Drop dependency on exceptions lib (#87)

minio-hs.cabal

@@ -55,7 +55,6 @@ library
                      , cryptonite
                      , cryptonite-conduit
                      , data-default
-                     , exceptions
                      , filepath
                      , http-client
                      , http-conduit
@@ -137,7 +136,6 @@ test-suite minio-hs-live-server-test
                      , cryptonite-conduit
                      , data-default
                      , directory
-                     , exceptions
                      , filepath
                      , http-client
                      , http-conduit
@@ -177,7 +175,6 @@ test-suite minio-hs-test
                      , cryptonite-conduit
                      , data-default
                      , directory
-                     , exceptions
                      , http-client
                      , http-conduit
                      , http-types

src/Lib/Prelude.hs

@@ -19,14 +19,14 @@ module Lib.Prelude
     , both
     ) where
 
-import           Protolude                 as Exports
+import           Protolude                 as Exports hiding (catch, catches,
+                                                       throwIO, try)
 
 import           Control.Monad.Trans.Maybe as Exports (MaybeT (..), runMaybeT)
 import           Data.Time                 as Exports (UTCTime (..),
                                                        diffUTCTime)
-
+import           UnliftIO                  as Exports (catch, catches, throwIO,
-import           Control.Monad.Catch       as Exports (MonadCatch, MonadThrow,
+                                                       try)
-                                                       throwM)
 
 -- | Apply a function on both elements of a pair
 both :: (a -> b) -> (a, a) -> (b, b)

src/Network/Minio/API.hs

@@ -116,7 +116,7 @@ buildRequest ri = do
     Nothing ->  return $ connectHost ci
     Just r -> if "amazonaws.com" `T.isSuffixOf` connectHost ci
               then maybe
-                   (throwM $ MErrVRegionNotSupported r)
+                   (throwIO $ MErrVRegionNotSupported r)
                    return
                    (Map.lookup r awsRegionMap)
               else return $ connectHost ci
@@ -192,16 +192,16 @@ isValidBucketName bucket =
     isIPCheck = and labelAsNums && length labelAsNums == 4
 
 -- Throws exception iff bucket name is invalid according to AWS rules.
-checkBucketNameValidity :: MonadThrow m => Bucket -> m ()
+checkBucketNameValidity :: MonadIO m => Bucket -> m ()
 checkBucketNameValidity bucket =
   when (not $ isValidBucketName bucket) $
-  throwM $ MErrVInvalidBucketName bucket
+  throwIO $ MErrVInvalidBucketName bucket
 
 isValidObjectName :: Object -> Bool
 isValidObjectName object =
   T.length object > 0 && B.length (encodeUtf8 object) <= 1024
 
-checkObjectNameValidity :: MonadThrow m => Object -> m ()
+checkObjectNameValidity :: MonadIO m => Object -> m ()
 checkObjectNameValidity object =
   when (not $ isValidObjectName object) $
-  throwM $ MErrVInvalidObjectName object
+  throwIO $ MErrVInvalidObjectName object

src/Network/Minio/CopyObject.hs

@@ -47,7 +47,7 @@ copyObjectInternal b' o srcInfo = do
   when (isJust rangeMay &&
         or [startOffset < 0, endOffset < startOffset,
             endOffset >= fromIntegral srcSize]) $
-    throwM $ MErrVInvalidSrcObjByteRange range
+    throwIO $ MErrVInvalidSrcObjByteRange range
 
   -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR
   -- 2. If startOffset /= 0 use multipart copy

src/Network/Minio/Data.hs

@@ -20,7 +20,6 @@ module Network.Minio.Data where
 
 import           Control.Concurrent.MVar      (MVar)
 import qualified Control.Concurrent.MVar      as M
-import qualified Control.Monad.Catch          as MC
 import           Control.Monad.IO.Unlift      (MonadUnliftIO, UnliftIO (..),
                                                askUnliftIO, withUnliftIO)
 import           Control.Monad.Trans.Resource
