From 9358d28d3bcbae498d4e43d7cd9ec31dcc0aeab0 Mon Sep 17 00:00:00 2001 From: Krishnan Parthasarathi Date: Sat, 25 Mar 2017 15:56:51 +0530 Subject: [PATCH] Fix hlint warnings and suggestions (#44) --- src/Network/Minio.hs | 2 +- src/Network/Minio/API.hs | 4 ++-- src/Network/Minio/Data.hs | 11 +++++------ src/Network/Minio/Data/ByteString.hs | 10 +++++----- src/Network/Minio/ListOps.hs | 5 ++--- src/Network/Minio/PutObject.hs | 4 ++-- src/Network/Minio/S3API.hs | 20 ++++++++++---------- src/Network/Minio/Sign/V4.hs | 26 ++++++++++++-------------- src/Network/Minio/Utils.hs | 18 ++++++++---------- src/Network/Minio/XmlParser.hs | 4 ++-- 10 files changed, 49 insertions(+), 55 deletions(-) diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 753fb01..5c1a94c 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -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 diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 5d16e21..240f830 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -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 } diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index bfa24aa..40a1cc6 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -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 diff --git a/src/Network/Minio/Data/ByteString.hs b/src/Network/Minio/Data/ByteString.hs index f562b97..95d2f6d 100644 --- a/src/Network/Minio/Data/ByteString.hs +++ b/src/Network/Minio/Data/ByteString.hs @@ -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 == '.') diff --git a/src/Network/Minio/ListOps.hs b/src/Network/Minio/ListOps.hs index d9b1e2f..7911115 100644 --- a/src/Network/Minio/ListOps.hs +++ b/src/Network/Minio/ListOps.hs @@ -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) -> diff --git a/src/Network/Minio/PutObject.hs b/src/Network/Minio/PutObject.hs index 771e012..3cf9183 100644 --- a/src/Network/Minio/PutObject.hs +++ b/src/Network/Minio/PutObject.hs @@ -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 diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index f860578..790c633 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -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 diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 89ae8b8..792ed20 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -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 diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index ab5d69c..fd324c2 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -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] diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 0989925..9015fc9 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -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)