From c59b7066fcf9ece059ac226e28e7de9f5004edf6 Mon Sep 17 00:00:00 2001 From: Aditya Manthramurthy Date: Thu, 10 Feb 2022 13:34:11 -0800 Subject: [PATCH] Updates from new ormolu 0.4 (#167) * Changes from formatter * Fix github action run on master branch --- .github/workflows/ci.yml | 4 +- src/Network/Minio/API.hs | 78 ++++++++++++------------ src/Network/Minio/AdminAPI.hs | 4 +- src/Network/Minio/Data.hs | 16 ++--- src/Network/Minio/Data/ByteString.hs | 2 +- src/Network/Minio/PresignedOperations.hs | 10 +-- src/Network/Minio/PutObject.hs | 12 ++-- src/Network/Minio/SelectAPI.hs | 4 +- src/Network/Minio/Sign/V4.hs | 54 ++++++++-------- src/Network/Minio/Utils.hs | 2 +- test/LiveServer.hs | 2 +- test/Spec.hs | 8 +-- 12 files changed, 98 insertions(+), 98 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 4b3feab..888ce4a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,6 +1,6 @@ name: CI -# Trigger the workflow on push or pull request, but only for the main branch +# Trigger the workflow on push or pull request, but only for the master branch on: pull_request: branches: [master] @@ -45,7 +45,7 @@ jobs: steps: - uses: actions/checkout@v2 - if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/main' + if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' - uses: haskell/actions/setup@v1 id: setup-haskell-cabal diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 2d9d49b..87c3337 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -88,10 +88,10 @@ getRegion ri = do -- getService/makeBucket/getLocation -- don't need location if | not $ riNeedsLocation ri -> - return $ Just $ connectRegion ci + return $ Just $ connectRegion ci -- if autodiscovery of location is disabled by user | not $ connectAutoDiscoverRegion ci -> - return $ Just $ connectRegion ci + return $ Just $ connectRegion ci -- discover the region for the request | otherwise -> discoverRegion ri @@ -137,10 +137,10 @@ getHostPathRegion ri = do ) if | isAWSConnectInfo ci -> - return $ - if bucketHasPeriods bucket - then pathStyle - else virtualStyle + return $ + if bucketHasPeriods bucket + then pathStyle + else virtualStyle | otherwise -> return pathStyle buildRequest :: S3ReqInfo -> Minio NC.Request @@ -196,42 +196,42 @@ buildRequest ri = do if | isJust (riPresignExpirySecs ri') -> - -- case 0 from above. - do - let signPairs = signV4 sp baseRequest - qpToAdd = (fmap . fmap) Just signPairs - existingQueryParams = HT.parseQuery (NC.queryString baseRequest) - updatedQueryParams = existingQueryParams ++ qpToAdd - return $ NClient.setQueryString updatedQueryParams baseRequest + -- case 0 from above. + do + let signPairs = signV4 sp baseRequest + qpToAdd = (fmap . fmap) Just signPairs + existingQueryParams = HT.parseQuery (NC.queryString baseRequest) + updatedQueryParams = existingQueryParams ++ qpToAdd + return $ NClient.setQueryString updatedQueryParams baseRequest | isStreamingPayload (riPayload ri') && (not $ connectIsSecure ci') -> - -- case 2 from above. - do - (pLen, pSrc) <- case riPayload ri of - PayloadC l src -> return (l, src) - _ -> throwIO MErrVUnexpectedPayload - let reqFn = signV4Stream pLen sp baseRequest - return $ reqFn pSrc + -- case 2 from above. + do + (pLen, pSrc) <- case riPayload ri of + PayloadC l src -> return (l, src) + _ -> throwIO MErrVUnexpectedPayload + let reqFn = signV4Stream pLen sp baseRequest + return $ reqFn pSrc | otherwise -> - do - sp' <- - if - | connectIsSecure ci' -> - -- case 1 described above. - return sp - | otherwise -> - -- case 3 described above. - do - pHash <- getPayloadSHA256Hash $ riPayload ri' - return $ sp {spPayloadHash = Just pHash} + do + sp' <- + if + | connectIsSecure ci' -> + -- case 1 described above. + return sp + | otherwise -> + -- case 3 described above. + do + pHash <- getPayloadSHA256Hash $ riPayload ri' + return $ sp {spPayloadHash = Just pHash} - let signHeaders = signV4 sp' baseRequest - return $ - baseRequest - { NC.requestHeaders = - NC.requestHeaders baseRequest - ++ mkHeaderFromPairs signHeaders, - NC.requestBody = getRequestBody (riPayload ri') - } + let signHeaders = signV4 sp' baseRequest + return $ + baseRequest + { NC.requestHeaders = + NC.requestHeaders baseRequest + ++ mkHeaderFromPairs signHeaders, + NC.requestBody = getRequestBody (riPayload ri') + } retryAPIRequest :: Minio a -> Minio a retryAPIRequest apiCall = do diff --git a/src/Network/Minio/AdminAPI.hs b/src/Network/Minio/AdminAPI.hs index 3c338ec..1016537 100644 --- a/src/Network/Minio/AdminAPI.hs +++ b/src/Network/Minio/AdminAPI.hs @@ -599,8 +599,8 @@ buildAdminRequest areq = do sha256Hash <- if | connectIsSecure ci -> - -- if secure connection - return "UNSIGNED-PAYLOAD" + -- if secure connection + return "UNSIGNED-PAYLOAD" -- otherwise compute sha256 | otherwise -> getPayloadSHA256Hash (ariPayload areq) diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 389efb9..4c976b9 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -226,8 +226,8 @@ getHostAddr ci = if | port == 80 || port == 443 -> toUtf8 host | otherwise -> - toUtf8 $ - T.concat [host, ":", Lib.Prelude.show port] + toUtf8 $ + T.concat [host, ":", Lib.Prelude.show port] where port = connectPort ci host = connectHost ci @@ -283,9 +283,9 @@ newtype SSECKey = SSECKey BA.ScrubbedBytes mkSSECKey :: MonadThrow m => ByteString -> m SSECKey mkSSECKey keyBytes | B.length keyBytes /= 32 = - throwM MErrVInvalidEncryptionKeyLength + throwM MErrVInvalidEncryptionKeyLength | otherwise = - return $ SSECKey $ BA.convert keyBytes + return $ SSECKey $ BA.convert keyBytes -- | Data type to represent Server-Side-Encryption settings data SSE where @@ -1079,9 +1079,9 @@ instance HasSvcNamespace MinioConn where let host = connectHost $ mcConnInfo env in if | host == "storage.googleapis.com" -> - "http://doc.s3.amazonaws.com/2006-03-01" + "http://doc.s3.amazonaws.com/2006-03-01" | otherwise -> - "http://s3.amazonaws.com/doc/2006-03-01/" + "http://s3.amazonaws.com/doc/2006-03-01/" -- | Takes connection information and returns a connection object to -- be passed to 'runMinio'. The returned value can be kept in the @@ -1091,8 +1091,8 @@ connect :: ConnectInfo -> IO MinioConn connect ci = do let settings | connectIsSecure ci && connectDisableTLSCertValidation ci = - let badTlsSettings = Conn.TLSSettingsSimple True False False - in TLS.mkManagerSettings badTlsSettings Nothing + let badTlsSettings = Conn.TLSSettingsSimple True False False + in TLS.mkManagerSettings badTlsSettings Nothing | connectIsSecure ci = NC.tlsManagerSettings | otherwise = defaultManagerSettings mgr <- NC.newManager settings diff --git a/src/Network/Minio/Data/ByteString.hs b/src/Network/Minio/Data/ByteString.hs index 09e68d5..714b42a 100644 --- a/src/Network/Minio/Data/ByteString.hs +++ b/src/Network/Minio/Data/ByteString.hs @@ -66,7 +66,7 @@ uriEncodeChar ch _ || (ch == '-') || (ch == '.') || (ch == '~') = - BB.char7 ch + BB.char7 ch | otherwise = mconcat $ map f $ B.unpack $ encodeUtf8 $ T.singleton ch where f :: Word8 -> BB.Builder diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs index 8e753ea..4ee3256 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -246,19 +246,19 @@ newPostPolicy :: newPostPolicy expirationTime conds -- object name condition must be present | not $ any (keyEquals "key") conds = - Left PPEKeyNotSpecified + Left PPEKeyNotSpecified -- bucket name condition must be present | not $ any (keyEquals "bucket") conds = - Left PPEBucketNotSpecified + Left PPEBucketNotSpecified -- a condition with an empty key is invalid | any (keyEquals "") conds || any isEmptyRangeKey conds = - Left PPEConditionKeyEmpty + Left PPEConditionKeyEmpty -- invalid range check | any isInvalidRange conds = - Left PPERangeInvalid + Left PPERangeInvalid -- all good! | otherwise = - return $ PostPolicy expirationTime conds + return $ PostPolicy expirationTime conds where keyEquals k' (PPCStartsWith k _) = k == k' keyEquals k' (PPCEquals k _) = k == k' diff --git a/src/Network/Minio/PutObject.hs b/src/Network/Minio/PutObject.hs index 3eb1552..447ecbf 100644 --- a/src/Network/Minio/PutObject.hs +++ b/src/Network/Minio/PutObject.hs @@ -71,8 +71,8 @@ putObjectInternal b o opts (ODStream src sizeMay) = do Just size -> if | size <= 64 * oneMiB -> do - bs <- C.runConduit $ src C..| takeC (fromIntegral size) C..| CB.sinkLbs - putObjectSingle' b o (pooToHeaders opts) $ LBS.toStrict bs + bs <- C.runConduit $ src C..| takeC (fromIntegral size) C..| CB.sinkLbs + putObjectSingle' b o (pooToHeaders opts) $ LBS.toStrict bs | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size | otherwise -> sequentialMultipartUpload b o opts (Just size) src putObjectInternal b o opts (ODFile fp sizeMay) = do @@ -95,13 +95,13 @@ putObjectInternal b o opts (ODFile fp sizeMay) = do Just size -> if | size <= 64 * oneMiB -> - either throwIO return - =<< withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size) + either throwIO return + =<< withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size) | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size | isSeekable -> parallelMultipartUpload b o opts fp size | otherwise -> - sequentialMultipartUpload b o opts (Just size) $ - CB.sourceFile fp + sequentialMultipartUpload b o opts (Just size) $ + CB.sourceFile fp parallelMultipartUpload :: Bucket -> diff --git a/src/Network/Minio/SelectAPI.hs b/src/Network/Minio/SelectAPI.hs index dc336e2..3863268 100644 --- a/src/Network/Minio/SelectAPI.hs +++ b/src/Network/Minio/SelectAPI.hs @@ -186,7 +186,7 @@ crcCheck = do -- 12 bytes have been read off the current message. Now read the -- next (n-12)-4 bytes and accumulate the checksum, and yield it. let startCrc = crc32 b - finalCrc <- accumulateYield (fromIntegral n -16) startCrc + finalCrc <- accumulateYield (fromIntegral n - 16) startCrc bs <- readNBytes 4 expectedCrc :: Word32 <- liftIO $ parseBinary bs @@ -276,7 +276,7 @@ selectObjectContent b o r = do riNeedsLocation = False, riQueryParams = [("select", Nothing), ("select-type", Just "2")] } - --print $ mkSelectRequest r + -- print $ mkSelectRequest r resp <- mkStreamRequest reqInfo return $ NC.responseBody resp .| selectProtoConduit diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 0d183c5..2aaeee8 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -365,41 +365,41 @@ signV4Stream !payloadLength !sp !req = -- 'chunkSizeConstant'. if | n > 0 -> do - bs <- mustTakeN chunkSizeConstant - let strToSign = chunkStrToSign prevSign (hashSHA256 bs) - nextSign = computeSignature strToSign signingKey - chunkBS = - toHexStr chunkSizeConstant - <> ";chunk-signature=" - <> nextSign - <> "\r\n" - <> bs - <> "\r\n" - C.yield chunkBS - signerConduit (n -1) lps nextSign + bs <- mustTakeN chunkSizeConstant + let strToSign = chunkStrToSign prevSign (hashSHA256 bs) + nextSign = computeSignature strToSign signingKey + chunkBS = + toHexStr chunkSizeConstant + <> ";chunk-signature=" + <> nextSign + <> "\r\n" + <> bs + <> "\r\n" + C.yield chunkBS + signerConduit (n - 1) lps nextSign -- Second case encodes the last chunk which is smaller than -- 'chunkSizeConstant' | lps > 0 -> do - bs <- mustTakeN $ fromIntegral lps - let strToSign = chunkStrToSign prevSign (hashSHA256 bs) - nextSign = computeSignature strToSign signingKey - chunkBS = - toHexStr lps <> ";chunk-signature=" - <> nextSign - <> "\r\n" - <> bs - <> "\r\n" - C.yield chunkBS - signerConduit 0 0 nextSign + bs <- mustTakeN $ fromIntegral lps + let strToSign = chunkStrToSign prevSign (hashSHA256 bs) + nextSign = computeSignature strToSign signingKey + chunkBS = + toHexStr lps <> ";chunk-signature=" + <> nextSign + <> "\r\n" + <> bs + <> "\r\n" + C.yield chunkBS + signerConduit 0 0 nextSign -- Last case encodes the final signature chunk that has no -- data. | otherwise -> do - let strToSign = chunkStrToSign prevSign (hashSHA256 "") - nextSign = computeSignature strToSign signingKey - lastChunkBS = "0;chunk-signature=" <> nextSign <> "\r\n\r\n" - C.yield lastChunkBS + let strToSign = chunkStrToSign prevSign (hashSHA256 "") + nextSign = computeSignature strToSign signingKey + lastChunkBS = "0;chunk-signature=" <> nextSign <> "\r\n\r\n" + C.yield lastChunkBS in \src -> req { NC.requestHeaders = finalReqHeaders, diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index 769f5a7..579b8e1 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -235,7 +235,7 @@ limitedMapConcurrently count act args = do waitSem t = U.atomically $ do v <- U.readTVar t if v > 0 - then U.writeTVar t (v -1) + then U.writeTVar t (v - 1) else U.retrySTM signalSem t = U.atomically $ do v <- U.readTVar t diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 8f31058..635e6f3 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -1076,7 +1076,7 @@ copyObjectTests = funTestWithBucket "copyObject related tests" $ copyObjectPart dstInfo' srcInfo' - { srcRange = Just $ (,) ((p -1) * mb5) ((p -1) * mb5 + (mb5 - 1)) + { srcRange = Just $ (,) ((p - 1) * mb5) ((p - 1) * mb5 + (mb5 - 1)) } uid (fromIntegral p) diff --git a/test/Spec.hs b/test/Spec.hs index 95e5c1a..36a7cf9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -72,11 +72,11 @@ qcProps = isMinPartSizeOk = if | nparts > 1 -> -- last part can be smaller but > 0 - all (>= minPartSize) (take (nparts - 1) sizes) - && all (\s -> s > 0) (drop (nparts - 1) sizes) + all (>= minPartSize) (take (nparts - 1) sizes) + && all (\s -> s > 0) (drop (nparts - 1) sizes) | nparts == 1 -> -- size may be 0 here. - maybe True (\x -> x >= 0 && x <= minPartSize) $ - headMay sizes + maybe True (\x -> x >= 0 && x <= minPartSize) $ + headMay sizes | otherwise -> False in n < 0 || ( isPNumsAscendingFrom1 && isOffsetsAsc && isSumSizeOk