@@ -38,6 +37,7 @@ import           Network.HTTP.Types           (ByteRange, Header, Method, Query,
 import qualified Network.HTTP.Types           as HT
 import           Network.Minio.Errors
 import           Text.XML
+import qualified UnliftIO                     as U
 
 import           Lib.Prelude
 
@@ -102,7 +102,6 @@ getHostAddr ci = toS $ T.concat [ connectHost ci, ":"
                                 , Lib.Prelude.show $ connectPort ci
                                 ]
 
-
 -- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
 -- should be supplied before use, for e.g.:
 --
@@ -512,8 +511,6 @@ newtype Minio a = Minio {
     , Monad
     , MonadIO
     , MonadReader MinioConn
-    , MonadThrow
-    , MonadCatch
     , MonadResource
     )
 
@@ -544,11 +541,11 @@ runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
 runMinio ci m = do
   conn <- liftIO $ connect ci
   runResourceT . flip runReaderT conn . unMinio $
-    fmap Right m `MC.catches`
+    fmap Right m `U.catches`
-    [ MC.Handler handlerServiceErr
+    [ U.Handler handlerServiceErr
-    , MC.Handler handlerHE
+    , U.Handler handlerHE
-    , MC.Handler handlerFE
+    , U.Handler handlerFE
-    , MC.Handler handlerValidation
+    , U.Handler handlerValidation
     ]
   where
     handlerServiceErr = return . Left . MErrService

src/Network/Minio/PresignedOperations.hs

@@ -66,7 +66,7 @@ makePresignedUrl :: UrlExpiry -> HT.Method -> Maybe Bucket -> Maybe Object
                  -> Minio ByteString
 makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do
   when (expiry > 7*24*3600 || expiry < 0) $
-    throwM $ MErrVInvalidUrlExpiry expiry
+    throwIO $ MErrVInvalidUrlExpiry expiry
 
   ci <- asks mcConnInfo
 

src/Network/Minio/PutObject.hs

@@ -70,7 +70,7 @@ putObjectInternal b o opts (ODStream src sizeMay) = do
       if | size <= 64 * oneMiB -> do
              bs <- C.runConduit $ src C..| CB.sinkLbs
              putObjectSingle' b o (pooToHeaders opts) $ LBS.toStrict bs
-         | size > maxObjectSize -> throwM $ MErrVPutSizeExceeded size
+         | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size
          | otherwise -> sequentialMultipartUpload b o opts (Just size) src
 
 putObjectInternal b o opts (ODFile fp sizeMay) = do
@@ -90,9 +90,9 @@ putObjectInternal b o opts (ODFile fp sizeMay) = do
 
     -- got file size, so check for single/multipart upload
     Just size ->
-      if | size <= 64 * oneMiB -> either throwM return =<<
+      if | size <= 64 * oneMiB -> either throwIO return =<<
            withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size)
-         | size > maxObjectSize -> throwM $ MErrVPutSizeExceeded size
+         | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size
          | isSeekable -> parallelMultipartUpload b o opts fp size
          | otherwise -> sequentialMultipartUpload b o opts (Just size) $
                         CB.sourceFile fp
@@ -112,7 +112,7 @@ parallelMultipartUpload b o opts filePath size = do
                     (uploadPart uploadId) partSizeInfo
 
   -- if there were any errors, rethrow exception.
-  mapM_ throwM $ lefts uploadedPartsE
+  mapM_ throwIO $ lefts uploadedPartsE
 
   -- if we get here, all parts were successfully uploaded.
   completeMultipartUpload b o uploadId $ rights uploadedPartsE

src/Network/Minio/S3API.hs

@@ -90,16 +90,16 @@ module Network.Minio.S3API
   , removeAllBucketNotification
   ) where
 
-import           Control.Monad.Catch               (Handler (..), catches)
 import qualified Data.ByteString                   as BS
 import qualified Data.Conduit                      as C
 import           Data.Default                      (def)
 import qualified Data.Text                         as T
-
-import           Lib.Prelude                       hiding (catches)
 import qualified Network.HTTP.Conduit              as NC
 import qualified Network.HTTP.Types                as HT
 import           Network.HTTP.Types.Status         (status404)
