Minor refactor
This commit is contained in:
parent
f26fbc82a7
commit
0f3676b6d7
@ -11,3 +11,5 @@ module Lib.Prelude
|
||||
import Protolude as Exports
|
||||
|
||||
import Data.Time as Exports (UTCTime)
|
||||
|
||||
import Control.Monad.Catch as Exports (throwM, MonadThrow, MonadCatch)
|
||||
|
||||
@ -160,7 +160,7 @@ newtype Minio a = Minio {
|
||||
, MonadIO
|
||||
, MonadReader MinioConn
|
||||
, MonadThrow
|
||||
, MC.MonadCatch
|
||||
, MonadCatch
|
||||
, MonadBase IO
|
||||
, MonadResource
|
||||
)
|
||||
@ -197,8 +197,6 @@ runMinio ci m = do
|
||||
handlerHE = return . Left . MEHttp
|
||||
handlerFE = return . Left . MEFile
|
||||
|
||||
|
||||
|
||||
s3Name :: Text -> Name
|
||||
s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
|
||||
|
||||
|
||||
@ -35,7 +35,6 @@ module Network.Minio.S3API
|
||||
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Resource
|
||||
import qualified Data.Conduit as C
|
||||
import Data.Default (def)
|
||||
import qualified Network.HTTP.Conduit as NC
|
||||
|
||||
@ -3,8 +3,6 @@ module Network.Minio.Utils where
|
||||
import qualified Control.Concurrent.Async.Lifted as A
|
||||
import qualified Control.Concurrent.QSem as Q
|
||||
import qualified Control.Exception.Lifted as ExL
|
||||
import Control.Monad.Catch (throwM)
|
||||
import qualified Control.Monad.Catch as MC
|
||||
import Control.Monad.Trans.Control (liftBaseOp_, StM)
|
||||
import qualified Control.Monad.Trans.Resource as R
|
||||
import qualified Data.Conduit as C
|
||||
@ -23,7 +21,7 @@ allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m)
|
||||
=> FilePath -> m (R.ReleaseKey, Handle)
|
||||
allocateReadFile fp = do
|
||||
(rk, hdlE) <- R.allocate (openReadFile fp) cleanup
|
||||
either (MC.throwM . MEFile) (return . (rk,)) hdlE
|
||||
either (throwM . MEFile) (return . (rk,)) hdlE
|
||||
where
|
||||
openReadFile f = ExL.try $ IO.openBinaryFile f IO.ReadMode
|
||||
cleanup = either (const $ return ()) IO.hClose
|
||||
@ -38,7 +36,7 @@ isFileSeekable fp = do
|
||||
(rKey, h) <- allocateReadFile fp
|
||||
resE <- liftIO $ try $ IO.hIsSeekable h
|
||||
R.release rKey
|
||||
either (MC.throwM . MEFile) return resE
|
||||
either (throwM . MEFile) return resE
|
||||
|
||||
|
||||
lookupHeader :: HT.HeaderName -> [HT.Header] -> Maybe ByteString
|
||||
|
||||
@ -71,7 +71,7 @@ parseNewMultipartUpload :: (MonadThrow m)
|
||||
=> LByteString -> m UploadId
|
||||
parseNewMultipartUpload xmldata = do
|
||||
r <- parseRoot xmldata
|
||||
return $ T.concat $ r $// element (s3Name "UploadId") &/ content
|
||||
return $ T.concat $ r $// s3Elem "UploadId" &/ content
|
||||
|
||||
-- | Parse the response XML of completeMultipartUpload call.
|
||||
parseCompleteMultipartUploadResponse :: (MonadThrow m)
|
||||
@ -98,7 +98,6 @@ parseListObjectsResponse xmldata = do
|
||||
sizeStr = r $/ s3Elem "Contents" &/ s3Elem "Size" &/ content
|
||||
|
||||
modTimes <- mapM parseS3XMLTime modTimeStr
|
||||
|
||||
sizes <- parseDecimals sizeStr
|
||||
|
||||
let
|
||||
@ -123,7 +122,8 @@ parseListUploadsResponse xmldata = do
|
||||
uploadInitTimes <- mapM parseS3XMLTime uploadInitTimeStr
|
||||
|
||||
let
|
||||
uploads = map (uncurry3 UploadInfo) $ zip3 uploadKeys uploadIds uploadInitTimes
|
||||
uploads = map (uncurry3 UploadInfo) $
|
||||
zip3 uploadKeys uploadIds uploadInitTimes
|
||||
|
||||
return $ ListUploadsResult hasMore nextKey nextUpload uploads prefixes
|
||||
|
||||
@ -145,5 +145,7 @@ parseListPartsResponse xmldata = do
|
||||
nextPartNum <- parseDecimals $ maybeToList nextPartNumStr
|
||||
|
||||
let
|
||||
partInfos = map (uncurry4 ListPartInfo) $ zip4 partNumbers partETags partSizes partModTimes
|
||||
partInfos = map (uncurry4 ListPartInfo) $
|
||||
zip4 partNumbers partETags partSizes partModTimes
|
||||
|
||||
return $ ListPartsResult hasMore (listToMaybe nextPartNum) partInfos
|
||||
|
||||
Loading…
Reference in New Issue
Block a user