diff --git a/examples/FileUploader.hs b/examples/FileUploader.hs index dde340f..c5f3555 100755 --- a/examples/FileUploader.hs +++ b/examples/FileUploader.hs @@ -70,5 +70,5 @@ main = do fPutObject bucket object filepath defaultPutObjectOptions case res of - Left e -> putStrLn $ "file upload failed due to " ++ (show e) + Left e -> putStrLn $ "file upload failed due to " ++ show e Right () -> putStrLn "file upload succeeded." diff --git a/examples/GetConfig.hs b/examples/GetConfig.hs index 249a2c7..364affa 100755 --- a/examples/GetConfig.hs +++ b/examples/GetConfig.hs @@ -16,7 +16,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -- -{-# LANGUAGE OverloadedStrings #-} import Network.Minio import Network.Minio.AdminAPI @@ -25,6 +24,7 @@ import Prelude main :: IO () main = do res <- - runMinio minioPlayCI $ + runMinio + minioPlayCI getConfig print res diff --git a/examples/GetObject.hs b/examples/GetObject.hs index ffd2c1e..97d9b2d 100755 --- a/examples/GetObject.hs +++ b/examples/GetObject.hs @@ -37,5 +37,5 @@ main = do C.connect (gorObjectStream src) $ CB.sinkFileCautious "/tmp/my-object" case res of - Left e -> putStrLn $ "getObject failed." ++ (show e) + Left e -> putStrLn $ "getObject failed." ++ show e Right _ -> putStrLn "getObject succeeded." diff --git a/examples/Heal.hs b/examples/Heal.hs index 35a9a20..0d9e5e1 100755 --- a/examples/Heal.hs +++ b/examples/Heal.hs @@ -16,7 +16,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -- -{-# LANGUAGE OverloadedStrings #-} import Network.Minio import Network.Minio.AdminAPI diff --git a/examples/ListIncompleteUploads.hs b/examples/ListIncompleteUploads.hs index 4b17389..6313766 100755 --- a/examples/ListIncompleteUploads.hs +++ b/examples/ListIncompleteUploads.hs @@ -36,7 +36,7 @@ main = do res <- runMinio minioPlayCI $ runConduit $ - listIncompleteUploads bucket Nothing True .| mapM_C (\v -> (liftIO $ print v)) + listIncompleteUploads bucket Nothing True .| mapM_C (liftIO . print) print res {- diff --git a/examples/ListObjects.hs b/examples/ListObjects.hs index a25917e..58a42ff 100755 --- a/examples/ListObjects.hs +++ b/examples/ListObjects.hs @@ -36,7 +36,7 @@ main = do res <- runMinio minioPlayCI $ runConduit $ - listObjects bucket Nothing True .| mapM_C (\v -> (liftIO $ print v)) + listObjects bucket Nothing True .| mapM_C (liftIO . print) print res {- diff --git a/examples/PresignedGetObject.hs b/examples/PresignedGetObject.hs index 5c2e8e5..5add112 100755 --- a/examples/PresignedGetObject.hs +++ b/examples/PresignedGetObject.hs @@ -46,7 +46,7 @@ main = do res <- runMinio minioPlayCI $ do liftIO $ B.putStrLn "Upload a file that we will fetch with a presigned URL..." putObject bucket object (CC.repeat "a") (Just kb15) defaultPutObjectOptions - liftIO $ putStrLn $ "Done. Object created at: my-bucket/my-object" + liftIO $ putStrLn "Done. Object created at: my-bucket/my-object" -- Extract Etag of uploaded object oi <- statObject bucket object defaultGetObjectOptions diff --git a/examples/PresignedPostPolicy.hs b/examples/PresignedPostPolicy.hs index 05d1d4d..ac1f9bb 100755 --- a/examples/PresignedPostPolicy.hs +++ b/examples/PresignedPostPolicy.hs @@ -55,7 +55,7 @@ main = do ] case policyE of - Left err -> putStrLn $ show err + Left err -> print err Right policy -> do res <- runMinio minioPlayCI $ do (url, formData) <- presignedPostPolicy policy @@ -74,13 +74,14 @@ main = do formOptions = B.intercalate " " $ map formFn $ H.toList formData return $ - B.intercalate " " $ + B.intercalate + " " ["curl", formOptions, "-F file=@/tmp/photo.jpg", url] case res of - Left e -> putStrLn $ "post-policy error: " ++ (show e) + Left e -> putStrLn $ "post-policy error: " ++ show e Right cmd -> do - putStrLn $ "Put a photo at /tmp/photo.jpg and run command:\n" + putStrLn "Put a photo at /tmp/photo.jpg and run command:\n" -- print the generated curl command Char8.putStrLn cmd diff --git a/examples/SelectObject.hs b/examples/SelectObject.hs index 033ddeb..f4c5ab1 100755 --- a/examples/SelectObject.hs +++ b/examples/SelectObject.hs @@ -19,7 +19,7 @@ {-# LANGUAGE OverloadedStrings #-} import qualified Conduit as C -import Control.Monad (when) +import Control.Monad (unless) import Network.Minio import Prelude @@ -35,7 +35,7 @@ main = do res <- runMinio minioPlayCI $ do exists <- bucketExists bucket - when (not exists) $ + unless exists $ makeBucket bucket Nothing C.liftIO $ putStrLn "Uploading csv object" diff --git a/examples/ServerInfo.hs b/examples/ServerInfo.hs index a11ec07..bc24a1c 100755 --- a/examples/ServerInfo.hs +++ b/examples/ServerInfo.hs @@ -16,7 +16,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -- -{-# LANGUAGE OverloadedStrings #-} import Network.Minio import Network.Minio.AdminAPI @@ -25,6 +24,7 @@ import Prelude main :: IO () main = do res <- - runMinio minioPlayCI $ + runMinio + minioPlayCI getServerInfo print res diff --git a/examples/ServiceSendRestart.hs b/examples/ServiceSendRestart.hs index a8f565b..70b89df 100755 --- a/examples/ServiceSendRestart.hs +++ b/examples/ServiceSendRestart.hs @@ -16,7 +16,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -- -{-# LANGUAGE OverloadedStrings #-} import Network.Minio import Network.Minio.AdminAPI diff --git a/examples/ServiceSendStop.hs b/examples/ServiceSendStop.hs index b4fd277..56a1167 100755 --- a/examples/ServiceSendStop.hs +++ b/examples/ServiceSendStop.hs @@ -16,7 +16,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -- -{-# LANGUAGE OverloadedStrings #-} import Network.Minio import Network.Minio.AdminAPI diff --git a/examples/ServiceStatus.hs b/examples/ServiceStatus.hs index 39739be..60a7bcd 100755 --- a/examples/ServiceStatus.hs +++ b/examples/ServiceStatus.hs @@ -16,7 +16,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -- -{-# LANGUAGE OverloadedStrings #-} import Network.Minio import Network.Minio.AdminAPI @@ -25,6 +24,7 @@ import Prelude main :: IO () main = do res <- - runMinio minioPlayCI $ + runMinio + minioPlayCI serviceStatus print res diff --git a/minio-hs.cabal b/minio-hs.cabal index 0c8650b..14a38d3 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -58,6 +58,7 @@ common base-settings , DerivingStrategies , FlexibleContexts , FlexibleInstances + , LambdaCase , MultiParamTypeClasses , MultiWayIf , OverloadedStrings diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 87c3337..a4f7633 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -130,18 +130,18 @@ getHostPathRegion ri = do regionMay ) virtualStyle = - ( ( bucket <> "." <> regionHost, - encodeUtf8 $ "/" <> fromMaybe "" (riObject ri), - regionMay - ) + ( bucket <> "." <> regionHost, + encodeUtf8 $ "/" <> fromMaybe "" (riObject ri), + regionMay ) - if - | isAWSConnectInfo ci -> - return $ - if bucketHasPeriods bucket - then pathStyle - else virtualStyle - | otherwise -> return pathStyle + ( if isAWSConnectInfo ci + then + return $ + if bucketHasPeriods bucket + then pathStyle + else virtualStyle + else return pathStyle + ) buildRequest :: S3ReqInfo -> Minio NC.Request buildRequest ri = do @@ -203,7 +203,7 @@ buildRequest ri = do existingQueryParams = HT.parseQuery (NC.queryString baseRequest) updatedQueryParams = existingQueryParams ++ qpToAdd return $ NClient.setQueryString updatedQueryParams baseRequest - | isStreamingPayload (riPayload ri') && (not $ connectIsSecure ci') -> + | isStreamingPayload (riPayload ri') && not (connectIsSecure ci') -> -- case 2 from above. do (pLen, pSrc) <- case riPayload ri of @@ -214,15 +214,16 @@ buildRequest ri = do | otherwise -> do sp' <- - if - | connectIsSecure ci' -> - -- case 1 described above. - return sp - | otherwise -> - -- case 3 described above. + ( if connectIsSecure ci' + then -- case 1 described above. + return sp + else + ( -- case 3 described above. do pHash <- getPayloadSHA256Hash $ riPayload ri' return $ sp {spPayloadHash = Just pHash} + ) + ) let signHeaders = signV4 sp' baseRequest return $ @@ -285,8 +286,8 @@ isValidBucketName bucket = not ( or [ len < 3 || len > 63, - or (map labelCheck labels), - or (map labelCharsCheck labels), + any labelCheck labels, + any labelCharsCheck labels, isIPCheck ] ) @@ -316,7 +317,7 @@ isValidBucketName bucket = -- Throws exception iff bucket name is invalid according to AWS rules. checkBucketNameValidity :: MonadIO m => Bucket -> m () checkBucketNameValidity bucket = - when (not $ isValidBucketName bucket) $ + unless (isValidBucketName bucket) $ throwIO $ MErrVInvalidBucketName bucket @@ -326,6 +327,6 @@ isValidObjectName object = checkObjectNameValidity :: MonadIO m => Object -> m () checkObjectNameValidity object = - when (not $ isValidObjectName object) $ + unless (isValidObjectName object) $ throwIO $ MErrVInvalidObjectName object diff --git a/src/Network/Minio/AdminAPI.hs b/src/Network/Minio/AdminAPI.hs index 0193215..b15598c 100644 --- a/src/Network/Minio/AdminAPI.hs +++ b/src/Network/Minio/AdminAPI.hs @@ -429,7 +429,7 @@ instance FromJSON HealStatus where healPath :: Maybe Bucket -> Maybe Text -> ByteString healPath bucket prefix = do - if (isJust bucket) + if isJust bucket then encodeUtf8 $ "v1/heal/" @@ -599,12 +599,11 @@ buildAdminRequest :: AdminReqInfo -> Minio NC.Request buildAdminRequest areq = do ci <- asks mcConnInfo sha256Hash <- - if - | connectIsSecure ci -> - -- if secure connection - return "UNSIGNED-PAYLOAD" - -- otherwise compute sha256 - | otherwise -> getPayloadSHA256Hash (ariPayload areq) + if connectIsSecure ci + then -- if secure connection + return "UNSIGNED-PAYLOAD" + else -- otherwise compute sha256 + getPayloadSHA256Hash (ariPayload areq) timeStamp <- liftIO getCurrentTime diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 5127fc6..a49098e 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -161,7 +161,7 @@ findFirst (f : fs) = do fromAWSConfigFile :: Provider fromAWSConfigFile = do credsE <- runExceptT $ do - homeDir <- lift $ getHomeDirectory + homeDir <- lift getHomeDirectory let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials" fileExists <- lift $ doesFileExist awsCredsFile bool (throwE "FileNotFound") (return ()) fileExists @@ -201,7 +201,7 @@ setCredsFrom ps ci = do pMay <- findFirst ps maybe (throwIO MErrVMissingCredentials) - (return . (flip setCreds ci)) + (return . (`setCreds` ci)) pMay -- | setCreds sets the given `Credentials` in the `ConnectInfo`. @@ -234,11 +234,11 @@ disableTLSCertValidation c = c {connectDisableTLSCertValidation = True} getHostAddr :: ConnectInfo -> ByteString getHostAddr ci = - if - | port == 80 || port == 443 -> encodeUtf8 host - | otherwise -> - encodeUtf8 $ - T.concat [host, ":", show port] + if port == 80 || port == 443 + then encodeUtf8 host + else + encodeUtf8 $ + T.concat [host, ":", show port] where port = connectPort ci host = connectHost ci @@ -382,12 +382,12 @@ addXAmzMetaPrefix s | otherwise = "X-Amz-Meta-" <> s mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header] -mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ x, encodeUtf8 y)) +mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix x, encodeUtf8 y)) pooToHeaders :: PutObjectOptions -> [HT.Header] pooToHeaders poo = userMetadata - ++ (catMaybes $ map tupToMaybe (zipWith (,) names values)) + ++ mapMaybe tupToMaybe (zip names values) ++ maybe [] toPutObjectHeaders (pooSSE poo) where tupToMaybe (k, Just v) = Just (k, v) @@ -658,7 +658,7 @@ textToEvent t = case t of _ -> Nothing -- | Filter data type - part of notification configuration -data Filter = Filter +newtype Filter = Filter { fFilter :: FilterKey } deriving stock (Show, Eq) @@ -669,7 +669,7 @@ defaultFilter :: Filter defaultFilter = Filter defaultFilterKey -- | FilterKey contains FilterRules, and is part of a Filter. -data FilterKey = FilterKey +newtype FilterKey = FilterKey { fkKey :: FilterRules } deriving stock (Show, Eq) @@ -680,7 +680,7 @@ defaultFilterKey :: FilterKey defaultFilterKey = FilterKey defaultFilterRules -- | FilterRules represents a collection of `FilterRule`s. -data FilterRules = FilterRules +newtype FilterRules = FilterRules { frFilterRules :: [FilterRule] } deriving stock (Show, Eq) @@ -856,21 +856,15 @@ type CSVInputProp = CSVProp -- | CSVProp represents CSV format properties. It is built up using -- the Monoid instance. -data CSVProp = CSVProp (H.HashMap Text Text) +newtype CSVProp = CSVProp (H.HashMap Text Text) deriving stock (Show, Eq) -#if (__GLASGOW_HASKELL__ >= 804) instance Semigroup CSVProp where - (CSVProp a) <> (CSVProp b) = CSVProp (b <> a) -#endif + (CSVProp a) <> (CSVProp b) = CSVProp (b <> a) instance Monoid CSVProp where mempty = CSVProp mempty -#if (__GLASGOW_HASKELL__ < 804) - mappend (CSVProp a) (CSVProp b) = CSVProp (b <> a) -#endif - csvPropsList :: CSVProp -> [(Text, Text)] csvPropsList (CSVProp h) = sort $ H.toList h @@ -927,9 +921,9 @@ setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p} -- | Set the CSV format properties in the OutputSerialization. outputCSVFromProps :: CSVProp -> OutputSerialization -outputCSVFromProps p = OutputSerializationCSV p +outputCSVFromProps = OutputSerializationCSV -data JSONInputProp = JSONInputProp {jsonipType :: JSONType} +newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType} deriving stock (Show, Eq) data JSONType = JSONTypeDocument | JSONTypeLines @@ -957,7 +951,7 @@ quoteFields q = CSVProp $ data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways deriving stock (Show, Eq) -data JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text} +newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text} deriving stock (Show, Eq) -- | Set the output record delimiter for JSON format @@ -1089,11 +1083,10 @@ class HasSvcNamespace env where instance HasSvcNamespace MinioConn where getSvcNamespace env = let host = connectHost $ mcConnInfo env - in if - | host == "storage.googleapis.com" -> - "http://doc.s3.amazonaws.com/2006-03-01" - | otherwise -> - "http://s3.amazonaws.com/doc/2006-03-01/" + in ( if host == "storage.googleapis.com" + then "http://doc.s3.amazonaws.com/2006-03-01" + else "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 diff --git a/src/Network/Minio/ListOps.hs b/src/Network/Minio/ListOps.hs index 65860c0..ac71252 100644 --- a/src/Network/Minio/ListOps.hs +++ b/src/Network/Minio/ListOps.hs @@ -143,12 +143,15 @@ listIncompleteUploads bucket prefix recurse = loop Nothing Nothing C..| CC.sinkList return $ foldl' (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos - CL.sourceList - $ map - ( \((uKey, uId, uInitTime), size) -> - UploadInfo uKey uId uInitTime size + CL.sourceList $ + zipWith + ( curry + ( \((uKey, uId, uInitTime), size) -> + UploadInfo uKey uId uInitTime size + ) ) - $ zip (lurUploads res) aggrSizes + (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 b289a1e..dadca93 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -210,7 +210,7 @@ data PostPolicy = PostPolicy instance Json.ToJSON PostPolicy where toJSON (PostPolicy e c) = - Json.object $ + Json.object [ "expiration" .= iso8601TimeFormat e, "conditions" .= c ] @@ -298,7 +298,7 @@ presignedPostPolicy :: Minio (ByteString, H.HashMap Text ByteString) presignedPostPolicy p = do ci <- asks mcConnInfo - signTime <- liftIO $ Time.getCurrentTime + signTime <- liftIO Time.getCurrentTime let extraConditions = [ PPCEquals "x-amz-date" (toText $ awsTimeFormat signTime), @@ -332,8 +332,9 @@ presignedPostPolicy p = do formFromPolicy = H.map encodeUtf8 $ H.fromList $ - catMaybes $ - mkPair <$> conditions ppWithCreds + mapMaybe + mkPair + (conditions ppWithCreds) formData = formFromPolicy `H.union` signData -- compute POST upload URL bucket = H.lookupDefault "" "bucket" formData diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index f8fbd4e..80555f0 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -407,8 +407,7 @@ srcInfoToHeaders srcInfo = fmap formatRFC1123 . srcIfModifiedSince ] rangeHdr = - maybe [] (\a -> [("x-amz-copy-source-range", HT.renderByteRanges [a])]) $ - toByteRange <$> srcRange srcInfo + maybe [] ((\a -> [("x-amz-copy-source-range", HT.renderByteRanges [a])]) . toByteRange) (srcRange srcInfo) toByteRange :: (Int64, Int64) -> HT.ByteRange toByteRange (x, y) = HT.ByteRangeFromTo (fromIntegral x) (fromIntegral y) diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 4338b45..86d604b 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -130,9 +130,9 @@ signV4 !sp !req = datePair = ("X-Amz-Date", awsTimeFormatBS ts) computedHeaders = NC.requestHeaders req - ++ if isJust $ expiry + ++ if isJust expiry then [] - else map (\(x, y) -> (mk x, y)) [datePair, sha256Hdr] + else map (first mk) [datePair, sha256Hdr] headersToSign = getHeadersToSign computedHeaders signedHeaderKeys = B.intercalate ";" $ sort $ map fst headersToSign -- query-parameters to be added before signing for presigned URLs @@ -169,7 +169,7 @@ signV4 !sp !req = if isJust expiry then ("X-Amz-Signature", signature) : authQP else - [ (\(x, y) -> (CI.foldedCase x, y)) authHeader, + [ first CI.foldedCase authHeader, datePair, sha256Hdr ] @@ -188,7 +188,7 @@ mkScope ts region = getHeadersToSign :: [Header] -> [(ByteString, ByteString)] getHeadersToSign !h = filter ((\hdr -> not $ Set.member hdr ignoredHeaders) . fst) $ - map (\(x, y) -> (CI.foldedCase x, stripBS y)) h + map (bimap CI.foldedCase stripBS) h mkCanonicalRequest :: Bool -> @@ -198,14 +198,13 @@ 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 + ( bimap (uriEncode True) (maybe "" (uriEncode True)) + ) + (parseQuery $ NC.queryString req) sortedHeaders = sort headersForSign canonicalHeaders = B.concat $ diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index af0f3c8..2ecab7c 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -103,7 +103,7 @@ withNewHandle fp fileAction = do return resE mkHeaderFromPairs :: [(ByteString, ByteString)] -> [HT.Header] -mkHeaderFromPairs = map ((\(x, y) -> (mk x, y))) +mkHeaderFromPairs = map (first mk) lookupHeader :: HT.HeaderName -> [HT.Header] -> Maybe ByteString lookupHeader hdr = listToMaybe . map snd . filter (\(h, _) -> h == hdr) @@ -113,7 +113,7 @@ getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs getMetadata :: [HT.Header] -> [(Text, Text)] getMetadata = - map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y))) + map (\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)) toMaybeMetadataHeader :: (Text, Text) -> Maybe (Text, Text) toMaybeMetadataHeader (k, v) = diff --git a/src/Network/Minio/XmlGenerator.hs b/src/Network/Minio/XmlGenerator.hs index 6c84e5f..730def0 100644 --- a/src/Network/Minio/XmlGenerator.hs +++ b/src/Network/Minio/XmlGenerator.hs @@ -190,7 +190,7 @@ mkSelectRequest r = LBS.toStrict $ renderLBS def sr Element "CSV" mempty - (map NodeElement $ map kvElement $ csvPropsList c) + (map (NodeElement . kvElement) (csvPropsList c)) formatNode (InputFormatJSON p) = Element "JSON" @@ -218,7 +218,7 @@ mkSelectRequest r = LBS.toStrict $ renderLBS def sr Element "CSV" mempty - (map NodeElement $ map kvElement $ csvPropsList c) + (map (NodeElement . kvElement) (csvPropsList c)) ] rdElem Nothing = [] rdElem (Just t) = diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index b537082..7ab2178 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -236,9 +236,9 @@ parseNotification xmldata = do tcfg = map node $ r $/ s3Elem' "TopicConfiguration" lcfg = map node $ r $/ s3Elem' "CloudFunctionConfiguration" Notification - <$> (mapM (parseNode ns "Queue") qcfg) - <*> (mapM (parseNode ns "Topic") tcfg) - <*> (mapM (parseNode ns "CloudFunction") lcfg) + <$> mapM (parseNode ns "Queue") qcfg + <*> mapM (parseNode ns "Topic") tcfg + <*> mapM (parseNode ns "CloudFunction") lcfg where getFilterRule ns c = let name = T.concat $ c $/ s3Elem ns "Name" &/ content @@ -248,7 +248,7 @@ parseNotification xmldata = do let c = fromNode nodeData itemId = T.concat $ c $/ s3Elem ns "Id" &/ content arn = T.concat $ c $/ s3Elem ns arnName &/ content - events = catMaybes $ map textToEvent $ c $/ s3Elem ns "Event" &/ content + events = mapMaybe textToEvent (c $/ s3Elem ns "Event" &/ content) rules = c $/ s3Elem ns "Filter" diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 1efd549..8c93ea1 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -52,7 +52,7 @@ tests = testGroup "Tests" [liveServerUnitTests] -- conduit that generates random binary stream of given length randomDataSrc :: MonadIO m => Int64 -> C.ConduitM () ByteString m () -randomDataSrc s' = genBS s' +randomDataSrc = genBS where concatIt bs n = BS.concat $ @@ -180,7 +180,7 @@ basicTests = funTestWithBucket "Basic tests" $ "test-file" outFile defaultGetObjectOptions - { gooIfUnmodifiedSince = (Just unmodifiedTime) + { gooIfUnmodifiedSince = Just unmodifiedTime } case resE of Left exn -> liftIO $ exn @?= ServiceErr "PreconditionFailed" "At least one of the pre-conditions you specified did not hold" @@ -194,7 +194,7 @@ basicTests = funTestWithBucket "Basic tests" $ "test-file" outFile defaultGetObjectOptions - { gooIfMatch = (Just "invalid-etag") + { gooIfMatch = Just "invalid-etag" } case resE1 of Left exn -> liftIO $ exn @?= ServiceErr "PreconditionFailed" "At least one of the pre-conditions you specified did not hold" @@ -208,7 +208,7 @@ basicTests = funTestWithBucket "Basic tests" $ "test-file" outFile defaultGetObjectOptions - { gooRange = (Just $ HT.ByteRangeFromTo 100 300) + { gooRange = Just $ HT.ByteRangeFromTo 100 300 } case resE2 of Left exn -> liftIO $ exn @?= ServiceErr "InvalidRange" "The requested range is not satisfiable" @@ -220,7 +220,7 @@ basicTests = funTestWithBucket "Basic tests" $ "test-file" outFile defaultGetObjectOptions - { gooRange = (Just $ HT.ByteRangeFrom 1) + { gooRange = Just $ HT.ByteRangeFrom 1 } step "fGetObject a non-existent object and check for NoSuchKey exception" @@ -231,7 +231,7 @@ basicTests = funTestWithBucket "Basic tests" $ step "create new multipart upload works" uid <- newMultipartUpload bucket "newmpupload" [] - liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.") + liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id." step "abort a new multipart upload works" abortMultipartUpload bucket "newmpupload" uid @@ -247,7 +247,7 @@ basicTests = funTestWithBucket "Basic tests" $ step "get metadata of the object" res <- statObject bucket object defaultGetObjectOptions - liftIO $ (oiSize res) @?= 0 + liftIO $ oiSize res @?= 0 step "delete object" deleteObject bucket object @@ -262,7 +262,7 @@ lowLevelMultipartTest = funTestWithBucket "Low-level Multipart Test" $ step "Prepare for low-level multipart tests." step "create new multipart upload" uid <- newMultipartUpload bucket object [] - liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.") + liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id." randFile <- mkRandFile mb15 @@ -338,22 +338,20 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ \step bucket -> do step "High-level listObjects Test" step "put 3 objects" - let expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3", "o4"] - extractObjectsFromList os = + let extractObjectsFromList = mapM - ( \t -> case t of + ( \case ListItemObject o -> Just $ oiObject o _ -> Nothing ) - os - expectedNonRecList = ["o4", "dir/"] - extractObjectsAndDirsFromList os = + extractObjectsAndDirsFromList = map - ( \t -> case t of + ( \case ListItemObject o -> oiObject o ListItemPrefix d -> d ) - os + expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3", "o4"] + expectedNonRecList = ["o4", "dir/"] testFilepath <- mkRandFile 200 forM_ expectedObjects $ @@ -435,7 +433,7 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ step "create 10 multipart uploads" forM_ [1 .. 10 :: Int] $ \_ -> do uid <- newMultipartUpload bucket object [] - liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.") + liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id." step "High-level listing of incomplete multipart uploads" uploads <- @@ -497,7 +495,7 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do map ( T.concat . ("test-file-" :) - . (\x -> [x]) + . (: []) . T.pack . show ) @@ -516,7 +514,7 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do let object = "newmpupload" forM_ [1 .. 10 :: Int] $ \_ -> do uid <- newMultipartUpload bucket object [] - liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.") + liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id." step "list incomplete multipart uploads" incompleteUploads <- @@ -527,7 +525,7 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do Nothing Nothing Nothing - liftIO $ (length $ lurUploads incompleteUploads) @?= 10 + liftIO $ length (lurUploads incompleteUploads) @?= 10 step "cleanup" forM_ (lurUploads incompleteUploads) $ @@ -538,7 +536,7 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do step "create a multipart upload" uid <- newMultipartUpload bucket object [] - liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.") + liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id." step "put object parts 1..10" inputFile <- mkRandFile mb5 @@ -548,7 +546,7 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do step "fetch list parts" listPartsResult <- listIncompleteParts' bucket object uid Nothing Nothing - liftIO $ (length $ lprParts listPartsResult) @?= 10 + liftIO $ length (lprParts listPartsResult) @?= 10 abortMultipartUpload bucket object uid presignedUrlFunTest :: TestTree @@ -662,7 +660,7 @@ presignedPostPolicyFunTest :: TestTree presignedPostPolicyFunTest = funTestWithBucket "Presigned Post Policy tests" $ \step bucket -> do step "presignedPostPolicy basic test" - now <- liftIO $ Time.getCurrentTime + now <- liftIO Time.getCurrentTime let key = "presignedPostPolicyTest/myfile" policyConds = @@ -693,7 +691,7 @@ presignedPostPolicyFunTest = funTestWithBucket "Presigned Post Policy tests" $ postForm url formData inputFile = do req <- NC.parseRequest $ decodeUtf8 url let parts = - map (\(x, y) -> Form.partBS x y) $ + map (uncurry Form.partBS) $ H.toList formData parts' = parts ++ [Form.partFile "file" inputFile] req' <- Form.formDataBody parts' req @@ -750,7 +748,7 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $ `catch` (\(e :: NC.HttpException) -> return $ Left (show e :: Text)) case respE of Left err -> liftIO $ assertFailure $ show err - Right s -> liftIO $ s @?= (BS.concat $ replicate 100 "c") + Right s -> liftIO $ s @?= BS.concat (replicate 100 "c") deleteObject bucket obj @@ -805,7 +803,7 @@ multipartTest = funTestWithBucket "Multipart Tests" $ C.runConduit $ listIncompleteUploads bucket (Just object) False C..| sinkList - liftIO $ (null uploads) @? "removeIncompleteUploads didn't complete successfully" + liftIO $ null uploads @? "removeIncompleteUploads didn't complete successfully" putObjectContentTypeTest :: TestTree putObjectContentTypeTest = funTestWithBucket "putObject contentType tests" $ @@ -913,7 +911,7 @@ putObjectUserMetadataTest = funTestWithBucket "putObject user-metadata test" $ -- need to do a case-insensitive comparison sortedMeta = sort $ - map (\(k, v) -> (T.toLower k, T.toLower v)) $ + map (bimap T.toLower T.toLower) $ H.toList m ref = sort [("mykey1", "myval1"), ("mykey2", "myval2")] @@ -948,7 +946,7 @@ getObjectTest = funTestWithBucket "getObject test" $ -- need to do a case-insensitive comparison sortedMeta = sort $ - map (\(k, v) -> (T.toLower k, T.toLower v)) $ + map (bimap T.toLower T.toLower) $ H.toList m ref = sort [("mykey1", "myval1"), ("mykey2", "myval2")] diff --git a/test/Network/Minio/JsonParser/Test.hs b/test/Network/Minio/JsonParser/Test.hs index fbf4102..9048455 100644 --- a/test/Network/Minio/JsonParser/Test.hs +++ b/test/Network/Minio/JsonParser/Test.hs @@ -34,7 +34,7 @@ jsonParserTests = ] tryValidationErr :: (MonadUnliftIO m) => m a -> m (Either MErrV a) -tryValidationErr act = try act +tryValidationErr = try assertValidationErr :: MErrV -> Assertion assertValidationErr e = assertFailure $ "Failed due to validation error => " ++ show e diff --git a/test/Network/Minio/XmlParser/Test.hs b/test/Network/Minio/XmlParser/Test.hs index 65aac09..1520952 100644 --- a/test/Network/Minio/XmlParser/Test.hs +++ b/test/Network/Minio/XmlParser/Test.hs @@ -49,7 +49,7 @@ xmlParserTests = ] tryValidationErr :: (MonadUnliftIO m) => m a -> m (Either MErrV a) -tryValidationErr act = try act +tryValidationErr = try assertValidtionErr :: MErrV -> Assertion assertValidtionErr e = assertFailure $ "Failed due to validation error => " ++ show e diff --git a/test/Spec.hs b/test/Spec.hs index e0c0b09..e851043 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -55,17 +55,17 @@ qcProps = \n -> let (pns, offs, sizes) = L.unzip3 (selectPartSizes n) -- check that pns increments from 1. - isPNumsAscendingFrom1 = all (\(a, b) -> a == b) $ zip pns [1 ..] + isPNumsAscendingFrom1 = all (uncurry (==)) $ zip pns [1 ..] consPairs [] = [] consPairs [_] = [] - consPairs (a : (b : c)) = (a, b) : (consPairs (b : c)) + consPairs (a : (b : c)) = (a, b) : consPairs (b : c) -- check `offs` is monotonically increasing. - isOffsetsAsc = all (\(a, b) -> a < b) $ consPairs offs + isOffsetsAsc = all (uncurry (<)) $ consPairs offs -- check sizes sums to n. isSumSizeOk = sum sizes == n -- check sizes are constant except last isSizesConstantExceptLast = - all (\(a, b) -> a == b) (consPairs $ L.init sizes) + all (uncurry (==)) (consPairs $ L.init sizes) -- check each part except last is at least minPartSize; -- last part may be 0 only if it is the only part. nparts = length sizes @@ -94,7 +94,7 @@ qcProps = isFirstPartOk = maybe False ((start ==) . fst) $ listToMaybe pairs -- each pair is >=64MiB except last, and all those parts -- have same size. - initSizes = maybe [] (map (\(a, b) -> b - a + 1)) $ init <$> nonEmpty pairs + initSizes = maybe [] (map (\(a, b) -> b - a + 1) . init) (nonEmpty pairs) isPartSizesOk = all (>= minPartSize) initSizes && maybe @@ -106,7 +106,7 @@ qcProps = snds = take (length pairs - 1) $ map snd pairs isContParts = length fsts == length snds - && and (map (\(a, b) -> a == b + 1) $ zip fsts snds) + && all (\(a, b) -> a == b + 1) (zip fsts snds) in start < 0 || start > end || (isLastPartOk && isFirstPartOk && isPartSizesOk && isContParts),