+import           UnliftIO                          (Handler (Handler))
+
+import           Lib.Prelude
 
 import           Network.Minio.API
 import           Network.Minio.Data
@@ -150,7 +150,7 @@ putObjectSingle' bucket object headers bs = do
   let size = fromIntegral (BS.length bs)
   -- check length is within single PUT object size.
   when (size > maxSinglePutObjectSizeBytes) $
-    throwM $ MErrVSinglePUTSizeExceeded size
+    throwIO $ MErrVSinglePUTSizeExceeded size
 
   -- content-length header is automatically set by library.
   resp <- executeRequest $
@@ -164,7 +164,7 @@ putObjectSingle' bucket object headers bs = do
   let rheaders = NC.responseHeaders resp
       etag = getETagHeader rheaders
   maybe
-    (throwM MErrVETagHeaderNotFound)
+    (throwIO MErrVETagHeaderNotFound)
     return etag
 
 -- | PUT an object into the service. This function performs a single
@@ -174,7 +174,7 @@ putObjectSingle :: Bucket -> Object -> [HT.Header] -> Handle -> Int64
 putObjectSingle bucket object headers h offset size = do
   -- check length is within single PUT object size.
   when (size > maxSinglePutObjectSizeBytes) $
-    throwM $ MErrVSinglePUTSizeExceeded size
+    throwIO $ MErrVSinglePUTSizeExceeded size
 
   -- content-length header is automatically set by library.
   resp <- executeRequest $
@@ -188,7 +188,7 @@ putObjectSingle bucket object headers h offset size = do
   let rheaders = NC.responseHeaders resp
       etag = getETagHeader rheaders
   maybe
-    (throwM MErrVETagHeaderNotFound)
+    (throwIO MErrVETagHeaderNotFound)
     return etag
 
 -- | List objects in a bucket matching prefix up to delimiter,
@@ -271,7 +271,7 @@ putObjectPart bucket object uploadId partNumber headers payload = do
   let rheaders = NC.responseHeaders resp
       etag = getETagHeader rheaders
   maybe
