haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Update with changes for ormolu 0.5.0.0 (#171)

Browse Source 
- Add ormolu check to CI
This commit is contained in:
Aditya Manthramurthy 2022-05-27 12:07:28 -07:00 committed by GitHub
parent 7b6547aca0
commit b91a7afd6b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
14 changed files with 89 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.github/workflows/ci.yml vendored
View File

@ -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.

3
examples/PresignedGetObject.hs
View File

@ -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 $

3
examples/PresignedPutObject.hs
View File

@ -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 $

10
src/Network/Minio/AdminAPI.hs
View File

@ -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 =

4
src/Network/Minio/CopyObject.hs
View File

@ -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

3
src/Network/Minio/Data.hs
View File

@ -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 =

6
src/Network/Minio/ListOps.hs
View File

@ -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)

7
src/Network/Minio/PresignedOperations.hs
View File

@ -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 "/"

23
src/Network/Minio/S3API.hs
View File

@ -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' ::

23
src/Network/Minio/Sign/V4.hs
View File

@ -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

3
src/Network/Minio/XmlGenerator.hs
View File

@ -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

13
src/Network/Minio/XmlParser.hs
View File

@ -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

39
test/LiveServer.hs
View File

@ -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 $

7
test/Spec.hs
View File

@ -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 ->