Updates from new ormolu 0.4 (#167)

* Changes from formatter

* Fix github action run on master branch
This commit is contained in:
Aditya Manthramurthy 2022-02-10 13:34:11 -08:00 committed by GitHub
parent 193be59432
commit c59b7066fc
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 98 additions and 98 deletions

View File

@ -1,6 +1,6 @@
name: CI 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: on:
pull_request: pull_request:
branches: [master] branches: [master]
@ -45,7 +45,7 @@ jobs:
steps: steps:
- uses: actions/checkout@v2 - 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 - uses: haskell/actions/setup@v1
id: setup-haskell-cabal id: setup-haskell-cabal

View File

@ -88,10 +88,10 @@ getRegion ri = do
-- getService/makeBucket/getLocation -- don't need location -- getService/makeBucket/getLocation -- don't need location
if if
| not $ riNeedsLocation ri -> | not $ riNeedsLocation ri ->
return $ Just $ connectRegion ci return $ Just $ connectRegion ci
-- if autodiscovery of location is disabled by user -- if autodiscovery of location is disabled by user
| not $ connectAutoDiscoverRegion ci -> | not $ connectAutoDiscoverRegion ci ->
return $ Just $ connectRegion ci return $ Just $ connectRegion ci
-- discover the region for the request -- discover the region for the request
| otherwise -> discoverRegion ri | otherwise -> discoverRegion ri
@ -137,10 +137,10 @@ getHostPathRegion ri = do
) )
if if
| isAWSConnectInfo ci -> | isAWSConnectInfo ci ->
return $ return $
if bucketHasPeriods bucket if bucketHasPeriods bucket
then pathStyle then pathStyle
else virtualStyle else virtualStyle
| otherwise -> return pathStyle | otherwise -> return pathStyle
buildRequest :: S3ReqInfo -> Minio NC.Request buildRequest :: S3ReqInfo -> Minio NC.Request
@ -196,42 +196,42 @@ buildRequest ri = do
if if
| isJust (riPresignExpirySecs ri') -> | isJust (riPresignExpirySecs ri') ->
-- case 0 from above. -- case 0 from above.
do do
let signPairs = signV4 sp baseRequest let signPairs = signV4 sp baseRequest
qpToAdd = (fmap . fmap) Just signPairs qpToAdd = (fmap . fmap) Just signPairs
existingQueryParams = HT.parseQuery (NC.queryString baseRequest) existingQueryParams = HT.parseQuery (NC.queryString baseRequest)
updatedQueryParams = existingQueryParams ++ qpToAdd updatedQueryParams = existingQueryParams ++ qpToAdd
return $ NClient.setQueryString updatedQueryParams baseRequest return $ NClient.setQueryString updatedQueryParams baseRequest
| isStreamingPayload (riPayload ri') && (not $ connectIsSecure ci') -> | isStreamingPayload (riPayload ri') && (not $ connectIsSecure ci') ->
-- case 2 from above. -- case 2 from above.
do do
(pLen, pSrc) <- case riPayload ri of (pLen, pSrc) <- case riPayload ri of
PayloadC l src -> return (l, src) PayloadC l src -> return (l, src)
_ -> throwIO MErrVUnexpectedPayload _ -> throwIO MErrVUnexpectedPayload
let reqFn = signV4Stream pLen sp baseRequest let reqFn = signV4Stream pLen sp baseRequest
return $ reqFn pSrc return $ reqFn pSrc
| otherwise -> | otherwise ->
do do
sp' <- sp' <-
if if
| connectIsSecure ci' -> | connectIsSecure ci' ->
-- case 1 described above. -- case 1 described above.
return sp return sp
| otherwise -> | otherwise ->
-- case 3 described above. -- case 3 described above.
do do
pHash <- getPayloadSHA256Hash $ riPayload ri' pHash <- getPayloadSHA256Hash $ riPayload ri'
return $ sp {spPayloadHash = Just pHash} return $ sp {spPayloadHash = Just pHash}
let signHeaders = signV4 sp' baseRequest let signHeaders = signV4 sp' baseRequest
return $ return $
baseRequest baseRequest
{ NC.requestHeaders = { NC.requestHeaders =
NC.requestHeaders baseRequest NC.requestHeaders baseRequest
++ mkHeaderFromPairs signHeaders, ++ mkHeaderFromPairs signHeaders,
NC.requestBody = getRequestBody (riPayload ri') NC.requestBody = getRequestBody (riPayload ri')
} }
retryAPIRequest :: Minio a -> Minio a retryAPIRequest :: Minio a -> Minio a
retryAPIRequest apiCall = do retryAPIRequest apiCall = do

