diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6efe221..6ba68b1 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -21,9 +21,15 @@ env: MINIO_SECURE: 1 jobs: + ormolu: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - uses: mrkkrp/ormolu-action@v6 cabal: name: ${{ matrix.os }} / ghc-${{ matrix.ghc }} / cabal-${{ matrix.cabal }} runs-on: ${{ matrix.os }} + needs: ormolu strategy: matrix: os: [ubuntu-latest, windows-latest] # Removed macos-latest due to cert issues. diff --git a/examples/PresignedGetObject.hs b/examples/PresignedGetObject.hs index 7a87445..5c2e8e5 100755 --- a/examples/PresignedGetObject.hs +++ b/examples/PresignedGetObject.hs @@ -77,7 +77,8 @@ main = do let hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"] curlCmd = B.intercalate " " $ - ["curl --fail"] ++ map hdrOpt headers + ["curl --fail"] + ++ map hdrOpt headers ++ ["-o /tmp/myfile", B.concat ["'", url, "'"]] putStrLn $ diff --git a/examples/PresignedPutObject.hs b/examples/PresignedPutObject.hs index b44bdee..2355dc7 100755 --- a/examples/PresignedPutObject.hs +++ b/examples/PresignedPutObject.hs @@ -48,7 +48,8 @@ main = do let hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"] curlCmd = B.intercalate " " $ - ["curl "] ++ map hdrOpt headers + ["curl "] + ++ map hdrOpt headers ++ ["-T /tmp/myfile", B.concat ["'", url, "'"]] putStrLn $ diff --git a/src/Network/Minio/AdminAPI.hs b/src/Network/Minio/AdminAPI.hs index d27e2d4..0193215 100644 --- a/src/Network/Minio/AdminAPI.hs +++ b/src/Network/Minio/AdminAPI.hs @@ -432,7 +432,9 @@ healPath bucket prefix = do if (isJust bucket) then encodeUtf8 $ - "v1/heal/" <> fromMaybe "" bucket <> "/" + "v1/heal/" + <> fromMaybe "" bucket + <> "/" <> fromMaybe "" prefix else encodeUtf8 ("v1/heal/" :: Text) @@ -611,9 +613,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 7454346..4d173a0 100644 --- a/src/Network/Minio/CopyObject.hs +++ b/src/Network/Minio/CopyObject.hs @@ -50,8 +50,8 @@ copyObjectInternal b' o srcInfo = do || (endOffset >= srcSize) ) ) - $ throwIO $ - MErrVInvalidSrcObjByteRange range + $ throwIO + $ MErrVInvalidSrcObjByteRange range -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR -- 2. If startOffset /= 0 use multipart copy diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index d367d9a..5127fc6 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -587,7 +587,8 @@ defaultGetObjectOptions = gooToHeaders :: GetObjectOptions -> [HT.Header] gooToHeaders goo = - rangeHdr ++ zip names values + rangeHdr + ++ zip names values ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo) where names = diff --git a/src/Network/Minio/ListOps.hs b/src/Network/Minio/ListOps.hs index d288af7..65860c0 100644 --- a/src/Network/Minio/ListOps.hs +++ b/src/Network/Minio/ListOps.hs @@ -143,12 +143,12 @@ listIncompleteUploads bucket prefix recurse = loop Nothing Nothing 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 44f21e2..b289a1e 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -53,9 +53,11 @@ import Network.Minio.Errors import Network.Minio.Sign.V4 import Network.URI (uriToString) +{- ORMOLU_DISABLE -} #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as A #endif +{- ORMOLU_ENABLE -} -- | Generate a presigned URL. This function allows for advanced usage -- - for simple cases prefer the `presigned*Url` functions. @@ -178,6 +180,7 @@ data PostPolicyCondition | PPCRange Text Int64 Int64 deriving stock (Show, Eq) +{- ORMOLU_DISABLE -} instance Json.ToJSON PostPolicyCondition where toJSON (PPCStartsWith k v) = Json.toJSON ["starts-with", k, v] #if MIN_VERSION_aeson(2,0,0) @@ -196,6 +199,7 @@ instance Json.ToJSON PostPolicyCondition where #endif toEncoding (PPCRange k minVal maxVal) = Json.foldable [Json.toJSON k, Json.toJSON minVal, Json.toJSON maxVal] +{- ORMOLU_ENABLE -} -- | A PostPolicy is required to perform uploads via browser forms. data PostPolicy = PostPolicy @@ -338,7 +342,8 @@ presignedPostPolicy p = do url = toStrictBS $ toLazyByteString $ - scheme <> byteString (getHostAddr ci) + scheme + <> byteString (getHostAddr ci) <> byteString "/" <> byteString bucket <> byteString "/" diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 77befdf..f8fbd4e 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -131,7 +131,8 @@ parseGetObjectHeaders object headers = let metadataPairs = getMetadata headers userMetadata = getUserMetadataMap metadataPairs metadata = getNonUserMetadataMap metadataPairs - in ObjectInfo <$> Just object + in ObjectInfo + <$> Just object <*> getLastModifiedHeader headers <*> getETagHeader headers <*> getContentLength headers @@ -387,8 +388,8 @@ srcInfoToHeaders srcInfo = "/", srcObject srcInfo ] - ) : - rangeHdr + ) + : rangeHdr ++ zip names values where names = @@ -519,14 +520,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' :: diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 37e8950..4338b45 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 = @@ -385,7 +385,8 @@ signV4Stream !payloadLength !sp !req = let strToSign = chunkStrToSign prevSign (hashSHA256 bs) nextSign = computeSignature strToSign signingKey chunkBS = - toHexStr lps <> ";chunk-signature=" + toHexStr lps + <> ";chunk-signature=" <> nextSign <> "\r\n" <> bs diff --git a/src/Network/Minio/XmlGenerator.hs b/src/Network/Minio/XmlGenerator.hs index a2c381f..6c84e5f 100644 --- a/src/Network/Minio/XmlGenerator.hs +++ b/src/Network/Minio/XmlGenerator.hs @@ -105,7 +105,8 @@ instance ToXNode Notification where toXNodesWithArnName :: Text -> Text -> NotificationConfig -> XNode toXNodesWithArnName eltName arnName (NotificationConfig itemId arn events fRule) = XNode eltName $ - [XLeaf "Id" itemId, XLeaf arnName arn] ++ map toXNode events + [XLeaf "Id" itemId, XLeaf arnName arn] + ++ map toXNode events ++ [toXNode fRule] instance ToXNode Filter where diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 94a2f29..b537082 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -235,7 +235,8 @@ parseNotification xmldata = do qcfg = map node $ r $/ s3Elem' "QueueConfiguration" tcfg = map node $ r $/ s3Elem' "TopicConfiguration" lcfg = map node $ r $/ s3Elem' "CloudFunctionConfiguration" - Notification <$> (mapM (parseNode ns "Queue") qcfg) + Notification + <$> (mapM (parseNode ns "Queue") qcfg) <*> (mapM (parseNode ns "Topic") tcfg) <*> (mapM (parseNode ns "CloudFunction") lcfg) where @@ -249,8 +250,11 @@ parseNotification xmldata = do arn = T.concat $ c $/ s3Elem ns arnName &/ content events = catMaybes $ map textToEvent $ c $/ s3Elem ns "Event" &/ content rules = - c $/ s3Elem ns "Filter" &/ s3Elem ns "S3Key" - &/ s3Elem ns "FilterRule" &| getFilterRule ns + c + $/ s3Elem ns "Filter" + &/ s3Elem ns "S3Key" + &/ s3Elem ns "FilterRule" + &| getFilterRule ns return $ NotificationConfig itemId @@ -264,6 +268,7 @@ parseSelectProgress xmldata = do let bScanned = T.concat $ r $/ element "BytesScanned" &/ content bProcessed = T.concat $ r $/ element "BytesProcessed" &/ content bReturned = T.concat $ r $/ element "BytesReturned" &/ content - Progress <$> parseDecimal bScanned + Progress + <$> parseDecimal bScanned <*> parseDecimal bProcessed <*> parseDecimal bReturned diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 194dbeb..1efd549 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -136,7 +136,8 @@ basicTests = funTestWithBucket "Basic tests" $ unless (length (filter (== bucket) $ map biName buckets) == 1) $ liftIO $ assertFailure - ( "The bucket " ++ show bucket + ( "The bucket " + ++ show bucket ++ " was expected to exist." ) @@ -367,11 +368,11 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ 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 @@ -385,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 $ diff --git a/test/Spec.hs b/test/Spec.hs index 418e04f..e0c0b09 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -79,7 +79,9 @@ qcProps = listToMaybe sizes | otherwise -> False in n < 0 - || ( isPNumsAscendingFrom1 && isOffsetsAsc && isSumSizeOk + || ( isPNumsAscendingFrom1 + && isOffsetsAsc + && isSumSizeOk && isSizesConstantExceptLast && isMinPartSizeOk ), @@ -105,7 +107,8 @@ qcProps = isContParts = length fsts == length snds && and (map (\(a, b) -> a == b + 1) $ zip fsts snds) - in start < 0 || start > end + in start < 0 + || start > end || (isLastPartOk && isFirstPartOk && isPartSizesOk && isContParts), QC.testProperty "mkSSECKey:" $ \w8s ->