diff --git a/examples/ListIncompleteUploads.hs b/examples/ListIncompleteUploads.hs index b41da7a..4b17389 100755 --- a/examples/ListIncompleteUploads.hs +++ b/examples/ListIncompleteUploads.hs @@ -34,9 +34,9 @@ main = do -- Performs a recursive listing of incomplete uploads under bucket "test" -- on a local minio server. res <- - runMinio minioPlayCI - $ runConduit - $ listIncompleteUploads bucket Nothing True .| mapM_C (\v -> (liftIO $ print v)) + runMinio minioPlayCI $ + runConduit $ + listIncompleteUploads bucket Nothing True .| mapM_C (\v -> (liftIO $ print v)) print res {- diff --git a/examples/ListObjects.hs b/examples/ListObjects.hs index 924615f..a25917e 100755 --- a/examples/ListObjects.hs +++ b/examples/ListObjects.hs @@ -34,9 +34,9 @@ main = do -- Performs a recursive listing of all objects under bucket "test" -- on play.min.io. res <- - runMinio minioPlayCI - $ runConduit - $ listObjects bucket Nothing True .| mapM_C (\v -> (liftIO $ print v)) + runMinio minioPlayCI $ + runConduit $ + listObjects bucket Nothing True .| mapM_C (\v -> (liftIO $ print v)) print res {- diff --git a/examples/PresignedPostPolicy.hs b/examples/PresignedPostPolicy.hs index 310a188..05d1d4d 100755 --- a/examples/PresignedPostPolicy.hs +++ b/examples/PresignedPostPolicy.hs @@ -73,8 +73,9 @@ main = do ] formOptions = B.intercalate " " $ map formFn $ H.toList formData - return $ B.intercalate " " $ - ["curl", formOptions, "-F file=@/tmp/photo.jpg", url] + return $ + B.intercalate " " $ + ["curl", formOptions, "-F file=@/tmp/photo.jpg", url] case res of Left e -> putStrLn $ "post-policy error: " ++ (show e) diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 5642945..7a30d9e 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -55,6 +55,7 @@ module Network.Minio gcsCI, -- * Minio Monad + ---------------- -- | The Minio Monad provides connection-reuse, bucket-location diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 7444218..eb8d113 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -186,9 +186,9 @@ buildRequest ri = do retryAPIRequest :: Minio a -> Minio a retryAPIRequest apiCall = do resE <- - retrying retryPolicy (const shouldRetry) - $ const - $ try apiCall + retrying retryPolicy (const shouldRetry) $ + const $ + try apiCall either throwIO return resE where -- Retry using the full-jitter backoff method for up to 10 mins @@ -266,9 +266,9 @@ isValidBucketName bucket = -- Throws exception iff bucket name is invalid according to AWS rules. checkBucketNameValidity :: MonadIO m => Bucket -> m () checkBucketNameValidity bucket = - when (not $ isValidBucketName bucket) - $ throwIO - $ MErrVInvalidBucketName bucket + when (not $ isValidBucketName bucket) $ + throwIO $ + MErrVInvalidBucketName bucket isValidObjectName :: Object -> Bool isValidObjectName object = @@ -276,6 +276,6 @@ isValidObjectName object = checkObjectNameValidity :: MonadIO m => Object -> m () checkObjectNameValidity object = - when (not $ isValidObjectName object) - $ throwIO - $ MErrVInvalidObjectName object + when (not $ isValidObjectName object) $ + throwIO $ + MErrVInvalidObjectName object diff --git a/src/Network/Minio/AdminAPI.hs b/src/Network/Minio/AdminAPI.hs index dcada23..3c338ec 100644 --- a/src/Network/Minio/AdminAPI.hs +++ b/src/Network/Minio/AdminAPI.hs @@ -16,7 +16,8 @@ module Network.Minio.AdminAPI ( -- * MinIO Admin API - -------------------- + + -------------------- -- | Provides MinIO admin API and related types. It is in -- experimental state. @@ -52,10 +53,7 @@ module Network.Minio.AdminAPI where import Data.Aeson - ( (.:), - (.:?), - (.=), - FromJSON, + ( FromJSON, ToJSON, Value (Object), eitherDecode, @@ -66,6 +64,9 @@ import Data.Aeson toJSON, withObject, withText, + (.:), + (.:?), + (.=), ) import qualified Data.Aeson as A import Data.Aeson.Types (typeMismatch) @@ -610,9 +611,9 @@ buildAdminRequest areq = do areq { ariPayloadHash = Just sha256Hash, ariHeaders = - hostHeader - : sha256Header sha256Hash - : ariHeaders areq + hostHeader : + sha256Header sha256Hash : + ariHeaders areq } signReq = toRequest ci newAreq sp = diff --git a/src/Network/Minio/CopyObject.hs b/src/Network/Minio/CopyObject.hs index 36c4443..c5adaaa 100644 --- a/src/Network/Minio/CopyObject.hs +++ b/src/Network/Minio/CopyObject.hs @@ -51,8 +51,8 @@ copyObjectInternal b' o srcInfo = do endOffset >= fromIntegral srcSize ] ) - $ throwIO - $ MErrVInvalidSrcObjByteRange range + $ throwIO $ + MErrVInvalidSrcObjByteRange range -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR -- 2. If startOffset /= 0 use multipart copy @@ -69,9 +69,9 @@ copyObjectInternal b' o srcInfo = do -- used is minPartSize. selectCopyRanges :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))] selectCopyRanges (st, end) = - zip pns - $ map (\(x, y) -> (st + x, st + x + y - 1)) - $ zip startOffsets partSizes + zip pns $ + map (\(x, y) -> (st + x, st + x + y - 1)) $ + zip startOffsets partSizes where size = end - st + 1 (pns, startOffsets, partSizes) = List.unzip3 $ selectPartSizes size diff --git a/src/Network/Minio/Data/ByteString.hs b/src/Network/Minio/Data/ByteString.hs index 00ddb22..09e68d5 100644 --- a/src/Network/Minio/Data/ByteString.hs +++ b/src/Network/Minio/Data/ByteString.hs @@ -38,8 +38,10 @@ class UriEncodable s where instance UriEncodable [Char] where uriEncode encodeSlash payload = - LB.toStrict $ BB.toLazyByteString $ mconcat $ - map (`uriEncodeChar` encodeSlash) payload + LB.toStrict $ + BB.toLazyByteString $ + mconcat $ + map (`uriEncodeChar` encodeSlash) payload instance UriEncodable ByteString where -- assumes that uriEncode is passed ASCII encoded strings. diff --git a/src/Network/Minio/JsonParser.hs b/src/Network/Minio/JsonParser.hs index 901fd8e..9d0ce46 100644 --- a/src/Network/Minio/JsonParser.hs +++ b/src/Network/Minio/JsonParser.hs @@ -20,11 +20,11 @@ module Network.Minio.JsonParser where import Data.Aeson - ( (.:), - FromJSON, + ( FromJSON, eitherDecode, parseJSON, withObject, + (.:), ) import qualified Data.Text as T import Lib.Prelude diff --git a/src/Network/Minio/ListOps.hs b/src/Network/Minio/ListOps.hs index 42050ec..723370c 100644 --- a/src/Network/Minio/ListOps.hs +++ b/src/Network/Minio/ListOps.hs @@ -51,10 +51,10 @@ listObjects bucket prefix recurse = loop Nothing res <- lift $ listObjects' bucket prefix nextToken delimiter Nothing CL.sourceList $ map ListItemObject $ lorObjects res - unless recurse - $ CL.sourceList - $ map ListItemPrefix - $ lorCPrefixes res + unless recurse $ + CL.sourceList $ + map ListItemPrefix $ + lorCPrefixes res when (lorHasMore res) $ loop (lorNextToken res) @@ -73,10 +73,10 @@ listObjectsV1 bucket prefix recurse = loop Nothing res <- lift $ listObjectsV1' bucket prefix nextMarker delimiter Nothing CL.sourceList $ map ListItemObject $ lorObjects' res - unless recurse - $ CL.sourceList - $ map ListItemPrefix - $ lorCPrefixes' res + unless recurse $ + CL.sourceList $ + map ListItemPrefix $ + lorCPrefixes' res when (lorHasMore' res) $ loop (lorNextMarker res) @@ -104,19 +104,20 @@ listIncompleteUploads bucket prefix recurse = loop Nothing Nothing nextUploadIdMarker Nothing - aggrSizes <- lift $ forM (lurUploads res) $ \(uKey, uId, _) -> do - partInfos <- - C.runConduit $ - listIncompleteParts bucket uKey uId - C..| CC.sinkList - return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos + aggrSizes <- lift $ + forM (lurUploads res) $ \(uKey, uId, _) -> do + partInfos <- + C.runConduit $ + listIncompleteParts bucket uKey uId + C..| CC.sinkList + return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos - CL.sourceList - $ map + CL.sourceList $ + map ( \((uKey, uId, uInitTime), size) -> UploadInfo uKey uId uInitTime size ) - $ zip (lurUploads res) aggrSizes + $ zip (lurUploads res) aggrSizes when (lurHasMore res) $ loop (lurNextKey res) (lurNextUpload res) diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs index 9c7f37f..81bafa8 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -68,9 +68,9 @@ makePresignedUrl :: HT.RequestHeaders -> Minio ByteString makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do - when (expiry > 7 * 24 * 3600 || expiry < 0) - $ throwIO - $ MErrVInvalidUrlExpiry expiry + when (expiry > 7 * 24 * 3600 || expiry < 0) $ + throwIO $ + MErrVInvalidUrlExpiry expiry ci <- asks mcConnInfo @@ -103,11 +103,13 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do ((HT.parseQuery $ NC.queryString req) ++ qpToAdd) scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci - return $ toStrictBS $ toLazyByteString $ - scheme - <> byteString (getHostAddr ci) - <> byteString (getS3Path bucket object) - <> queryStr + return $ + toStrictBS $ + toLazyByteString $ + scheme + <> byteString (getHostAddr ci) + <> byteString (getS3Path bucket object) + <> queryStr -- | Generate a URL with authentication signature to PUT (upload) an -- object. Any extra headers if passed, are signed, and so they are @@ -331,18 +333,21 @@ presignedPostPolicy p = do mkPair (PPCEquals k v) = Just (k, v) mkPair _ = Nothing formFromPolicy = - H.map toUtf8 $ H.fromList $ catMaybes $ - mkPair <$> conditions ppWithCreds + H.map toUtf8 $ + H.fromList $ + catMaybes $ + mkPair <$> conditions ppWithCreds formData = formFromPolicy `H.union` signData -- compute POST upload URL bucket = H.lookupDefault "" "bucket" formData scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci region = connectRegion ci url = - toStrictBS $ toLazyByteString $ - scheme <> byteString (getHostAddr ci) - <> byteString "/" - <> byteString bucket - <> byteString "/" + toStrictBS $ + toLazyByteString $ + scheme <> byteString (getHostAddr ci) + <> byteString "/" + <> byteString bucket + <> byteString "/" return (url, formData) diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index f016951..38dfe47 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -19,10 +19,12 @@ module Network.Minio.S3API getLocation, -- * Listing buckets + -------------------- getService, -- * Listing objects + -------------------- ListObjectsResult (..), ListObjectsV1Result (..), @@ -33,11 +35,13 @@ module Network.Minio.S3API headBucket, -- * Retrieving objects + ----------------------- getObject', headObject, -- * Creating buckets and objects + --------------------------------- putBucket, ETag, @@ -47,6 +51,7 @@ module Network.Minio.S3API copyObjectSingle, -- * Multipart Upload APIs + -------------------------- UploadId, PartTuple, @@ -63,11 +68,13 @@ module Network.Minio.S3API listIncompleteParts', -- * Deletion APIs + -------------------------- deleteBucket, deleteObject, -- * Presigned Operations + ----------------------------- module Network.Minio.PresignedOperations, @@ -76,6 +83,7 @@ module Network.Minio.S3API setBucketPolicy, -- * Bucket Notifications + ------------------------- Notification (..), NotificationConfig (..), @@ -157,24 +165,26 @@ getObject' bucket object queryParams headers = do { riBucket = Just bucket, riObject = Just object, riQueryParams = queryParams, - riHeaders = headers - -- This header is required for safety as otherwise http-client, - -- sends Accept-Encoding: gzip, and the server may actually gzip - -- body. In that case Content-Length header will be missing. - <> [("Accept-Encoding", "identity")] + riHeaders = + headers + -- This header is required for safety as otherwise http-client, + -- sends Accept-Encoding: gzip, and the server may actually gzip + -- body. In that case Content-Length header will be missing. + <> [("Accept-Encoding", "identity")] } -- | Creates a bucket via a PUT bucket call. putBucket :: Bucket -> Region -> Minio () putBucket bucket location = do ns <- asks getSvcNamespace - void $ executeRequest $ - defaultS3ReqInfo - { riMethod = HT.methodPut, - riBucket = Just bucket, - riPayload = PayloadBS $ mkCreateBucketConfig ns location, - riNeedsLocation = False - } + void $ + executeRequest $ + defaultS3ReqInfo + { riMethod = HT.methodPut, + riBucket = Just bucket, + riPayload = PayloadBS $ mkCreateBucketConfig ns location, + riNeedsLocation = False + } -- | Single PUT object size. maxSinglePutObjectSizeBytes :: Int64 @@ -188,9 +198,9 @@ putObjectSingle' :: Bucket -> Object -> [HT.Header] -> ByteString -> Minio ETag putObjectSingle' bucket object headers bs = do let size = fromIntegral (BS.length bs) -- check length is within single PUT object size. - when (size > maxSinglePutObjectSizeBytes) - $ throwIO - $ MErrVSinglePUTSizeExceeded size + when (size > maxSinglePutObjectSizeBytes) $ + throwIO $ + MErrVSinglePUTSizeExceeded size let payload = mkStreamingPayload $ PayloadBS bs resp <- @@ -222,9 +232,9 @@ putObjectSingle :: Minio ETag putObjectSingle bucket object headers h offset size = do -- check length is within single PUT object size. - when (size > maxSinglePutObjectSizeBytes) - $ throwIO - $ MErrVSinglePUTSizeExceeded size + when (size > maxSinglePutObjectSizeBytes) $ + throwIO $ + MErrVSinglePUTSizeExceeded size -- content-length header is automatically set by library. let payload = mkStreamingPayload $ PayloadH h offset size @@ -301,23 +311,23 @@ listObjects' bucket prefix nextToken delimiter maxKeys = do -- | DELETE a bucket from the service. deleteBucket :: Bucket -> Minio () deleteBucket bucket = - void - $ executeRequest - $ defaultS3ReqInfo - { riMethod = HT.methodDelete, - riBucket = Just bucket - } + void $ + executeRequest $ + defaultS3ReqInfo + { riMethod = HT.methodDelete, + riBucket = Just bucket + } -- | DELETE an object from the service. deleteObject :: Bucket -> Object -> Minio () deleteObject bucket object = - void - $ executeRequest - $ defaultS3ReqInfo - { riMethod = HT.methodDelete, - riBucket = Just bucket, - riObject = Just object - } + void $ + executeRequest $ + defaultS3ReqInfo + { riMethod = HT.methodDelete, + riBucket = Just bucket, + riObject = Just object + } -- | Create a new multipart upload. newMultipartUpload :: Bucket -> Object -> [HT.Header] -> Minio UploadId @@ -377,8 +387,8 @@ srcInfoToHeaders srcInfo = "/", srcObject srcInfo ] - ) - : rangeHdr + ) : + rangeHdr ++ zip names values where names = @@ -477,14 +487,14 @@ completeMultipartUpload bucket object uploadId partTuple = do -- | Abort a multipart upload. abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio () abortMultipartUpload bucket object uploadId = - void - $ executeRequest - $ defaultS3ReqInfo - { riMethod = HT.methodDelete, - riBucket = Just bucket, - riObject = Just object, - riQueryParams = mkOptionalParams params - } + void $ + executeRequest $ + defaultS3ReqInfo + { riMethod = HT.methodDelete, + riBucket = Just bucket, + riObject = Just object, + riQueryParams = mkOptionalParams params + } where params = [("uploadId", Just uploadId)] @@ -509,14 +519,14 @@ listIncompleteUploads' bucket prefix delimiter keyMarker uploadIdMarker maxKeys where -- build query params params = - ("uploads", Nothing) - : mkOptionalParams - [ ("prefix", prefix), - ("delimiter", delimiter), - ("key-marker", keyMarker), - ("upload-id-marker", uploadIdMarker), - ("max-uploads", show <$> maxKeys) - ] + ("uploads", Nothing) : + mkOptionalParams + [ ("prefix", prefix), + ("delimiter", delimiter), + ("key-marker", keyMarker), + ("upload-id-marker", uploadIdMarker), + ("max-uploads", show <$> maxKeys) + ] -- | List parts of an ongoing multipart upload. listIncompleteParts' :: @@ -553,15 +563,16 @@ headObject bucket object reqHeaders = do { riMethod = HT.methodHead, riBucket = Just bucket, riObject = Just object, - riHeaders = reqHeaders - -- This header is required for safety as otherwise http-client, - -- sends Accept-Encoding: gzip, and the server may actually gzip - -- body. In that case Content-Length header will be missing. - <> [("Accept-Encoding", "identity")] + riHeaders = + reqHeaders + -- This header is required for safety as otherwise http-client, + -- sends Accept-Encoding: gzip, and the server may actually gzip + -- body. In that case Content-Length header will be missing. + <> [("Accept-Encoding", "identity")] } - maybe (throwIO MErrVInvalidObjectInfoResponse) return - $ parseGetObjectHeaders object - $ NC.responseHeaders resp + maybe (throwIO MErrVInvalidObjectInfoResponse) return $ + parseGetObjectHeaders object $ + NC.responseHeaders resp -- | Query the object store if a given bucket exists. headBucket :: Bucket -> Minio Bool @@ -594,15 +605,16 @@ headBucket bucket = putBucketNotification :: Bucket -> Notification -> Minio () putBucketNotification bucket ncfg = do ns <- asks getSvcNamespace - void $ executeRequest $ - defaultS3ReqInfo - { riMethod = HT.methodPut, - riBucket = Just bucket, - riQueryParams = [("notification", Nothing)], - riPayload = - PayloadBS $ - mkPutNotificationRequest ns ncfg - } + void $ + executeRequest $ + defaultS3ReqInfo + { riMethod = HT.methodPut, + riBucket = Just bucket, + riQueryParams = [("notification", Nothing)], + riPayload = + PayloadBS $ + mkPutNotificationRequest ns ncfg + } -- | Retrieve the notification configuration on a bucket. getBucketNotification :: Bucket -> Minio Notification @@ -644,20 +656,22 @@ setBucketPolicy bucket policy = do -- | Save a new policy on a bucket. putBucketPolicy :: Bucket -> Text -> Minio () putBucketPolicy bucket policy = do - void $ executeRequest $ - defaultS3ReqInfo - { riMethod = HT.methodPut, - riBucket = Just bucket, - riQueryParams = [("policy", Nothing)], - riPayload = PayloadBS $ encodeUtf8 policy - } + void $ + executeRequest $ + defaultS3ReqInfo + { riMethod = HT.methodPut, + riBucket = Just bucket, + riQueryParams = [("policy", Nothing)], + riPayload = PayloadBS $ encodeUtf8 policy + } -- | Delete any policy set on a bucket. deleteBucketPolicy :: Bucket -> Minio () deleteBucketPolicy bucket = do - void $ executeRequest $ - defaultS3ReqInfo - { riMethod = HT.methodDelete, - riBucket = Just bucket, - riQueryParams = [("policy", Nothing)] - } + void $ + executeRequest $ + defaultS3ReqInfo + { riMethod = HT.methodDelete, + riBucket = Just bucket, + riQueryParams = [("policy", Nothing)] + } diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 6f3e7aa..923d946 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -198,14 +198,14 @@ mkCanonicalRequest :: ByteString mkCanonicalRequest !isStreaming !sp !req !headersForSign = let canonicalQueryString = - B.intercalate "&" - $ map (\(x, y) -> B.concat [x, "=", y]) - $ sort - $ map - ( \(x, y) -> - (uriEncode True x, maybe "" (uriEncode True) y) - ) - $ (parseQuery $ NC.queryString req) + B.intercalate "&" $ + map (\(x, y) -> B.concat [x, "=", y]) $ + sort $ + map + ( \(x, y) -> + (uriEncode True x, maybe "" (uriEncode True) y) + ) + $ (parseQuery $ NC.queryString req) sortedHeaders = sort headersForSign canonicalHeaders = B.concat $ @@ -298,8 +298,8 @@ signV4Stream !payloadLength !sp !req = in case ceMay of Nothing -> ("content-encoding", "aws-chunked") : hs Just (_, ce) -> - ("content-encoding", ce <> ",aws-chunked") - : filter (\(x, _) -> x /= "content-encoding") hs + ("content-encoding", ce <> ",aws-chunked") : + filter (\(x, _) -> x /= "content-encoding") hs -- headers to be added to the request datePair = ("X-Amz-Date", awsTimeFormatBS ts) computedHeaders = diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index 79f2c0f..769f5a7 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -170,8 +170,9 @@ httpLbs req mgr = do sErr <- parseErrResponseJSON $ NC.responseBody resp throwIO sErr _ -> - throwIO $ NC.HttpExceptionRequest req $ - NC.StatusCodeException (void resp) (showBS resp) + throwIO $ + NC.HttpExceptionRequest req $ + NC.StatusCodeException (void resp) (showBS resp) return resp where @@ -199,8 +200,9 @@ http req mgr = do throwIO sErr _ -> do content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp - throwIO $ NC.HttpExceptionRequest req $ - NC.StatusCodeException (void resp) content + throwIO $ + NC.HttpExceptionRequest req $ + NC.StatusCodeException (void resp) content return resp where @@ -265,9 +267,9 @@ chunkBSConduit (s : ss) = do -- be 64MiB. selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)] selectPartSizes size = - uncurry (List.zip3 [1 ..]) - $ List.unzip - $ loop 0 size + uncurry (List.zip3 [1 ..]) $ + List.unzip $ + loop 0 size where ceil :: Double -> Int64 ceil = ceiling diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 8ecd36a..fb97874 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -56,9 +56,9 @@ uncurry6 f (a, b, c, d, e, g) = f a b c d e g -- | Parse time strings from XML parseS3XMLTime :: MonadIO m => Text -> m UTCTime parseS3XMLTime t = - maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return - $ parseTimeM True defaultTimeLocale s3TimeFormat - $ T.unpack t + maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return $ + parseTimeM True defaultTimeLocale s3TimeFormat $ + T.unpack t parseDecimal :: (MonadIO m, Integral a) => Text -> m a parseDecimal numStr = diff --git a/test/LiveServer.hs b/test/LiveServer.hs index f0fa3ae..b07fcc2 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -134,12 +134,12 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do step "getService works and contains the test bucket." buckets <- getService - unless (length (filter (== bucket) $ map biName buckets) == 1) - $ liftIO - $ assertFailure - ( "The bucket " ++ show bucket - ++ " was expected to exist." - ) + unless (length (filter (== bucket) $ map biName buckets) == 1) $ + liftIO $ + assertFailure + ( "The bucket " ++ show bucket + ++ " was expected to exist." + ) step "makeBucket again to check if BucketAlreadyOwnedByYou exception is raised." mbE <- try $ makeBucket bucket Nothing @@ -361,22 +361,24 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ step "High-level listing of objects" items <- C.runConduit $ listObjects bucket Nothing False C..| sinkList - liftIO $ assertEqual "Objects/Dirs match failed!" expectedNonRecList $ - extractObjectsAndDirsFromList items + liftIO $ + assertEqual "Objects/Dirs match failed!" expectedNonRecList $ + extractObjectsAndDirsFromList items step "High-level recursive listing of objects" objects <- C.runConduit $ listObjects bucket Nothing True C..| sinkList - liftIO - $ assertEqual + liftIO $ + assertEqual "Objects match failed!" (Just $ sort expectedObjects) - $ extractObjectsFromList objects + $ extractObjectsFromList objects step "High-level listing of objects (version 1)" itemsV1 <- C.runConduit $ listObjectsV1 bucket Nothing False C..| sinkList - liftIO $ assertEqual "Objects/Dirs match failed!" expectedNonRecList $ - extractObjectsAndDirsFromList itemsV1 + liftIO $ + assertEqual "Objects/Dirs match failed!" expectedNonRecList $ + extractObjectsAndDirsFromList itemsV1 step "High-level recursive listing of objects (version 1)" objectsV1 <- @@ -384,45 +386,45 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ listObjectsV1 bucket Nothing True C..| sinkList - liftIO - $ assertEqual + liftIO $ + assertEqual "Objects match failed!" (Just $ sort expectedObjects) - $ extractObjectsFromList objectsV1 + $ extractObjectsFromList objectsV1 let expectedPrefListing = ["dir/o1", "dir/dir1/", "dir/dir2/"] expectedPrefListingRec = Just ["dir/dir1/o2", "dir/dir2/o3", "dir/o1"] step "High-level listing with prefix" prefItems <- C.runConduit $ listObjects bucket (Just "dir/") False C..| sinkList - liftIO - $ assertEqual + liftIO $ + assertEqual "Objects/Dirs under prefix match failed!" expectedPrefListing - $ extractObjectsAndDirsFromList prefItems + $ extractObjectsAndDirsFromList prefItems step "High-level listing with prefix recursive" prefItemsRec <- C.runConduit $ listObjects bucket (Just "dir/") True C..| sinkList - liftIO - $ assertEqual + liftIO $ + assertEqual "Objects/Dirs under prefix match recursive failed!" expectedPrefListingRec - $ extractObjectsFromList prefItemsRec + $ extractObjectsFromList prefItemsRec step "High-level listing with prefix (version 1)" prefItemsV1 <- C.runConduit $ listObjectsV1 bucket (Just "dir/") False C..| sinkList - liftIO - $ assertEqual + liftIO $ + assertEqual "Objects/Dirs under prefix match failed!" expectedPrefListing - $ extractObjectsAndDirsFromList prefItemsV1 + $ extractObjectsAndDirsFromList prefItemsV1 step "High-level listing with prefix recursive (version 1)" prefItemsRecV1 <- C.runConduit $ listObjectsV1 bucket (Just "dir/") True C..| sinkList - liftIO - $ assertEqual + liftIO $ + assertEqual "Objects/Dirs under prefix match recursive failed!" expectedPrefListingRec - $ extractObjectsFromList prefItemsRecV1 + $ extractObjectsFromList prefItemsRecV1 step "Cleanup actions" forM_ expectedObjects $ @@ -910,8 +912,9 @@ putObjectUserMetadataTest = funTestWithBucket "putObject user-metadata test" $ let m = oiUserMetadata oi -- need to do a case-insensitive comparison sortedMeta = - sort $ map (\(k, v) -> (T.toLower k, T.toLower v)) $ - H.toList m + sort $ + map (\(k, v) -> (T.toLower k, T.toLower v)) $ + H.toList m ref = sort [("mykey1", "myval1"), ("mykey2", "myval2")] liftIO $ (sortedMeta == ref) @? "Metadata mismatch!" @@ -944,8 +947,9 @@ getObjectTest = funTestWithBucket "getObject test" $ let m = oiUserMetadata $ gorObjectInfo gor -- need to do a case-insensitive comparison sortedMeta = - sort $ map (\(k, v) -> (T.toLower k, T.toLower v)) $ - H.toList m + sort $ + map (\(k, v) -> (T.toLower k, T.toLower v)) $ + H.toList m ref = sort [("mykey1", "myval1"), ("mykey2", "myval2")] liftIO $ (sortedMeta == ref) @? "Metadata mismatch!" diff --git a/test/Network/Minio/API/Test.hs b/test/Network/Minio/API/Test.hs index 7b9b9d6..e35b8a8 100644 --- a/test/Network/Minio/API/Test.hs +++ b/test/Network/Minio/API/Test.hs @@ -63,8 +63,9 @@ parseServerInfoJSONTest = testGroup "Parse MinIO Admin API ServerInfo JSON test" $ map ( \(tName, tDesc, tfn, tVal) -> - testCase tName $ assertBool tDesc $ - tfn (eitherDecode tVal :: Either [Char] [ServerInfo]) + testCase tName $ + assertBool tDesc $ + tfn (eitherDecode tVal :: Either [Char] [ServerInfo]) ) testCases where @@ -82,8 +83,9 @@ parseHealStatusTest = testGroup "Parse MinIO Admin API HealStatus JSON test" $ map ( \(tName, tDesc, tfn, tVal) -> - testCase tName $ assertBool tDesc $ - tfn (eitherDecode tVal :: Either [Char] HealStatus) + testCase tName $ + assertBool tDesc $ + tfn (eitherDecode tVal :: Either [Char] HealStatus) ) testCases where @@ -101,8 +103,9 @@ parseHealStartRespTest = testGroup "Parse MinIO Admin API HealStartResp JSON test" $ map ( \(tName, tDesc, tfn, tVal) -> - testCase tName $ assertBool tDesc $ - tfn (eitherDecode tVal :: Either [Char] HealStartResp) + testCase tName $ + assertBool tDesc $ + tfn (eitherDecode tVal :: Either [Char] HealStartResp) ) testCases where diff --git a/test/Network/Minio/JsonParser/Test.hs b/test/Network/Minio/JsonParser/Test.hs index a60a209..fbf4102 100644 --- a/test/Network/Minio/JsonParser/Test.hs +++ b/test/Network/Minio/JsonParser/Test.hs @@ -43,9 +43,9 @@ testParseErrResponseJSON :: Assertion testParseErrResponseJSON = do -- 1. Test parsing of an invalid error json. parseResE <- tryValidationErr $ parseErrResponseJSON "ClearlyInvalidJSON" - when (isRight parseResE) - $ assertFailure - $ "Parsing should have failed => " ++ show parseResE + when (isRight parseResE) $ + assertFailure $ + "Parsing should have failed => " ++ show parseResE forM_ cases $ \(jsondata, sErr) -> do parseErr <- tryValidationErr $ parseErrResponseJSON jsondata diff --git a/test/Network/Minio/XmlParser/Test.hs b/test/Network/Minio/XmlParser/Test.hs index f2ad52a..65aac09 100644 --- a/test/Network/Minio/XmlParser/Test.hs +++ b/test/Network/Minio/XmlParser/Test.hs @@ -62,9 +62,9 @@ testParseLocation :: Assertion testParseLocation = do -- 1. Test parsing of an invalid location constraint xml. parseResE <- tryValidationErr $ parseLocation "ClearlyInvalidXml" - when (isRight parseResE) - $ assertFailure - $ "Parsing should have failed => " ++ show parseResE + when (isRight parseResE) $ + assertFailure $ + "Parsing should have failed => " ++ show parseResE forM_ cases $ \(xmldata, expectedLocation) -> do parseLocE <- tryValidationErr $ parseLocation xmldata @@ -344,11 +344,12 @@ testParseNotification = do "1" "arn:aws:sqs:us-west-2:444455556666:s3notificationqueue" [ObjectCreatedPut] - ( Filter $ FilterKey $ - FilterRules - [ FilterRule "prefix" "images/", - FilterRule "suffix" ".jpg" - ] + ( Filter $ + FilterKey $ + FilterRules + [ FilterRule "prefix" "images/", + FilterRule "suffix" ".jpg" + ] ), NotificationConfig ""