View File

@ -599,8 +599,8 @@ buildAdminRequest areq = do
sha256Hash <- sha256Hash <-
if if
| connectIsSecure ci -> | connectIsSecure ci ->
-- if secure connection -- if secure connection
return "UNSIGNED-PAYLOAD" return "UNSIGNED-PAYLOAD"
-- otherwise compute sha256 -- otherwise compute sha256
| otherwise -> getPayloadSHA256Hash (ariPayload areq) | otherwise -> getPayloadSHA256Hash (ariPayload areq)

View File

@ -226,8 +226,8 @@ getHostAddr ci =
if if
| port == 80 || port == 443 -> toUtf8 host | port == 80 || port == 443 -> toUtf8 host
| otherwise -> | otherwise ->
toUtf8 $ toUtf8 $
T.concat [host, ":", Lib.Prelude.show port] T.concat [host, ":", Lib.Prelude.show port]
where where
port = connectPort ci port = connectPort ci
host = connectHost ci host = connectHost ci
@ -283,9 +283,9 @@ newtype SSECKey = SSECKey BA.ScrubbedBytes
mkSSECKey :: MonadThrow m => ByteString -> m SSECKey mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
mkSSECKey keyBytes mkSSECKey keyBytes
| B.length keyBytes /= 32 = | B.length keyBytes /= 32 =
throwM MErrVInvalidEncryptionKeyLength throwM MErrVInvalidEncryptionKeyLength
| otherwise = | otherwise =
return $ SSECKey $ BA.convert keyBytes return $ SSECKey $ BA.convert keyBytes
-- | Data type to represent Server-Side-Encryption settings -- | Data type to represent Server-Side-Encryption settings
data SSE where data SSE where
@ -1079,9 +1079,9 @@ instance HasSvcNamespace MinioConn where
let host = connectHost $ mcConnInfo env let host = connectHost $ mcConnInfo env
in if in if
| host == "storage.googleapis.com" -> | host == "storage.googleapis.com" ->
"http://doc.s3.amazonaws.com/2006-03-01" "http://doc.s3.amazonaws.com/2006-03-01"
| otherwise -> | 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 -- | Takes connection information and returns a connection object to
-- be passed to 'runMinio'. The returned value can be kept in the -- be passed to 'runMinio'. The returned value can be kept in the
@ -1091,8 +1091,8 @@ connect :: ConnectInfo -> IO MinioConn
connect ci = do connect ci = do
let settings let settings
| connectIsSecure ci && connectDisableTLSCertValidation ci = | connectIsSecure ci && connectDisableTLSCertValidation ci =
let badTlsSettings = Conn.TLSSettingsSimple True False False let badTlsSettings = Conn.TLSSettingsSimple True False False
in TLS.mkManagerSettings badTlsSettings Nothing in TLS.mkManagerSettings badTlsSettings Nothing
| connectIsSecure ci = NC.tlsManagerSettings | connectIsSecure ci = NC.tlsManagerSettings
| otherwise = defaultManagerSettings | otherwise = defaultManagerSettings
mgr <- NC.newManager settings mgr <- NC.newManager settings

View File

@ -66,7 +66,7 @@ uriEncodeChar ch _
|| (ch == '-') || (ch == '-')
|| (ch == '.') || (ch == '.')
|| (ch == '~') = || (ch == '~') =
BB.char7 ch BB.char7 ch
| otherwise = mconcat $ map f $ B.unpack $ encodeUtf8 $ T.singleton ch | otherwise = mconcat $ map f $ B.unpack $ encodeUtf8 $ T.singleton ch
where where
f :: Word8 -> BB.Builder f :: Word8 -> BB.Builder

View File

