Hlint fixes (#173)

* Hlint fixes

- Will require major version bump as some types were changed from data
  to newtype

* ormolu fixes after hlint

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

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

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

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

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

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

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

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

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"

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

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

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

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

minio-hs.cabal

@@ -58,6 +58,7 @@ common base-settings
                      , DerivingStrategies
                      , FlexibleContexts
                      , FlexibleInstances
+                     , LambdaCase
                      , MultiParamTypeClasses
                      , MultiWayIf
                      , OverloadedStrings

src/Network/Minio/API.hs

@@ -130,18 +130,18 @@ getHostPathRegion ri = do
               regionMay
             )
           virtualStyle =
-            ( ( bucket <> "." <> regionHost,
+            ( bucket <> "." <> regionHost,
-                encodeUtf8 $ "/" <> fromMaybe "" (riObject ri),
+              encodeUtf8 $ "/" <> fromMaybe "" (riObject ri),
-                regionMay
+              regionMay
-              )
             )
-      if
+      ( if isAWSConnectInfo ci
-          | isAWSConnectInfo ci ->
+          then
-              return $
+            return $
-                if bucketHasPeriods bucket
+              if bucketHasPeriods bucket
-                  then pathStyle
+                then pathStyle
-                  else virtualStyle
+                else virtualStyle
-          | otherwise -> return pathStyle
+          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
+              ( if connectIsSecure ci'
-                  | connectIsSecure ci' ->
+                  then -- case 1 described above.
-                      -- case 1 described above.
+                    return sp
-                      return sp
+                  else
-                  | otherwise ->
+                    ( -- case 3 described above.
-                      -- 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),
+          any labelCheck labels,
-          or (map labelCharsCheck 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

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
+    if connectIsSecure ci
-        | connectIsSecure ci ->
+      then -- if secure connection
-            -- if secure connection
+        return "UNSIGNED-PAYLOAD"
-            return "UNSIGNED-PAYLOAD"
+      else -- otherwise compute sha256
-        -- otherwise compute sha256
+        getPayloadSHA256Hash (ariPayload areq)
-        | otherwise -> getPayloadSHA256Hash (ariPayload areq)
 
   timeStamp <- liftIO getCurrentTime
 

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
+  if port == 80 || port == 443
-      | port == 80 || port == 443 -> encodeUtf8 host
+    then encodeUtf8 host
-      | otherwise ->
+    else
-          encodeUtf8 $
+      encodeUtf8 $
-            T.concat [host, ":", show port]
+        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)
+  (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
-#endif
 
 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
+     in ( if host == "storage.googleapis.com"
-            | host == "storage.googleapis.com" ->
+            then "http://doc.s3.amazonaws.com/2006-03-01"
-                "http://doc.s3.amazonaws.com/2006-03-01"
+            else "http://s3.amazonaws.com/doc/2006-03-01/"
-            | otherwise ->
+        )
-                "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

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
+      CL.sourceList $
-        $ map
+        zipWith
-          ( \((uKey, uId, uInitTime), size) ->
+          ( curry
-              UploadInfo uKey uId uInitTime size
+              ( \((uKey, uId, uInitTime), size) ->
+                  UploadInfo uKey uId uInitTime size
+              )
           )
-        $ zip (lurUploads res) aggrSizes
+          (lurUploads res)
+          aggrSizes
 
       when (lurHasMore res) $
         loop (lurNextKey res) (lurNextUpload res)

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 $
+            mapMaybe
-              mkPair <$> conditions ppWithCreds
+              mkPair
+              (conditions ppWithCreds)
       formData = formFromPolicy `H.union` signData
       -- compute POST upload URL
       bucket = H.lookupDefault "" "bucket" formData

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])]) $
+      maybe [] ((\a -> [("x-amz-copy-source-range", HT.renderByteRanges [a])]) . toByteRange) (srcRange srcInfo)
-        toByteRange <$> srcRange srcInfo
     toByteRange :: (Int64, Int64) -> HT.ByteRange
     toByteRange (x, y) = HT.ByteRangeFromTo (fromIntegral x) (fromIntegral y)
 

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 "&"
+        B.intercalate "&" $
-          $ map (\(x, y) -> B.concat [x, "=", y])
+          map (\(x, y) -> B.concat [x, "=", y]) $
-          $ sort
+            sort $
-          $ map
+              map
-            ( \(x, y) ->
+                ( bimap (uriEncode True) (maybe "" (uriEncode True))
-                (uriEncode True x, maybe "" (uriEncode True) y)
+                )
-            )
+                (parseQuery $ NC.queryString req)
-          $ (parseQuery $ NC.queryString req)
       sortedHeaders = sort headersForSign
       canonicalHeaders =
         B.concat $

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

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

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 "Queue") qcfg
-    <*> (mapM (parseNode ns "Topic") tcfg)
+    <*> mapM (parseNode ns "Topic") tcfg
-    <*> (mapM (parseNode ns "CloudFunction") lcfg)
+    <*> 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"

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"]
+    let extractObjectsFromList =
-        extractObjectsFromList os =
           mapM
-            ( \t -> case t of
+            ( \case
                 ListItemObject o -> Just $ oiObject o
                 _ -> Nothing
             )
-            os
+        extractObjectsAndDirsFromList =
-        expectedNonRecList = ["o4", "dir/"]
-        extractObjectsAndDirsFromList os =
           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")]
 

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

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

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