Drop dependency on exceptions lib (minio#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           Control.Monad.Catch       as Exports (MonadCatch, MonadThrow,
-                                                       throwM)
+import           UnliftIO                  as Exports (catch, catches, throwIO,
+                                                       try)
 
 -- | 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`
-    [ MC.Handler handlerServiceErr
-    , MC.Handler handlerHE
-    , MC.Handler handlerFE
-    , MC.Handler handlerValidation
+    fmap Right m `U.catches`
+    [ U.Handler handlerServiceErr
+    , U.Handler handlerHE
+    , U.Handler handlerFE
+    , 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
-    handleStatus404 e = throwM e
+      else throwIO e
+    handleStatus404 e = throwIO e
 
     headBucketEx = do
       resp <- executeRequest $ def { riMethod = HT.methodHead