@ -246,19 +246,19 @@ newPostPolicy ::
newPostPolicy expirationTime conds newPostPolicy expirationTime conds
-- object name condition must be present -- object name condition must be present
| not $ any (keyEquals "key") conds = | not $ any (keyEquals "key") conds =
Left PPEKeyNotSpecified Left PPEKeyNotSpecified
-- bucket name condition must be present -- bucket name condition must be present
| not $ any (keyEquals "bucket") conds = | not $ any (keyEquals "bucket") conds =
Left PPEBucketNotSpecified Left PPEBucketNotSpecified
-- a condition with an empty key is invalid -- a condition with an empty key is invalid
| any (keyEquals "") conds || any isEmptyRangeKey conds = | any (keyEquals "") conds || any isEmptyRangeKey conds =
Left PPEConditionKeyEmpty Left PPEConditionKeyEmpty
-- invalid range check -- invalid range check
| any isInvalidRange conds = | any isInvalidRange conds =
Left PPERangeInvalid Left PPERangeInvalid
-- all good! -- all good!
| otherwise = | otherwise =
return $ PostPolicy expirationTime conds return $ PostPolicy expirationTime conds
where where
keyEquals k' (PPCStartsWith k _) = k == k' keyEquals k' (PPCStartsWith k _) = k == k'
keyEquals k' (PPCEquals k _) = k == k' keyEquals k' (PPCEquals k _) = k == k'

View File

@ -71,8 +71,8 @@ putObjectInternal b o opts (ODStream src sizeMay) = do
Just size -> Just size ->
if if
| size <= 64 * oneMiB -> do | size <= 64 * oneMiB -> do
bs <- C.runConduit $ src C..| takeC (fromIntegral size) C..| CB.sinkLbs bs <- C.runConduit $ src C..| takeC (fromIntegral size) C..| CB.sinkLbs
putObjectSingle' b o (pooToHeaders opts) $ LBS.toStrict bs putObjectSingle' b o (pooToHeaders opts) $ LBS.toStrict bs
| size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size
| otherwise -> sequentialMultipartUpload b o opts (Just size) src | otherwise -> sequentialMultipartUpload b o opts (Just size) src
putObjectInternal b o opts (ODFile fp sizeMay) = do putObjectInternal b o opts (ODFile fp sizeMay) = do
@ -95,13 +95,13 @@ putObjectInternal b o opts (ODFile fp sizeMay) = do
Just size -> Just size ->
if if
| size <= 64 * oneMiB -> | size <= 64 * oneMiB ->
either throwIO return either throwIO return
=<< withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size) =<< withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size)
| size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size | size > maxObjectSize -> throwIO $ MErrVPutSizeExceeded size
| isSeekable -> parallelMultipartUpload b o opts fp size | isSeekable -> parallelMultipartUpload b o opts fp size
| otherwise -> | otherwise ->
sequentialMultipartUpload b o opts (Just size) $ sequentialMultipartUpload b o opts (Just size) $
CB.sourceFile fp CB.sourceFile fp
parallelMultipartUpload :: parallelMultipartUpload ::
Bucket -> Bucket ->

View File

@ -186,7 +186,7 @@ crcCheck = do
-- 12 bytes have been read off the current message. Now read the -- 12 bytes have been read off the current message. Now read the
-- next (n-12)-4 bytes and accumulate the checksum, and yield it. -- next (n-12)-4 bytes and accumulate the checksum, and yield it.
let startCrc = crc32 b let startCrc = crc32 b
finalCrc <- accumulateYield (fromIntegral n -16) startCrc finalCrc <- accumulateYield (fromIntegral n - 16) startCrc
bs <- readNBytes 4 bs <- readNBytes 4
expectedCrc :: Word32 <- liftIO $ parseBinary bs expectedCrc :: Word32 <- liftIO $ parseBinary bs
@ -276,7 +276,7 @@ selectObjectContent b o r = do
riNeedsLocation = False, riNeedsLocation = False,
riQueryParams = [("select", Nothing), ("select-type", Just "2")] riQueryParams = [("select", Nothing), ("select-type", Just "2")]
} }
--print $ mkSelectRequest r -- print $ mkSelectRequest r
resp <- mkStreamRequest reqInfo resp <- mkStreamRequest reqInfo
return $ NC.responseBody resp .| selectProtoConduit return $ NC.responseBody resp .| selectProtoConduit

View File

