Fix hlint warnings and suggestions (#44)
This commit is contained in:
parent
b30beecd52
commit
9358d28d3b
@ -134,7 +134,7 @@ getObject bucket object = snd <$> getObject' bucket object [] []
|
|||||||
|
|
||||||
-- | Get an object's metadata from the object store.
|
-- | Get an object's metadata from the object store.
|
||||||
statObject :: Bucket -> Object -> Minio ObjectInfo
|
statObject :: Bucket -> Object -> Minio ObjectInfo
|
||||||
statObject bucket object = headObject bucket object
|
statObject = headObject
|
||||||
|
|
||||||
-- | Creates a new bucket in the object store. The Region can be
|
-- | Creates a new bucket in the object store. The Region can be
|
||||||
-- optionally specified. If not specified, it will use the region
|
-- optionally specified. If not specified, it will use the region
|
||||||
|
|||||||
@ -108,7 +108,7 @@ buildRequest ri = do
|
|||||||
|
|
||||||
regionHost <- case region of
|
regionHost <- case region of
|
||||||
Nothing -> return $ connectHost ci
|
Nothing -> return $ connectHost ci
|
||||||
Just r -> if "amazonaws.com" `T.isSuffixOf` (connectHost ci)
|
Just r -> if "amazonaws.com" `T.isSuffixOf` connectHost ci
|
||||||
then maybe
|
then maybe
|
||||||
(throwM $ MErrVRegionNotSupported r)
|
(throwM $ MErrVRegionNotSupported r)
|
||||||
return
|
return
|
||||||
@ -118,7 +118,7 @@ buildRequest ri = do
|
|||||||
|
|
||||||
sha256Hash <- getPayloadSHA256Hash (riPayload ri)
|
sha256Hash <- getPayloadSHA256Hash (riPayload ri)
|
||||||
let newRi = ri { riPayloadHash = sha256Hash
|
let newRi = ri { riPayloadHash = sha256Hash
|
||||||
, riHeaders = sha256Header sha256Hash : (riHeaders ri)
|
, riHeaders = sha256Header sha256Hash : riHeaders ri
|
||||||
, riRegion = region
|
, riRegion = region
|
||||||
}
|
}
|
||||||
newCi = ci { connectHost = regionHost }
|
newCi = ci { connectHost = regionHost }
|
||||||
|
|||||||
@ -248,12 +248,12 @@ instance Default CopyPartSource where
|
|||||||
|
|
||||||
cpsToHeaders :: CopyPartSource -> [HT.Header]
|
cpsToHeaders :: CopyPartSource -> [HT.Header]
|
||||||
cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
|
cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
|
||||||
(rangeHdr ++ (zip names values))
|
rangeHdr ++ zip names values
|
||||||
where
|
where
|
||||||
names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",
|
names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",
|
||||||
"x-amz-copy-source-if-unmodified-since",
|
"x-amz-copy-source-if-unmodified-since",
|
||||||
"x-amz-copy-source-if-modified-since"]
|
"x-amz-copy-source-if-modified-since"]
|
||||||
values = concatMap (maybeToList . fmap encodeUtf8 . (cps &))
|
values = mapMaybe (fmap encodeUtf8 . (cps &))
|
||||||
[cpSourceIfMatch, cpSourceIfNoneMatch,
|
[cpSourceIfMatch, cpSourceIfNoneMatch,
|
||||||
fmap formatRFC1123 . cpSourceIfUnmodifiedSince,
|
fmap formatRFC1123 . cpSourceIfUnmodifiedSince,
|
||||||
fmap formatRFC1123 . cpSourceIfModifiedSince]
|
fmap formatRFC1123 . cpSourceIfModifiedSince]
|
||||||
@ -261,8 +261,7 @@ cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
|
|||||||
. HT.renderByteRanges
|
. HT.renderByteRanges
|
||||||
. (:[])
|
. (:[])
|
||||||
. uncurry HT.ByteRangeFromTo
|
. uncurry HT.ByteRangeFromTo
|
||||||
<$> (map (both fromIntegral) $
|
<$> map (both fromIntegral) (maybeToList $ cpSourceRange cps)
|
||||||
maybeToList $ cpSourceRange cps)
|
|
||||||
|
|
||||||
-- | Extract the source bucket and source object name. TODO: validate
|
-- | Extract the source bucket and source object name. TODO: validate
|
||||||
-- the bucket and object name extracted.
|
-- the bucket and object name extracted.
|
||||||
@ -299,7 +298,7 @@ instance Default RequestInfo where
|
|||||||
def = RequestInfo HT.methodGet def def def def def "" def True
|
def = RequestInfo HT.methodGet def def def def def "" def True
|
||||||
|
|
||||||
getPathFromRI :: RequestInfo -> ByteString
|
getPathFromRI :: RequestInfo -> ByteString
|
||||||
getPathFromRI ri = B.concat $ parts
|
getPathFromRI ri = B.concat parts
|
||||||
where
|
where
|
||||||
objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ riObject ri
|
objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ riObject ri
|
||||||
parts = maybe ["/"] (\b -> "/" : encodeUtf8 b : objPart) $ riBucket ri
|
parts = maybe ["/"] (\b -> "/" : encodeUtf8 b : objPart) $ riBucket ri
|
||||||
@ -347,7 +346,7 @@ runMinio :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
|
|||||||
runMinio ci m = do
|
runMinio ci m = do
|
||||||
conn <- liftIO $ connect ci
|
conn <- liftIO $ connect ci
|
||||||
flip evalStateT Map.empty . flip runReaderT conn . unMinio $
|
flip evalStateT Map.empty . flip runReaderT conn . unMinio $
|
||||||
(m >>= (return . Right)) `MC.catches`
|
fmap Right m `MC.catches`
|
||||||
[ MC.Handler handlerServiceErr
|
[ MC.Handler handlerServiceErr
|
||||||
, MC.Handler handlerHE
|
, MC.Handler handlerHE
|
||||||
, MC.Handler handlerFE
|
, MC.Handler handlerFE
|
||||||
|
|||||||
@ -25,7 +25,7 @@ import qualified Data.ByteString as B
|
|||||||
import qualified Data.ByteString.Builder as BB
|
import qualified Data.ByteString.Builder as BB
|
||||||
import qualified Data.ByteString.Char8 as BC8
|
import qualified Data.ByteString.Char8 as BC8
|
||||||
import qualified Data.ByteString.Lazy as LB
|
import qualified Data.ByteString.Lazy as LB
|
||||||
import Data.Char (isSpace, toUpper)
|
import Data.Char (isSpace, toUpper, isAsciiUpper, isAsciiLower, isDigit)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Numeric (showHex)
|
import Numeric (showHex)
|
||||||
|
|
||||||
@ -40,7 +40,7 @@ class UriEncodable s where
|
|||||||
instance UriEncodable [Char] where
|
instance UriEncodable [Char] where
|
||||||
uriEncode encodeSlash payload =
|
uriEncode encodeSlash payload =
|
||||||
LB.toStrict $ BB.toLazyByteString $ mconcat $
|
LB.toStrict $ BB.toLazyByteString $ mconcat $
|
||||||
map (flip uriEncodeChar encodeSlash) payload
|
map (`uriEncodeChar` encodeSlash) payload
|
||||||
|
|
||||||
instance UriEncodable ByteString where
|
instance UriEncodable ByteString where
|
||||||
-- assumes that uriEncode is passed ASCII encoded strings.
|
-- assumes that uriEncode is passed ASCII encoded strings.
|
||||||
@ -58,9 +58,9 @@ uriEncodeChar :: Char -> Bool -> BB.Builder
|
|||||||
uriEncodeChar '/' True = BB.byteString "%2F"
|
uriEncodeChar '/' True = BB.byteString "%2F"
|
||||||
uriEncodeChar '/' False = BB.char7 '/'
|
uriEncodeChar '/' False = BB.char7 '/'
|
||||||
uriEncodeChar ch _
|
uriEncodeChar ch _
|
||||||
| (ch >= 'A' && ch <= 'Z')
|
| isAsciiUpper ch
|
||||||
|| (ch >= 'a' && ch <= 'z')
|
|| isAsciiLower ch
|
||||||
|| (ch >= '0' && ch <= '9')
|
|| isDigit ch
|
||||||
|| (ch == '_')
|
|| (ch == '_')
|
||||||
|| (ch == '-')
|
|| (ch == '-')
|
||||||
|| (ch == '.')
|
|| (ch == '.')
|
||||||
|
|||||||
@ -55,10 +55,9 @@ listIncompleteUploads bucket prefix recurse = loop Nothing Nothing
|
|||||||
res <- lift $ listIncompleteUploads' bucket prefix delimiter
|
res <- lift $ listIncompleteUploads' bucket prefix delimiter
|
||||||
nextKeyMarker nextUploadIdMarker
|
nextKeyMarker nextUploadIdMarker
|
||||||
|
|
||||||
aggrSizes <- lift $ forM (lurUploads res) $ \((uKey, uId, _)) -> do
|
aggrSizes <- lift $ forM (lurUploads res) $ \(uKey, uId, _) -> do
|
||||||
partInfos <- listIncompleteParts bucket uKey uId C.$$ CC.sinkList
|
partInfos <- listIncompleteParts bucket uKey uId C.$$ CC.sinkList
|
||||||
return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0
|
return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos
|
||||||
$ partInfos
|
|
||||||
|
|
||||||
CL.sourceList $
|
CL.sourceList $
|
||||||
map (\((uKey, uId, uInitTime), size) ->
|
map (\((uKey, uId, uInitTime), size) ->
|
||||||
|
|||||||
@ -124,7 +124,7 @@ checkUploadNeeded :: Payload -> PartNumber
|
|||||||
checkUploadNeeded payload n pmap = do
|
checkUploadNeeded payload n pmap = do
|
||||||
(md5hash, pSize) <- case payload of
|
(md5hash, pSize) <- case payload of
|
||||||
PayloadBS bs -> return (hashMD5 bs, fromIntegral $ B.length bs)
|
PayloadBS bs -> return (hashMD5 bs, fromIntegral $ B.length bs)
|
||||||
PayloadH h off size -> liftM (, size) $
|
PayloadH h off size -> fmap (, size) $
|
||||||
hashMD5FromSource $ sourceHandleRange h (Just $ fromIntegral off)
|
hashMD5FromSource $ sourceHandleRange h (Just $ fromIntegral off)
|
||||||
(Just $ fromIntegral size)
|
(Just $ fromIntegral size)
|
||||||
case Map.lookup n pmap of
|
case Map.lookup n pmap of
|
||||||
@ -266,7 +266,7 @@ multiPartCopyObject b o cps srcSize = do
|
|||||||
copiedParts <- limitedMapConcurrently 10
|
copiedParts <- limitedMapConcurrently 10
|
||||||
(\(pn, cps') -> do
|
(\(pn, cps') -> do
|
||||||
(etag, _) <- copyObjectPart b o cps' uid pn []
|
(etag, _) <- copyObjectPart b o cps' uid pn []
|
||||||
return $ (pn, etag)
|
return (pn, etag)
|
||||||
)
|
)
|
||||||
partSources
|
partSources
|
||||||
|
|
||||||
|
|||||||
@ -97,7 +97,7 @@ getObject' :: Bucket -> Object -> HT.Query -> [HT.Header]
|
|||||||
-> Minio ([HT.Header], C.ResumableSource Minio ByteString)
|
-> Minio ([HT.Header], C.ResumableSource Minio ByteString)
|
||||||
getObject' bucket object queryParams headers = do
|
getObject' bucket object queryParams headers = do
|
||||||
resp <- mkStreamRequest reqInfo
|
resp <- mkStreamRequest reqInfo
|
||||||
return $ (NC.responseHeaders resp, NC.responseBody resp)
|
return (NC.responseHeaders resp, NC.responseBody resp)
|
||||||
where
|
where
|
||||||
reqInfo = def { riBucket = Just bucket
|
reqInfo = def { riBucket = Just bucket
|
||||||
, riObject = Just object
|
, riObject = Just object
|
||||||
@ -107,8 +107,8 @@ getObject' bucket object queryParams headers = do
|
|||||||
|
|
||||||
-- | Creates a bucket via a PUT bucket call.
|
-- | Creates a bucket via a PUT bucket call.
|
||||||
putBucket :: Bucket -> Region -> Minio ()
|
putBucket :: Bucket -> Region -> Minio ()
|
||||||
putBucket bucket location = do
|
putBucket bucket location = void $
|
||||||
void $ executeRequest $
|
executeRequest $
|
||||||
def { riMethod = HT.methodPut
|
def { riMethod = HT.methodPut
|
||||||
, riBucket = Just bucket
|
, riBucket = Just bucket
|
||||||
, riPayload = PayloadBS $ mkCreateBucketConfig location
|
, riPayload = PayloadBS $ mkCreateBucketConfig location
|
||||||
@ -163,16 +163,16 @@ listObjects' bucket prefix nextToken delimiter = do
|
|||||||
|
|
||||||
-- | DELETE a bucket from the service.
|
-- | DELETE a bucket from the service.
|
||||||
deleteBucket :: Bucket -> Minio ()
|
deleteBucket :: Bucket -> Minio ()
|
||||||
deleteBucket bucket = do
|
deleteBucket bucket = void $
|
||||||
void $ executeRequest $
|
executeRequest $
|
||||||
def { riMethod = HT.methodDelete
|
def { riMethod = HT.methodDelete
|
||||||
, riBucket = Just bucket
|
, riBucket = Just bucket
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | DELETE an object from the service.
|
-- | DELETE an object from the service.
|
||||||
deleteObject :: Bucket -> Object -> Minio ()
|
deleteObject :: Bucket -> Object -> Minio ()
|
||||||
deleteObject bucket object = do
|
deleteObject bucket object = void $
|
||||||
void $ executeRequest $
|
executeRequest $
|
||||||
def { riMethod = HT.methodDelete
|
def { riMethod = HT.methodDelete
|
||||||
, riBucket = Just bucket
|
, riBucket = Just bucket
|
||||||
, riObject = Just object
|
, riObject = Just object
|
||||||
@ -267,8 +267,8 @@ completeMultipartUpload bucket object uploadId partTuple = do
|
|||||||
|
|
||||||
-- | Abort a multipart upload.
|
-- | Abort a multipart upload.
|
||||||
abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio ()
|
abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio ()
|
||||||
abortMultipartUpload bucket object uploadId = do
|
abortMultipartUpload bucket object uploadId = void $
|
||||||
void $ executeRequest $ def { riMethod = HT.methodDelete
|
executeRequest $ def { riMethod = HT.methodDelete
|
||||||
, riBucket = Just bucket
|
, riBucket = Just bucket
|
||||||
, riObject = Just object
|
, riObject = Just object
|
||||||
, riQueryParams = mkOptionalParams params
|
, riQueryParams = mkOptionalParams params
|
||||||
@ -355,4 +355,4 @@ headBucket bucket = headBucketEx `catches`
|
|||||||
resp <- executeRequest $ def { riMethod = HT.methodHead
|
resp <- executeRequest $ def { riMethod = HT.methodHead
|
||||||
, riBucket = Just bucket
|
, riBucket = Just bucket
|
||||||
}
|
}
|
||||||
return $ (NC.responseStatus resp) == HT.ok200
|
return $ NC.responseStatus resp == HT.ok200
|
||||||
|
|||||||
@ -98,10 +98,10 @@ signV4AtTime ts ci ri =
|
|||||||
outHeaders = authHeader : headersWithDate
|
outHeaders = authHeader : headersWithDate
|
||||||
timeBS = awsTimeFormatBS ts
|
timeBS = awsTimeFormatBS ts
|
||||||
dateHeader = (mk "X-Amz-Date", timeBS)
|
dateHeader = (mk "X-Amz-Date", timeBS)
|
||||||
hostHeader = (mk "host", encodeUtf8 $ format "{}:{}" $
|
hostHeader = (mk "host", encodeUtf8 $ format "{}:{}"
|
||||||
[connectHost ci, show $ connectPort ci])
|
[connectHost ci, show $ connectPort ci])
|
||||||
|
|
||||||
headersWithDate = dateHeader : hostHeader : (riHeaders ri)
|
headersWithDate = dateHeader : hostHeader : riHeaders ri
|
||||||
|
|
||||||
authHeader = (mk "Authorization", authHeaderValue)
|
authHeader = (mk "Authorization", authHeaderValue)
|
||||||
|
|
||||||
@ -126,20 +126,20 @@ signV4AtTime ts ci ri =
|
|||||||
. hmacSHA256RawBS "s3"
|
. hmacSHA256RawBS "s3"
|
||||||
. hmacSHA256RawBS (encodeUtf8 region)
|
. hmacSHA256RawBS (encodeUtf8 region)
|
||||||
. hmacSHA256RawBS (awsDateFormatBS ts)
|
. hmacSHA256RawBS (awsDateFormatBS ts)
|
||||||
$ (B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci])
|
$ B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci]
|
||||||
|
|
||||||
stringToSign = B.intercalate "\n" $
|
stringToSign = B.intercalate "\n"
|
||||||
["AWS4-HMAC-SHA256",
|
[ "AWS4-HMAC-SHA256"
|
||||||
timeBS,
|
, timeBS
|
||||||
scope,
|
, scope
|
||||||
hashSHA256 $ canonicalRequest
|
, hashSHA256 canonicalRequest
|
||||||
]
|
]
|
||||||
|
|
||||||
canonicalRequest = getCanonicalRequest ri headersToSign
|
canonicalRequest = getCanonicalRequest ri headersToSign
|
||||||
|
|
||||||
|
|
||||||
getScope :: UTCTime -> Region -> ByteString
|
getScope :: UTCTime -> Region -> ByteString
|
||||||
getScope ts region = B.intercalate "/" $ [
|
getScope ts region = B.intercalate "/" [
|
||||||
pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts,
|
pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts,
|
||||||
encodeUtf8 region, "s3", "aws4_request"
|
encodeUtf8 region, "s3", "aws4_request"
|
||||||
]
|
]
|
||||||
@ -148,11 +148,10 @@ getHeadersToSign :: [Header] -> [(ByteString, ByteString)]
|
|||||||
getHeadersToSign h =
|
getHeadersToSign h =
|
||||||
sort $
|
sort $
|
||||||
filter (flip Set.notMember ignoredHeaders . fst) $
|
filter (flip Set.notMember ignoredHeaders . fst) $
|
||||||
map (\(x, y) -> (CI.foldedCase x, stripBS y)) $
|
map (\(x, y) -> (CI.foldedCase x, stripBS y)) h
|
||||||
h
|
|
||||||
|
|
||||||
getCanonicalRequest :: RequestInfo -> [(ByteString, ByteString)] -> ByteString
|
getCanonicalRequest :: RequestInfo -> [(ByteString, ByteString)] -> ByteString
|
||||||
getCanonicalRequest ri headersForSign = B.intercalate "\n" $ [
|
getCanonicalRequest ri headersForSign = B.intercalate "\n" [
|
||||||
riMethod ri,
|
riMethod ri,
|
||||||
uriEncode False path,
|
uriEncode False path,
|
||||||
canonicalQueryString,
|
canonicalQueryString,
|
||||||
@ -170,7 +169,6 @@ getCanonicalRequest ri headersForSign = B.intercalate "\n" $ [
|
|||||||
riQueryParams ri
|
riQueryParams ri
|
||||||
|
|
||||||
canonicalHeaders = B.concat $
|
canonicalHeaders = B.concat $
|
||||||
map (\(x, y) -> B.concat [x, ":", y, "\n"]) $
|
map (\(x, y) -> B.concat [x, ":", y, "\n"]) headersForSign
|
||||||
headersForSign
|
|
||||||
|
|
||||||
signedHeaders = B.intercalate ";" $ map fst headersForSign
|
signedHeaders = B.intercalate ";" $ map fst headersForSign
|
||||||
|
|||||||
@ -117,7 +117,7 @@ httpLbs :: (R.MonadThrow m, MonadIO m)
|
|||||||
=> NC.Request -> NC.Manager
|
=> NC.Request -> NC.Manager
|
||||||
-> m (NC.Response LByteString)
|
-> m (NC.Response LByteString)
|
||||||
httpLbs req mgr = do
|
httpLbs req mgr = do
|
||||||
respE <- liftIO $ tryHttpEx $ (NC.httpLbs req mgr)
|
respE <- liftIO $ tryHttpEx $ NC.httpLbs req mgr
|
||||||
resp <- either throwM return respE
|
resp <- either throwM return respE
|
||||||
unless (isSuccessStatus $ NC.responseStatus resp) $
|
unless (isSuccessStatus $ NC.responseStatus resp) $
|
||||||
case contentTypeMay resp of
|
case contentTypeMay resp of
|
||||||
@ -126,11 +126,11 @@ httpLbs req mgr = do
|
|||||||
throwM sErr
|
throwM sErr
|
||||||
|
|
||||||
_ -> throwM $ NC.HttpExceptionRequest req $
|
_ -> throwM $ NC.HttpExceptionRequest req $
|
||||||
NC.StatusCodeException (const () <$> resp) (show resp)
|
NC.StatusCodeException (void resp) (show resp)
|
||||||
|
|
||||||
return resp
|
return resp
|
||||||
where
|
where
|
||||||
tryHttpEx :: (IO (NC.Response LByteString))
|
tryHttpEx :: IO (NC.Response LByteString)
|
||||||
-> IO (Either NC.HttpException (NC.Response LByteString))
|
-> IO (Either NC.HttpException (NC.Response LByteString))
|
||||||
tryHttpEx = try
|
tryHttpEx = try
|
||||||
contentTypeMay resp = lookupHeader Hdr.hContentType $
|
contentTypeMay resp = lookupHeader Hdr.hContentType $
|
||||||
@ -146,18 +146,18 @@ http req mgr = do
|
|||||||
case contentTypeMay resp of
|
case contentTypeMay resp of
|
||||||
Just "application/xml" -> do
|
Just "application/xml" -> do
|
||||||
respBody <- NC.responseBody resp C.$$+- CB.sinkLbs
|
respBody <- NC.responseBody resp C.$$+- CB.sinkLbs
|
||||||
sErr <- parseErrResponse $ respBody
|
sErr <- parseErrResponse respBody
|
||||||
throwM sErr
|
throwM sErr
|
||||||
|
|
||||||
_ -> do
|
_ -> do
|
||||||
content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp
|
content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp
|
||||||
throwM $ NC.HttpExceptionRequest req $
|
throwM $ NC.HttpExceptionRequest req $
|
||||||
NC.StatusCodeException (const () <$> resp) $ content
|
NC.StatusCodeException (void resp) content
|
||||||
|
|
||||||
|
|
||||||
return resp
|
return resp
|
||||||
where
|
where
|
||||||
tryHttpEx :: (R.MonadResourceBase m) => (m a)
|
tryHttpEx :: (R.MonadResourceBase m) => m a
|
||||||
-> m (Either NC.HttpException a)
|
-> m (Either NC.HttpException a)
|
||||||
tryHttpEx = ExL.try
|
tryHttpEx = ExL.try
|
||||||
contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp
|
contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp
|
||||||
@ -189,7 +189,7 @@ mkQuery k mv = (k,) <$> mv
|
|||||||
-- helper function to build query parameters that are optional.
|
-- helper function to build query parameters that are optional.
|
||||||
-- don't use it with mandatory query params with empty value.
|
-- don't use it with mandatory query params with empty value.
|
||||||
mkOptionalParams :: [(Text, Maybe Text)] -> HT.Query
|
mkOptionalParams :: [(Text, Maybe Text)] -> HT.Query
|
||||||
mkOptionalParams params = HT.toQuery $ (uncurry mkQuery) <$> params
|
mkOptionalParams params = HT.toQuery $ uncurry mkQuery <$> params
|
||||||
|
|
||||||
chunkBSConduit :: (Monad m, Integral a)
|
chunkBSConduit :: (Monad m, Integral a)
|
||||||
=> [a] -> C.Conduit ByteString m ByteString
|
=> [a] -> C.Conduit ByteString m ByteString
|
||||||
@ -199,9 +199,7 @@ chunkBSConduit s = loop 0 [] s
|
|||||||
loop n readChunks (size:sizes) = do
|
loop n readChunks (size:sizes) = do
|
||||||
bsMay <- C.await
|
bsMay <- C.await
|
||||||
case bsMay of
|
case bsMay of
|
||||||
Nothing -> if n > 0
|
Nothing -> when (n > 0) $ C.yield $ B.concat readChunks
|
||||||
then C.yield $ B.concat readChunks
|
|
||||||
else return ()
|
|
||||||
Just bs -> if n + fromIntegral (B.length bs) >= size
|
Just bs -> if n + fromIntegral (B.length bs) >= size
|
||||||
then do let (a, b) = B.splitAt (fromIntegral $ size - n) bs
|
then do let (a, b) = B.splitAt (fromIntegral $ size - n) bs
|
||||||
chunkBS = B.concat $ readChunks ++ [a]
|
chunkBS = B.concat $ readChunks ++ [a]
|
||||||
|
|||||||
@ -76,7 +76,7 @@ parseListBuckets xmldata = do
|
|||||||
timeStrings = r $// s3Elem "Bucket" &// s3Elem "CreationDate" &/ content
|
timeStrings = r $// s3Elem "Bucket" &// s3Elem "CreationDate" &/ content
|
||||||
|
|
||||||
times <- mapM parseS3XMLTime timeStrings
|
times <- mapM parseS3XMLTime timeStrings
|
||||||
return $ map (\(n, t) -> BucketInfo n t) $ zip names times
|
return $ zipWith BucketInfo names times
|
||||||
|
|
||||||
-- | Parse the response XML of a location request.
|
-- | Parse the response XML of a location request.
|
||||||
parseLocation :: (MonadThrow m) => LByteString -> m Region
|
parseLocation :: (MonadThrow m) => LByteString -> m Region
|
||||||
@ -107,7 +107,7 @@ parseCopyObjectResponse xmldata = do
|
|||||||
mtimeStr = T.concat $ r $// s3Elem "LastModified" &/ content
|
mtimeStr = T.concat $ r $// s3Elem "LastModified" &/ content
|
||||||
|
|
||||||
mtime <- parseS3XMLTime mtimeStr
|
mtime <- parseS3XMLTime mtimeStr
|
||||||
return $ (T.concat $ r $// s3Elem "ETag" &/ content, mtime)
|
return (T.concat $ r $// s3Elem "ETag" &/ content, mtime)
|
||||||
|
|
||||||
-- | Parse the response XML of a list objects call.
|
-- | Parse the response XML of a list objects call.
|
||||||
parseListObjectsResponse :: (MonadThrow m)
|
parseListObjectsResponse :: (MonadThrow m)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user