-    (throwM MErrVETagHeaderNotFound)
+    (throwIO MErrVETagHeaderNotFound)
     (return . (partNumber, )) etag
   where
     params = [
@@ -325,7 +325,7 @@ copyObjectSingle :: Bucket -> Object -> SourceInfo -> [HT.Header]
 copyObjectSingle bucket object srcInfo headers = do
   -- validate that srcRange is Nothing for this API.
   when (isJust $ srcRange srcInfo) $
-    throwM MErrVCopyObjSingleNoRangeAccepted
+    throwIO MErrVCopyObjSingleNoRangeAccepted
   resp <- executeRequest $
           def { riMethod = HT.methodPut
               , riBucket = Just bucket
@@ -414,7 +414,7 @@ headObject bucket object = do
     size = getContentLength headers
     metadata = getMetadataMap headers
 
-  maybe (throwM MErrVInvalidObjectInfoResponse) return $
+  maybe (throwIO MErrVInvalidObjectInfoResponse) return $
     ObjectInfo <$> Just object <*> modTime <*> etag <*> size <*> Just metadata
 
 
@@ -428,14 +428,14 @@ headBucket bucket = headBucketEx `catches`
   where
     handleNoSuchBucket :: ServiceErr -> Minio Bool
     handleNoSuchBucket e | e == NoSuchBucket = return False
-                         | otherwise = throwM e
+                         | otherwise = throwIO e
 
     handleStatus404 :: NC.HttpException -> Minio Bool
     handleStatus404 e@(NC.HttpExceptionRequest _ (NC.StatusCodeException res _)) =
       if NC.responseStatus res == status404
       then return False
-      else throwM e
+      else throwIO e
-    handleStatus404 e = throwM e
+    handleStatus404 e = throwIO e
 
     headBucketEx = do
       resp <- executeRequest $ def { riMethod = HT.methodHead

src/Network/Minio/Utils.hs

@@ -16,7 +16,6 @@
 
 module Network.Minio.Utils where
 
-import qualified Control.Monad.Catch           as MC
 import           Control.Monad.IO.Unlift       (MonadUnliftIO)
 import qualified Control.Monad.Trans.Resource  as R
 import qualified Data.ByteString               as B
@@ -36,10 +35,9 @@ import qualified Network.HTTP.Conduit          as NC
 import qualified Network.HTTP.Types            as HT
 import qualified Network.HTTP.Types.Header     as Hdr
 import qualified System.IO                     as IO
+import qualified UnliftIO                      as U
 import qualified UnliftIO.Async                as A
-import qualified UnliftIO.Exception            as UEx
 import qualified UnliftIO.MVar                 as UM
-import qualified UnliftIO.STM                  as U
 
 import           Lib.Prelude
 
@@ -47,13 +45,13 @@ import           Network.Minio.Data
 import           Network.Minio.Data.ByteString
 import           Network.Minio.XmlParser       (parseErrResponse)
 
-allocateReadFile :: (MonadUnliftIO m, R.MonadResource m, MonadCatch m)
+allocateReadFile :: (MonadUnliftIO m, R.MonadResource m)
                  => FilePath -> m (R.ReleaseKey, Handle)
 allocateReadFile fp = do
   (rk, hdlE) <- R.allocate (openReadFile fp) cleanup
-  either (\(e :: IOException) -> throwM e) (return . (rk,)) hdlE
+  either (\(e :: IOException) -> throwIO e) (return . (rk,)) hdlE
   where
-    openReadFile f = UEx.try $ IO.openBinaryFile f IO.ReadMode
+    openReadFile f = U.try $ IO.openBinaryFile f IO.ReadMode
     cleanup = either (const $ return ()) IO.hClose
 
 -- | Queries the file size from the handle. Catches any file operation
@@ -80,17 +78,17 @@ isHandleSeekable h = do
 -- the given action on it. Exceptions of type MError are caught and
 -- returned - both during file handle allocation and when the action
 -- is run.
-withNewHandle :: (MonadUnliftIO m, R.MonadResource m, MonadCatch m)
+withNewHandle :: (MonadUnliftIO m, R.MonadResource m)
               => FilePath -> (Handle -> m a) -> m (Either IOException a)
 withNewHandle fp fileAction = do
   -- opening a handle can throw MError exception.
-  handleE <- MC.try $ allocateReadFile fp
+  handleE <- try $ allocateReadFile fp
   either (return . Left) doAction handleE
   where
     doAction (rkey, h) = do
       -- fileAction may also throw MError exception, so we catch and
       -- return it.
-      resE <- MC.try $ fileAction h
+      resE <- try $ fileAction h
       R.release rkey
       return resE
 
@@ -127,19 +125,19 @@ isSuccessStatus :: HT.Status -> Bool
 isSuccessStatus sts = let s = HT.statusCode sts
                       in (s >= 200 && s < 300)
 
-httpLbs :: (R.MonadThrow m, MonadIO m)
+httpLbs :: MonadIO m
         => NC.Request -> NC.Manager
         -> m (NC.Response LByteString)
 httpLbs req mgr = do
   respE <- liftIO $ tryHttpEx $ NC.httpLbs req mgr
-  resp <- either throwM return respE
+  resp <- either throwIO return respE
   unless (isSuccessStatus $ NC.responseStatus resp) $
     case contentTypeMay resp of
       Just "application/xml" -> do
         sErr <- parseErrResponse $ NC.responseBody resp
-        throwM sErr
+        throwIO sErr
 
-      _ -> throwM $ NC.HttpExceptionRequest req $
+      _ -> throwIO $ NC.HttpExceptionRequest req $
         NC.StatusCodeException (void resp) (show resp)
 
   return resp
@@ -150,23 +148,22 @@ httpLbs req mgr = do
     contentTypeMay resp = lookupHeader Hdr.hContentType $
                           NC.responseHeaders resp
 
-http :: (MonadUnliftIO m, MonadThrow m, R.MonadResource m)
+http :: (MonadUnliftIO m, R.MonadResource m)
      => NC.Request -> NC.Manager
      -> m (Response (C.ConduitT () ByteString m ()))
 http req mgr = do
   respE <- tryHttpEx $ NC.http req mgr
-  resp <- either throwM return respE
+  resp <- either throwIO return respE
   unless (isSuccessStatus $ NC.responseStatus resp) $
     case contentTypeMay resp of
       Just "application/xml" -> do
         respBody <- C.connect (NC.responseBody resp) CB.sinkLbs
-        --respBody <- C.unsealConduitT (NC.responseBody resp) C.$$+- CB.sinkLbs
         sErr <- parseErrResponse respBody
-        throwM sErr
+        throwIO sErr
 
       _ -> do
         content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp
-        throwM $ NC.HttpExceptionRequest req $
+        throwIO $ NC.HttpExceptionRequest req $
            NC.StatusCodeException (void resp) content
 
 
@@ -174,8 +171,9 @@ http req mgr = do
   where
     tryHttpEx :: (MonadUnliftIO m) => m a
               -> m (Either NC.HttpException a)
-    tryHttpEx = UEx.try
+    tryHttpEx = try
-    contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp
+    contentTypeMay resp = lookupHeader Hdr.hContentType $
+                          NC.responseHeaders resp
 
 -- Similar to mapConcurrently but limits the number of threads that
 -- can run using a quantity semaphore.
@@ -188,7 +186,7 @@ limitedMapConcurrently count act args = do
   mapM A.wait threads
   where
     wThread t arg =
-      UEx.bracket_ (waitSem t) (signalSem t) $ act arg
+      U.bracket_ (waitSem t) (signalSem t) $ act arg
 
     -- quantity semaphore implementation using TVar
     waitSem t = U.atomically $ do

src/Network/Minio/XmlParser.hs

@@ -28,14 +28,13 @@ module Network.Minio.XmlParser
   , parseNotification
   ) where
 
-import           Control.Monad.Trans.Resource
+import           Data.List            (zip3, zip4, zip5)
-import           Data.List                    (zip3, zip4, zip5)
+import qualified Data.Map             as Map
-import qualified Data.Text                    as T
+import qualified Data.Text            as T
-import qualified Data.Map                     as Map
+import           Data.Text.Read       (decimal)
-import           Data.Text.Read               (decimal)
 import           Data.Time
 import           Text.XML
-import           Text.XML.Cursor              hiding (bool)
+import           Text.XML.Cursor      hiding (bool)
 
 import           Lib.Prelude
 
@@ -55,27 +54,27 @@ uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
 uncurry5 f (a, b, c, d, e) = f a b c d e
 
 -- | Parse time strings from XML
-parseS3XMLTime :: (MonadThrow m) => Text -> m UTCTime
+parseS3XMLTime :: (MonadIO m) => Text -> m UTCTime
-parseS3XMLTime = either (throwM . MErrVXmlParse) return
+parseS3XMLTime = either (throwIO . MErrVXmlParse) return
                . parseTimeM True defaultTimeLocale s3TimeFormat
                . T.unpack
 
-parseDecimal :: (MonadThrow m, Integral a) => Text -> m a
+parseDecimal :: (MonadIO m, Integral a) => Text -> m a
-parseDecimal numStr = either (throwM . MErrVXmlParse . show) return $
+parseDecimal numStr = either (throwIO . MErrVXmlParse . show) return $
                       fst <$> decimal numStr
 
-parseDecimals :: (MonadThrow m, Integral a) => [Text] -> m [a]
+parseDecimals :: (MonadIO m, Integral a) => [Text] -> m [a]
 parseDecimals numStr = forM numStr parseDecimal
 
 s3Elem :: Text -> Axis
 s3Elem = element . s3Name
 
-parseRoot :: (MonadThrow m) => LByteString -> m Cursor
+parseRoot :: (MonadIO m) => LByteString -> m Cursor
-parseRoot = either (throwM . MErrVXmlParse . show) (return . fromDocument)
+parseRoot = either (throwIO . MErrVXmlParse . show) (return . fromDocument)
           . parseLBS def
 
 -- | Parse the response XML of a list buckets call.
-parseListBuckets :: (MonadThrow m) => LByteString -> m [BucketInfo]
+parseListBuckets :: (MonadIO m) => LByteString -> m [BucketInfo]
 parseListBuckets xmldata = do
   r <- parseRoot xmldata
   let
@@ -86,26 +85,26 @@ parseListBuckets xmldata = do
   return $ zipWith BucketInfo names times
 
 -- | Parse the response XML of a location request.
-parseLocation :: (MonadThrow m) => LByteString -> m Region
+parseLocation :: (MonadIO m) => LByteString -> m Region
 parseLocation xmldata = do
   r <- parseRoot xmldata
   let region = T.concat $ r $/ content
   return $ bool "us-east-1" region $ region /= ""
 
 -- | Parse the response XML of an newMultipartUpload call.
-parseNewMultipartUpload :: (MonadThrow m) => LByteString -> m UploadId
+parseNewMultipartUpload :: (MonadIO m) => LByteString -> m UploadId
 parseNewMultipartUpload xmldata = do
   r <- parseRoot xmldata
   return $ T.concat $ r $// s3Elem "UploadId" &/ content
 
 -- | Parse the response XML of completeMultipartUpload call.
-parseCompleteMultipartUploadResponse :: (MonadThrow m) => LByteString -> m ETag
+parseCompleteMultipartUploadResponse :: (MonadIO m) => LByteString -> m ETag
 parseCompleteMultipartUploadResponse xmldata = do
   r <- parseRoot xmldata
   return $ T.concat $ r $// s3Elem "ETag" &/ content
 
 -- | Parse the response XML of copyObject and copyObjectPart
-parseCopyObjectResponse :: (MonadThrow m) => LByteString -> m (ETag, UTCTime)
+parseCopyObjectResponse :: (MonadIO m) => LByteString -> m (ETag, UTCTime)
 parseCopyObjectResponse xmldata = do
   r <- parseRoot xmldata
   let
@@ -115,7 +114,7 @@ parseCopyObjectResponse xmldata = do
   return (T.concat $ r $// s3Elem "ETag" &/ content, mtime)
 
 -- | Parse the response XML of a list objects v1 call.
-parseListObjectsV1Response :: (MonadThrow m)
+parseListObjectsV1Response :: (MonadIO m)
                          => LByteString -> m ListObjectsV1Result
 parseListObjectsV1Response xmldata = do
   r <- parseRoot xmldata
@@ -143,7 +142,7 @@ parseListObjectsV1Response xmldata = do
   return $ ListObjectsV1Result hasMore nextMarker objects prefixes
 
 -- | Parse the response XML of a list objects call.
-parseListObjectsResponse :: (MonadThrow m) => LByteString -> m ListObjectsResult
+parseListObjectsResponse :: (MonadIO m) => LByteString -> m ListObjectsResult
 parseListObjectsResponse xmldata = do
   r <- parseRoot xmldata
   let
@@ -170,7 +169,7 @@ parseListObjectsResponse xmldata = do
   return $ ListObjectsResult hasMore nextToken objects prefixes
 
 -- | Parse the response XML of a list incomplete multipart upload call.
-parseListUploadsResponse :: (MonadThrow m) => LByteString -> m ListUploadsResult
+parseListUploadsResponse :: (MonadIO m) => LByteString -> m ListUploadsResult
 parseListUploadsResponse xmldata = do
   r <- parseRoot xmldata
   let
@@ -189,7 +188,7 @@ parseListUploadsResponse xmldata = do
 
   return $ ListUploadsResult hasMore nextKey nextUpload uploads prefixes
 
-parseListPartsResponse :: (MonadThrow m) => LByteString -> m ListPartsResult
+parseListPartsResponse :: (MonadIO m) => LByteString -> m ListPartsResult
 parseListPartsResponse xmldata = do
   r <- parseRoot xmldata
   let
@@ -212,14 +211,14 @@ parseListPartsResponse xmldata = do
   return $ ListPartsResult hasMore (listToMaybe nextPartNum) partInfos
 
 
-parseErrResponse :: (MonadThrow m) => LByteString -> m ServiceErr
+parseErrResponse :: (MonadIO m) => LByteString -> m ServiceErr
 parseErrResponse xmldata = do
   r <- parseRoot xmldata
   let code = T.concat $ r $/ element "Code" &/ content
       message = T.concat $ r $/ element "Message" &/ content
   return $ toServiceErr code message
 
-parseNotification :: (MonadThrow m) => LByteString -> m Notification
+parseNotification :: (MonadIO m) => LByteString -> m Notification
 parseNotification xmldata = do
   r <- parseRoot xmldata
   let qcfg = map node $ r $/ s3Elem "QueueConfiguration"

test/LiveServer.hs

@@ -20,7 +20,6 @@ import           Test.Tasty.HUnit
 import           Test.Tasty.QuickCheck                 as QC
 
 import           Conduit                               (replicateC)
-import qualified Control.Monad.Catch                   as MC
 import qualified Control.Monad.Trans.Resource          as R
 import qualified Data.ByteString                       as BS
 import           Data.Conduit                          (yield)
@@ -437,7 +436,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
       liftIO $ assertEqual "storageClass did not match" (Just "REDUCED_REDUNDANCY")
         (Map.lookup "X-Amz-Storage-Class" m')
 
-      fpE <- MC.try $ fPutObject bucket object'' inputFile'' def{
+      fpE <- try $ fPutObject bucket object'' inputFile'' def{
         pooStorageClass = Just "INVALID_STORAGE_CLASS"
         }
       case fpE of
@@ -571,13 +570,13 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
                        " was expected to exist.")
 
       step "makeBucket again to check if BucketAlreadyOwnedByYou exception is raised."
-      mbE <- MC.try $ makeBucket bucket Nothing
+      mbE <- try $ makeBucket bucket Nothing
       case mbE of
         Left exn -> liftIO $ exn @?= BucketAlreadyOwnedByYou
         _        -> return ()
 
       step "makeBucket with an invalid bucket name and check for appropriate exception."
-      invalidMBE <- MC.try $ makeBucket "invalidBucketName" Nothing
+      invalidMBE <- try $ makeBucket "invalidBucketName" Nothing
       case invalidMBE of
         Left exn -> liftIO $ exn @?= MErrVInvalidBucketName "invalidBucketName"
         _ -> return ()
@@ -590,7 +589,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
       fPutObject bucket "lsb-release" "/etc/lsb-release" def
 
       step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception"
-      fpE <- MC.try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" def
+      fpE <- try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" def
       case fpE of
         Left exn -> liftIO $ exn @?= NoSuchBucket
         _        -> return ()
@@ -601,7 +600,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
 
       let unmodifiedTime = UTCTime (fromGregorian 2010 11 26) 69857
       step "fGetObject an object which is modified now but requesting as un-modified in past, check for exception"
-      resE <- MC.try $ fGetObject bucket "lsb-release" outFile def{
+      resE <- try $ fGetObject bucket "lsb-release" outFile def{
         gooIfUnmodifiedSince = (Just unmodifiedTime)
         }
       case resE of
@@ -609,7 +608,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
         _        -> return ()
 
       step "fGetObject an object with no matching etag, check for exception"
-      resE1 <- MC.try $ fGetObject bucket "lsb-release" outFile def{
+      resE1 <- try $ fGetObject bucket "lsb-release" outFile def{
         gooIfMatch = (Just "invalid-etag")
         }
       case resE1 of
@@ -617,7 +616,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
         _        -> return ()
 
       step "fGetObject an object with no valid range, check for exception"
-      resE2 <- MC.try $ fGetObject bucket "lsb-release" outFile def{
+      resE2 <- try $ fGetObject bucket "lsb-release" outFile def{
         gooRange = (Just $ HT.ByteRangeFromTo 100 200)
         }
       case resE2 of
@@ -630,7 +629,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
         }
 
       step "fGetObject a non-existent object and check for NoSuchKey exception"
-      resE3 <- MC.try $ fGetObject bucket "noSuchKey" outFile def
+      resE3 <- try $ fGetObject bucket "noSuchKey" outFile def
       case resE3 of
         Left exn -> liftIO $ exn @?= NoSuchKey
         _        -> return ()
@@ -705,7 +704,7 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $
     step "HEAD object presigned URL - presignedHeadObjectUrl"
     headUrl <- presignedHeadObjectUrl bucket obj2 3600 []
 
-    headResp <- do req <- NC.parseRequest $ toS headUrl
+    headResp <- do let req = NC.parseRequest_ $ toS headUrl
                    NC.httpLbs (req {NC.method = HT.methodHead}) mgr
     liftIO $ (NC.responseStatus headResp == HT.status200) @?
       "presigned HEAD failed (presignedHeadObjectUrl)"
@@ -731,14 +730,14 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $
     mapM_ (removeObject bucket) [obj, obj2]
   where
     putR size filePath mgr url = do
-      req <- NC.parseRequest $ toS url
+      let req = NC.parseRequest_ $ toS url
       let req' = req { NC.method = HT.methodPut
                      , NC.requestBody = NC.requestBodySource size $
                                         CB.sourceFile filePath}
       NC.httpLbs req' mgr
 
     getR mgr url = do
-      req <- NC.parseRequest $ toS url
+      let req = NC.parseRequest_ $ toS url
       NC.httpLbs req mgr
 
 presignedPostPolicyFunTest :: TestTree
@@ -789,12 +788,12 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $
   \step bucket -> do
 
     step "bucketPolicy basic test - no policy exception"
-    resE <- MC.try $ getBucketPolicy bucket
+    resE <- try $ getBucketPolicy bucket
     case resE of
       Left exn -> liftIO $ exn @?= ServiceErr "NoSuchBucketPolicy" "The bucket policy does not exist"
       _        -> return ()
 
-    resE' <- MC.try $ setBucketPolicy bucket T.empty
+    resE' <- try $ setBucketPolicy bucket T.empty
     case resE' of
       Left exn -> liftIO $ exn @?= ServiceErr "NoSuchBucketPolicy" "The bucket policy does not exist"
       _        -> return ()
@@ -802,7 +801,7 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $
     let expectedPolicyJSON = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket\"]},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket/*\"]}]}"
 
     step "try a malformed policy, expect error"
-    resE'' <- MC.try $ setBucketPolicy bucket expectedPolicyJSON
+    resE'' <- try $ setBucketPolicy bucket expectedPolicyJSON
     case resE'' of
       Left exn -> liftIO $ exn @?= ServiceErr "MalformedPolicy" "Policy has invalid resource."
       _        -> return ()

test/Network/Minio/XmlParser/Test.hs

@@ -19,16 +19,15 @@ module Network.Minio.XmlParser.Test
     xmlParserTests
   ) where
 
-import qualified Control.Monad.Catch     as MC
+import           Data.Default            (def)
-import           Data.Time               (fromGregorian)
 import qualified Data.Map                as Map
+import           Data.Time               (fromGregorian)
 import           Test.Tasty
 import           Test.Tasty.HUnit
+import           UnliftIO                (MonadUnliftIO)
 
 import           Lib.Prelude
 
-import           Data.Default            (def)
-
 import           Network.Minio.Data
 import           Network.Minio.Errors
 import           Network.Minio.XmlParser
@@ -46,8 +45,8 @@ xmlParserTests = testGroup "XML Parser Tests"
   , testCase "Test parseNotification" testParseNotification
   ]
 
-tryValidationErr :: (MC.MonadCatch m) => m a -> m (Either MErrV a)
+tryValidationErr :: (MonadUnliftIO m) => m a -> m (Either MErrV a)
-tryValidationErr act = MC.try act
+tryValidationErr act = try act
 
 assertValidtionErr :: MErrV -> Assertion
 assertValidtionErr e = assertFailure $ "Failed due to validation error => " ++ show e