@ -365,41 +365,41 @@ signV4Stream !payloadLength !sp !req =
-- 'chunkSizeConstant'. -- 'chunkSizeConstant'.
if if
| n > 0 -> do | n > 0 -> do
bs <- mustTakeN chunkSizeConstant bs <- mustTakeN chunkSizeConstant
let strToSign = chunkStrToSign prevSign (hashSHA256 bs) let strToSign = chunkStrToSign prevSign (hashSHA256 bs)
nextSign = computeSignature strToSign signingKey nextSign = computeSignature strToSign signingKey
chunkBS = chunkBS =
toHexStr chunkSizeConstant toHexStr chunkSizeConstant
<> ";chunk-signature=" <> ";chunk-signature="
<> nextSign <> nextSign
<> "\r\n" <> "\r\n"
<> bs <> bs
<> "\r\n" <> "\r\n"
C.yield chunkBS C.yield chunkBS
signerConduit (n -1) lps nextSign signerConduit (n - 1) lps nextSign
-- Second case encodes the last chunk which is smaller than -- Second case encodes the last chunk which is smaller than
-- 'chunkSizeConstant' -- 'chunkSizeConstant'
| lps > 0 -> do | lps > 0 -> do
bs <- mustTakeN $ fromIntegral lps bs <- mustTakeN $ fromIntegral lps
let strToSign = chunkStrToSign prevSign (hashSHA256 bs) let strToSign = chunkStrToSign prevSign (hashSHA256 bs)
nextSign = computeSignature strToSign signingKey nextSign = computeSignature strToSign signingKey
chunkBS = chunkBS =
toHexStr lps <> ";chunk-signature=" toHexStr lps <> ";chunk-signature="
<> nextSign <> nextSign
<> "\r\n" <> "\r\n"
<> bs <> bs
<> "\r\n" <> "\r\n"
C.yield chunkBS C.yield chunkBS
signerConduit 0 0 nextSign signerConduit 0 0 nextSign
-- Last case encodes the final signature chunk that has no -- Last case encodes the final signature chunk that has no
-- data. -- data.
| otherwise -> do | otherwise -> do
let strToSign = chunkStrToSign prevSign (hashSHA256 "") let strToSign = chunkStrToSign prevSign (hashSHA256 "")
nextSign = computeSignature strToSign signingKey nextSign = computeSignature strToSign signingKey
lastChunkBS = "0;chunk-signature=" <> nextSign <> "\r\n\r\n" lastChunkBS = "0;chunk-signature=" <> nextSign <> "\r\n\r\n"
C.yield lastChunkBS C.yield lastChunkBS
in \src -> in \src ->
req req
{ NC.requestHeaders = finalReqHeaders, { NC.requestHeaders = finalReqHeaders,

View File

@ -235,7 +235,7 @@ limitedMapConcurrently count act args = do
waitSem t = U.atomically $ do waitSem t = U.atomically $ do
v <- U.readTVar t v <- U.readTVar t
if v > 0 if v > 0
then U.writeTVar t (v -1) then U.writeTVar t (v - 1)
else U.retrySTM else U.retrySTM
signalSem t = U.atomically $ do signalSem t = U.atomically $ do
v <- U.readTVar t v <- U.readTVar t

View File

@ -1076,7 +1076,7 @@ copyObjectTests = funTestWithBucket "copyObject related tests" $
copyObjectPart copyObjectPart
dstInfo' dstInfo'
srcInfo' srcInfo'
{ srcRange = Just $ (,) ((p -1) * mb5) ((p -1) * mb5 + (mb5 - 1)) { srcRange = Just $ (,) ((p - 1) * mb5) ((p - 1) * mb5 + (mb5 - 1))
} }
uid uid
(fromIntegral p) (fromIntegral p)

View File

@ -72,11 +72,11 @@ qcProps =
isMinPartSizeOk = isMinPartSizeOk =
if if
| nparts > 1 -> -- last part can be smaller but > 0 | nparts > 1 -> -- last part can be smaller but > 0
all (>= minPartSize) (take (nparts - 1) sizes) all (>= minPartSize) (take (nparts - 1) sizes)
&& all (\s -> s > 0) (drop (nparts - 1) sizes) && all (\s -> s > 0) (drop (nparts - 1) sizes)
| nparts == 1 -> -- size may be 0 here. | nparts == 1 -> -- size may be 0 here.
maybe True (\x -> x >= 0 && x <= minPartSize) $ maybe True (\x -> x >= 0 && x <= minPartSize) $
headMay sizes headMay sizes
| otherwise -> False | otherwise -> False
in n < 0 in n < 0
|| ( isPNumsAscendingFrom1 && isOffsetsAsc && isSumSizeOk || ( isPNumsAscendingFrom1 && isOffsetsAsc && isSumSizeOk