haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix hlint warnings and suggestions (#44)

Browse Source
This commit is contained in:
Krishnan Parthasarathi 2017-03-25 15:56:51 +05:30 committed by Aditya Manthramurthy
parent b30beecd52
commit 9358d28d3b
10 changed files with 49 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Network/Minio.hs
View File

@ -134,7 +134,7 @@ getObject bucket object = snd <$> getObject' bucket object [] []
-- | Get an object's metadata from the object store.
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
-- optionally specified. If not specified, it will use the region

4
src/Network/Minio/API.hs
View File

@ -108,7 +108,7 @@ buildRequest ri = do
regionHost <- case region of
Nothing -> return $ connectHost ci
Just r -> if "amazonaws.com" `T.isSuffixOf` (connectHost ci)
Just r -> if "amazonaws.com" `T.isSuffixOf` connectHost ci
then maybe
(throwM $ MErrVRegionNotSupported r)
return
@ -118,7 +118,7 @@ buildRequest ri = do
sha256Hash <- getPayloadSHA256Hash (riPayload ri)
let newRi = ri { riPayloadHash = sha256Hash
, riHeaders = sha256Header sha256Hash : (riHeaders ri)
, riHeaders = sha256Header sha256Hash : riHeaders ri
, riRegion = region
}
newCi = ci { connectHost = regionHost }

11
src/Network/Minio/Data.hs
View File

@ -248,12 +248,12 @@ instance Default CopyPartSource where
cpsToHeaders :: CopyPartSource -> [HT.Header]
cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
(rangeHdr ++ (zip names values))
rangeHdr ++ zip names values
where
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-modified-since"]
values = concatMap (maybeToList . fmap encodeUtf8 . (cps &))
values = mapMaybe (fmap encodeUtf8 . (cps &))
[cpSourceIfMatch, cpSourceIfNoneMatch,
fmap formatRFC1123 . cpSourceIfUnmodifiedSince,
fmap formatRFC1123 . cpSourceIfModifiedSince]
@ -261,8 +261,7 @@ cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
. HT.renderByteRanges
. (:[])
. uncurry HT.ByteRangeFromTo
<$> (map (both fromIntegral) $
maybeToList $ cpSourceRange cps)
<$> map (both fromIntegral) (maybeToList $ cpSourceRange cps)
-- | Extract the source bucket and source object name. TODO: validate
-- 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
getPathFromRI :: RequestInfo -> ByteString
getPathFromRI ri = B.concat $ parts
getPathFromRI ri = B.concat parts
where
objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ riObject 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
conn <- liftIO $ connect ci
flip evalStateT Map.empty . flip runReaderT conn . unMinio $
(m >>= (return . Right)) `MC.catches`
fmap Right m `MC.catches`
[ MC.Handler handlerServiceErr
, MC.Handler handlerHE
, MC.Handler handlerFE

10
src/Network/Minio/Data/ByteString.hs
View File

@ -25,7 +25,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC8
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 Numeric (showHex)
@ -40,7 +40,7 @@ class UriEncodable s where
instance UriEncodable [Char] where
uriEncode encodeSlash payload =
LB.toStrict $ BB.toLazyByteString $ mconcat $
map (flip uriEncodeChar encodeSlash) payload
map (`uriEncodeChar` encodeSlash) payload
instance UriEncodable ByteString where
-- assumes that uriEncode is passed ASCII encoded strings.
@ -58,9 +58,9 @@ uriEncodeChar :: Char -> Bool -> BB.Builder
uriEncodeChar '/' True = BB.byteString "%2F"
uriEncodeChar '/' False = BB.char7 '/'
uriEncodeChar ch _
| (ch >= 'A' && ch <= 'Z')
|| (ch >= 'a' && ch <= 'z')
|| (ch >= '0' && ch <= '9')
| isAsciiUpper ch
|| isAsciiLower ch
|| isDigit ch
|| (ch == '_')
|| (ch == '-')
|| (ch == '.')

5
src/Network/Minio/ListOps.hs
View File

@ -55,10 +55,9 @@ listIncompleteUploads bucket prefix recurse = loop Nothing Nothing
res <- lift $ listIncompleteUploads' bucket prefix delimiter
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
return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0
$ partInfos
return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos
CL.sourceList $
map (\((uKey, uId, uInitTime), size) ->

4
src/Network/Minio/PutObject.hs
View File

@ -124,7 +124,7 @@ checkUploadNeeded :: Payload -> PartNumber
checkUploadNeeded payload n pmap = do
(md5hash, pSize) <- case payload of
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)
(Just $ fromIntegral size)
case Map.lookup n pmap of
@ -266,7 +266,7 @@ multiPartCopyObject b o cps srcSize = do
copiedParts <- limitedMapConcurrently 10
(\(pn, cps') -> do
(etag, _) <- copyObjectPart b o cps' uid pn []
return $ (pn, etag)
return (pn, etag)
)
partSources

20
src/Network/Minio/S3API.hs
View File

@ -97,7 +97,7 @@ getObject' :: Bucket -> Object -> HT.Query -> [HT.Header]
-> Minio ([HT.Header], C.ResumableSource Minio ByteString)
getObject' bucket object queryParams headers = do
resp <- mkStreamRequest reqInfo
return $ (NC.responseHeaders resp, NC.responseBody resp)
return (NC.responseHeaders resp, NC.responseBody resp)
where
reqInfo = def { riBucket = Just bucket
, riObject = Just object
@ -107,8 +107,8 @@ getObject' bucket object queryParams headers = do
-- | Creates a bucket via a PUT bucket call.
putBucket :: Bucket -> Region -> Minio ()
putBucket bucket location = do
void $ executeRequest $
putBucket bucket location = void $
executeRequest $
def { riMethod = HT.methodPut
, riBucket = Just bucket
, riPayload = PayloadBS $ mkCreateBucketConfig location
@ -163,16 +163,16 @@ listObjects' bucket prefix nextToken delimiter = do
-- | DELETE a bucket from the service.
deleteBucket :: Bucket -> Minio ()
deleteBucket bucket = do
void $ executeRequest $
deleteBucket bucket = void $
executeRequest $
def { riMethod = HT.methodDelete
, riBucket = Just bucket
}
-- | DELETE an object from the service.
deleteObject :: Bucket -> Object -> Minio ()
deleteObject bucket object = do
void $ executeRequest $
deleteObject bucket object = void $
executeRequest $
def { riMethod = HT.methodDelete
, riBucket = Just bucket
, riObject = Just object
@ -267,8 +267,8 @@ completeMultipartUpload bucket object uploadId partTuple = do
-- | Abort a multipart upload.
abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio ()
abortMultipartUpload bucket object uploadId = do
void $ executeRequest $ def { riMethod = HT.methodDelete
abortMultipartUpload bucket object uploadId = void $
executeRequest $ def { riMethod = HT.methodDelete
, riBucket = Just bucket
, riObject = Just object
, riQueryParams = mkOptionalParams params
@ -355,4 +355,4 @@ headBucket bucket = headBucketEx `catches`
resp <- executeRequest $ def { riMethod = HT.methodHead
, riBucket = Just bucket
}
return $ (NC.responseStatus resp) == HT.ok200
return $ NC.responseStatus resp == HT.ok200

26
src/Network/Minio/Sign/V4.hs
View File

@ -98,10 +98,10 @@ signV4AtTime ts ci ri =
outHeaders = authHeader : headersWithDate
timeBS = awsTimeFormatBS ts
dateHeader = (mk "X-Amz-Date", timeBS)
hostHeader = (mk "host", encodeUtf8 $ format "{}:{}" $
hostHeader = (mk "host", encodeUtf8 $ format "{}:{}"
[connectHost ci, show $ connectPort ci])
headersWithDate = dateHeader : hostHeader : (riHeaders ri)
headersWithDate = dateHeader : hostHeader : riHeaders ri
authHeader = (mk "Authorization", authHeaderValue)
@ -126,20 +126,20 @@ signV4AtTime ts ci ri =
. hmacSHA256RawBS "s3"
. hmacSHA256RawBS (encodeUtf8 region)
. hmacSHA256RawBS (awsDateFormatBS ts)
$ (B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci])
$ B.concat ["AWS4", encodeUtf8 $ connectSecretKey ci]
stringToSign = B.intercalate "\n" $
["AWS4-HMAC-SHA256",
timeBS,
scope,
hashSHA256 $ canonicalRequest
stringToSign = B.intercalate "\n"
[ "AWS4-HMAC-SHA256"
, timeBS
, scope
, hashSHA256 canonicalRequest
]
canonicalRequest = getCanonicalRequest ri headersToSign
getScope :: UTCTime -> Region -> ByteString
getScope ts region = B.intercalate "/" $ [
getScope ts region = B.intercalate "/" [
pack $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts,
encodeUtf8 region, "s3", "aws4_request"
]
@ -148,11 +148,10 @@ getHeadersToSign :: [Header] -> [(ByteString, ByteString)]
getHeadersToSign h =
sort $
filter (flip Set.notMember ignoredHeaders . fst) $
map (\(x, y) -> (CI.foldedCase x, stripBS y)) $
h
map (\(x, y) -> (CI.foldedCase x, stripBS y)) h
getCanonicalRequest :: RequestInfo -> [(ByteString, ByteString)] -> ByteString
getCanonicalRequest ri headersForSign = B.intercalate "\n" $ [
getCanonicalRequest ri headersForSign = B.intercalate "\n" [
riMethod ri,
uriEncode False path,
canonicalQueryString,
@ -170,7 +169,6 @@ getCanonicalRequest ri headersForSign = B.intercalate "\n" $ [
riQueryParams ri
canonicalHeaders = B.concat $
map (\(x, y) -> B.concat [x, ":", y, "\n"]) $
headersForSign
map (\(x, y) -> B.concat [x, ":", y, "\n"]) headersForSign
signedHeaders = B.intercalate ";" $ map fst headersForSign

18
src/Network/Minio/Utils.hs
View File

@ -117,7 +117,7 @@ httpLbs :: (R.MonadThrow m, MonadIO m)
=> NC.Request -> NC.Manager
-> m (NC.Response LByteString)
httpLbs req mgr = do
respE <- liftIO $ tryHttpEx $ (NC.httpLbs req mgr)
respE <- liftIO $ tryHttpEx $ NC.httpLbs req mgr
resp <- either throwM return respE
unless (isSuccessStatus $ NC.responseStatus resp) $
case contentTypeMay resp of
@ -126,11 +126,11 @@ httpLbs req mgr = do
throwM sErr
_ -> throwM $ NC.HttpExceptionRequest req $
NC.StatusCodeException (const () <$> resp) (show resp)
NC.StatusCodeException (void resp) (show resp)
return resp
where
tryHttpEx :: (IO (NC.Response LByteString))
tryHttpEx :: IO (NC.Response LByteString)
-> IO (Either NC.HttpException (NC.Response LByteString))
tryHttpEx = try
contentTypeMay resp = lookupHeader Hdr.hContentType $
@ -146,18 +146,18 @@ http req mgr = do
case contentTypeMay resp of
Just "application/xml" -> do
respBody <- NC.responseBody resp C.$$+- CB.sinkLbs
sErr <- parseErrResponse $ respBody
sErr <- parseErrResponse respBody
throwM sErr
_ -> do
content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp
throwM $ NC.HttpExceptionRequest req $
NC.StatusCodeException (const () <$> resp) $ content
NC.StatusCodeException (void resp) content
return resp
where
tryHttpEx :: (R.MonadResourceBase m) => (m a)
tryHttpEx :: (R.MonadResourceBase m) => m a
-> m (Either NC.HttpException a)
tryHttpEx = ExL.try
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.
-- don't use it with mandatory query params with empty value.
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)
=> [a] -> C.Conduit ByteString m ByteString
@ -199,9 +199,7 @@ chunkBSConduit s = loop 0 [] s
loop n readChunks (size:sizes) = do
bsMay <- C.await
case bsMay of
Nothing -> if n > 0
then C.yield $ B.concat readChunks
else return ()
Nothing -> when (n > 0) $ C.yield $ B.concat readChunks
Just bs -> if n + fromIntegral (B.length bs) >= size
then do let (a, b) = B.splitAt (fromIntegral $ size - n) bs
chunkBS = B.concat $ readChunks ++ [a]

4
src/Network/Minio/XmlParser.hs
View File

@ -76,7 +76,7 @@ parseListBuckets xmldata = do
timeStrings = r $// s3Elem "Bucket" &// s3Elem "CreationDate" &/ content
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.
parseLocation :: (MonadThrow m) => LByteString -> m Region
@ -107,7 +107,7 @@ parseCopyObjectResponse xmldata = do
mtimeStr = T.concat $ r $// s3Elem "LastModified" &/ content
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.
parseListObjectsResponse :: (MonadThrow m)