Lint cargohold

services/cargohold/src/CargoHold/API/Federation.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>

services/cargohold/src/CargoHold/API/Legacy.hs

@@ -32,18 +32,18 @@ import URI.ByteString
 download :: UserId -> ConvId -> AssetId -> Handler (Maybe URI)
 download _ _ ast = S3.getMetadata ast >>= maybe notFound found
   where
-    notFound = return Nothing
+    notFound = pure Nothing
     found public =
       if not public
-        then return Nothing
+        then pure Nothing
         else do
           url <- genSignedURL (S3.plainKey ast)
-          return $! Just $! url
+          pure $! Just $! url
 
 downloadOtr :: UserId -> ConvId -> AssetId -> Handler (Maybe URI)
 downloadOtr _ cnv ast = S3.getOtrMetadata cnv ast >>= maybe notFound found
   where
-    notFound = return Nothing
+    notFound = pure Nothing
     found _ = do
       url <- genSignedURL (S3.otrKey cnv ast)
-      return $! Just $! url
+      pure $! Just $! url

services/cargohold/src/CargoHold/API/Public.hs

@@ -167,7 +167,7 @@ downloadAssetV4 usr qkey tok1 tok2 =
         qkey
 
 deleteAssetV3 :: MakePrincipal tag id => id -> AssetKey -> Handler ()
-deleteAssetV3 usr key = V3.delete (mkPrincipal usr) key
+deleteAssetV3 usr = V3.delete (mkPrincipal usr)
 
 deleteAssetV4 :: Local UserId -> Qualified AssetKey -> Handler ()
 deleteAssetV4 usr qkey = do
@@ -179,7 +179,7 @@ renewTokenV3 (tUnqualified -> usr) key =
   NewAssetToken <$> V3.renewToken (V3.UserPrincipal usr) key
 
 deleteTokenV3 :: Local UserId -> AssetKey -> Handler ()
-deleteTokenV3 (tUnqualified -> usr) key = V3.deleteToken (V3.UserPrincipal usr) key
+deleteTokenV3 (tUnqualified -> usr) = V3.deleteToken (V3.UserPrincipal usr)
 
 legacyDownloadPlain :: Local UserId -> ConvId -> AssetId -> Handler (Maybe (AssetLocation Absolute))
 legacyDownloadPlain (tUnqualified -> usr) cnv ast =

services/cargohold/src/CargoHold/API/V3.hs

@@ -37,7 +37,7 @@ import qualified CargoHold.Types.V3 as V3
 import CargoHold.Util
 import qualified Codec.MIME.Parse as MIME
 import qualified Codec.MIME.Type as MIME
-import qualified Conduit as Conduit
+import qualified Conduit
 import Control.Applicative (optional)
 import Control.Error
 import Control.Lens (set, view, (^.))
@@ -73,31 +73,31 @@ upload own bdy = do
   when (cl > maxTotalBytes) $
     throwE assetTooLarge
   ast <- liftIO $ Id <$> nextRandom
-  tok <- if sets ^. V3.setAssetPublic then return Nothing else Just <$> randToken
+  tok <- if sets ^. V3.setAssetPublic then pure Nothing else Just <$> randToken
   let ret = fromMaybe V3.AssetPersistent (sets ^. V3.setAssetRetention)
   key <- qualifyLocal (V3.AssetKeyV3 ast ret)
   void $ S3.uploadV3 own (tUnqualified key) hdrs tok src
   Metrics.s3UploadOk
   Metrics.s3UploadSize cl
   expires <- case V3.assetRetentionSeconds ret of
     Just n -> Just . addUTCTime n <$> liftIO getCurrentTime
-    Nothing -> return Nothing
-  return $! V3.mkAsset key
+    Nothing -> pure Nothing
+  pure $! V3.mkAsset key
     & set V3.assetExpires expires
     & set V3.assetToken tok
 
 renewToken :: V3.Principal -> V3.AssetKey -> Handler V3.AssetToken
 renewToken own key = do
   tok <- randToken
   updateToken own key (Just tok)
-  return tok
+  pure tok
 
 deleteToken :: V3.Principal -> V3.AssetKey -> Handler ()
 deleteToken own key = updateToken own key Nothing
 
 updateToken :: V3.Principal -> V3.AssetKey -> Maybe V3.AssetToken -> Handler ()
 updateToken own key tok = do
-  m <- S3.getMetadataV3 key >>= maybe (throwE assetNotFound) return
+  m <- S3.getMetadataV3 key >>= maybe (throwE assetNotFound) pure
   unless (S3.v3AssetOwner m == own) $
     throwE unauthorised
   let m' = m {S3.v3AssetToken = tok}
@@ -118,7 +118,7 @@ checkMetadata mown key tok = do
 
 delete :: V3.Principal -> V3.AssetKey -> Handler ()
 delete own key = do
-  m <- S3.getMetadataV3 key >>= maybe (throwE assetNotFound) return
+  m <- S3.getMetadataV3 key >>= maybe (throwE assetNotFound) pure
   unless (S3.v3AssetOwner m == own) $
     throwE unauthorised
   S3.deleteV3 key
@@ -156,7 +156,7 @@ assetSettings = do
   unless (MIME.mimeType ct == MIME.Application "json") $
     fail "Invalid metadata Content-Type. Expected 'application/json'."
   bs <- take (fromIntegral cl)
-  either fail return (eitherDecodeStrict' bs)
+  either fail pure (eitherDecodeStrict' bs)
 
 metadataHeaders :: Parser (MIME.Type, Word)
 metadataHeaders =
@@ -168,7 +168,7 @@ metadataHeaders =
     go hdrs = do
       ct <- contentType hdrs
       cl <- contentLength hdrs
-      return (ct, cl)
+      pure (ct, cl)
 
 assetHeaders :: Parser AssetHeaders
 assetHeaders =
@@ -186,14 +186,14 @@ contentType :: [(HeaderName, ByteString)] -> Parser MIME.Type
 contentType hdrs =
   maybe
     (fail "Missing Content-Type")
-    (maybe (fail "Invalid MIME type") return . MIME.parseMIMEType . decodeLatin1)
+    (maybe (fail "Invalid MIME type") pure . MIME.parseMIMEType . decodeLatin1)
     (lookup (CI.mk "Content-Type") hdrs)
 
 contentLength :: [(HeaderName, ByteString)] -> Parser Word
 contentLength hdrs =
   maybe
     (fail "Missing Content-Type")
-    (either fail return . parseOnly decimal)
+    (either fail pure . parseOnly decimal)
     (lookup (CI.mk "Content-Length") hdrs)
 
 boundary :: Parser ()

services/cargohold/src/CargoHold/AWS.hs

@@ -111,10 +111,10 @@ mkEnv lgr s3End s3Download bucket cfOpts mgr = do
   let g = Logger.clone (Just "aws.cargohold") lgr
   e <- mkAwsEnv g (setAWSEndpoint s3End S3.defaultService)
   cf <- mkCfEnv cfOpts
-  return (Env g bucket e s3Download cf)
+  pure (Env g bucket e s3Download cf)
   where
     mkCfEnv (Just o) = Just <$> initCloudFront (o ^. cfPrivateKey) (o ^. cfKeyPairId) 300 (o ^. cfDomain)
-    mkCfEnv Nothing = return Nothing
+    mkCfEnv Nothing = pure Nothing
     mkAwsEnv g s3 = do
       baseEnv <-
         AWS.newEnv AWS.discover
@@ -161,7 +161,7 @@ send :: AWSRequest r => AWS.Env -> r -> Amazon (AWSResponse r)
 send env r = throwA =<< sendCatch env r
 
 throwA :: Either AWS.Error a -> Amazon a
-throwA = either (throwM . GeneralError) return
+throwA = either (throwM . GeneralError) pure
 
 exec ::
   (AWSRequest r, Show r, MonadLogger m, MonadIO m, MonadThrow m) =>
@@ -180,7 +180,7 @@ exec env request = do
       -- We just re-throw the error, but logging it here also gives us the request
       -- that caused it.
       throwM (GeneralError err)
-    Right r -> return r
+    Right r -> pure r
 
 execStream ::
   (AWSRequest r, Show r) =>
@@ -215,8 +215,8 @@ execCatch env request = do
         Log.field "remote" (Log.val "S3")
           ~~ Log.msg (show err)
           ~~ Log.msg (show req)
-      return Nothing
-    Right r -> return $ Just r
+      pure Nothing
+    Right r -> pure $ Just r
 
 canRetry :: MonadIO m => Either AWS.Error a -> m Bool
 canRetry (Right _) = pure False

services/cargohold/src/CargoHold/App.hs

@@ -95,11 +95,10 @@ newEnv o = do
   mgr <- initHttpManager (o ^. optAws . awsS3Compatibility)
   ama <- initAws (o ^. optAws) lgr mgr
   let loc = toLocalUnsafe (o ^. optSettings . Opt.setFederationDomain) ()
-  return $ Env ama met lgr mgr def o loc
+  pure $ Env ama met lgr mgr def o loc
 
 initAws :: AWSOpts -> Logger -> Manager -> IO AWS.Env
-initAws o l m =
-  AWS.mkEnv l (o ^. awsS3Endpoint) downloadEndpoint (o ^. awsS3Bucket) (o ^. awsCloudFront) m
+initAws o l = AWS.mkEnv l (o ^. awsS3Endpoint) downloadEndpoint (o ^. awsS3Bucket) (o ^. awsCloudFront)
   where
     downloadEndpoint = fromMaybe (o ^. awsS3Endpoint) (o ^. awsS3DownloadEndpoint)
 
@@ -136,7 +135,7 @@ initSSLContext = do
   SSL.contextLoadSystemCerts ctx
   SSL.contextSetVerificationMode ctx $
     SSL.VerifyPeer True True Nothing
-  return ctx
+  pure ctx
 
 closeEnv :: Env -> IO ()
 closeEnv e = Log.close $ e ^. appLogger

services/cargohold/src/CargoHold/CloudFront.hs

@@ -74,7 +74,7 @@ signedURL :: (MonadIO m, ToByteString p) => CloudFront -> p -> m URI
 signedURL (CloudFront base kid ttl clock sign) path = liftIO $ do
   time <- (+ ttl) . round <$> clock
   sig <- sign (toStrict (toLazyByteString (policy url time)))
-  return
+  pure
     $! url
       { uriQuery =
           Query
@@ -105,10 +105,10 @@ sha1Rsa fp = do
   sha1 <-
     liftIO $
       getDigestByName "SHA1"
-        >>= maybe (error "OpenSSL: SHA1 not found") return
+        >>= maybe (error "OpenSSL: SHA1 not found") pure
   kbs <- readFile fp
   key <- readPrivateKey kbs PwNone
-  return (SSL.signBS sha1 key)
+  pure (SSL.signBS sha1 key)
 
 mkPOSIXClock :: IO (IO POSIXTime)
 mkPOSIXClock =

services/cargohold/src/CargoHold/S3.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.
@@ -51,6 +50,7 @@ import qualified Codec.MIME.Type as MIME
 import Conduit
 import Control.Error (ExceptT, throwE)
 import Control.Lens hiding (parts, (.=), (:<), (:>))
+import Data.Bifunctor (first)
 import Data.ByteString.Builder (toLazyByteString)
 import Data.ByteString.Conversion
 import qualified Data.ByteString.Lazy as LBS
@@ -159,13 +159,13 @@ getMetadataV3 (s3Key . mkKey -> key) = do
       ~~ "asset.key" .= key
       ~~ msg
         (val "Getting asset metadata")
-  maybe (return Nothing) handle =<< execCatch req
+  maybe (pure Nothing) handle =<< execCatch req
   where
     req b = newHeadObject (BucketName b) (ObjectKey key)
     handle r = do
       let ct = fromMaybe octets (MIME.parseMIMEType =<< r ^. headObjectResponse_contentType)
       let meta = HML.toList $ r ^. headObjectResponse_metadata
-      return $ parse ct meta
+      pure $ parse ct meta
     parse ct h =
       S3AssetMeta
         <$> getAmzMetaPrincipal h
@@ -225,7 +225,7 @@ signedURL path = do
             ~~ msg (val "Failed to generate a signed URI")
             ~~ msg (show e)
         throwE serverError
-      Right u -> return u
+      Right u -> pure u
 
 mkKey :: V3.AssetKey -> S3AssetKey
 mkKey (V3.AssetKeyV3 i r) = S3AssetKey $ "v3/" <> retention <> "/" <> key
@@ -280,7 +280,7 @@ setAmzMetaPrincipal (V3.ProviderPrincipal p) = setAmzMetaProvider p
 -- S3 Metadata Getters
 
 lookupCI :: (CI.FoldCase a, Eq a) => a -> [(a, b)] -> Maybe b
-lookupCI k = lookup (CI.mk k) . fmap (\(a, b) -> (CI.mk a, b))
+lookupCI k = lookup (CI.mk k) . fmap (first CI.mk)
 
 getAmzMetaPrincipal :: [(Text, Text)] -> Maybe V3.Principal
 getAmzMetaPrincipal h =
@@ -336,7 +336,7 @@ otrKey c a = S3AssetKey $ "otr/" <> Text.pack (show c) <> "/" <> Text.pack (show
 getMetadata :: AssetId -> ExceptT Error App (Maybe Bool)
 getMetadata ast = do
   r <- execCatch req
-  return $ parse <$> HML.toList <$> view headObjectResponse_metadata <$> r
+  pure $ (parse <$> HML.toList) . view headObjectResponse_metadata <$> r
   where
     req b = newHeadObject (BucketName b) (ObjectKey . Text.pack $ show ast)
     parse =
@@ -347,6 +347,6 @@ getOtrMetadata :: ConvId -> AssetId -> ExceptT Error App (Maybe UserId)
 getOtrMetadata cnv ast = do
   let S3AssetKey key = otrKey cnv ast
   r <- execCatch (req key)
-  return $ getAmzMetaUser =<< HML.toList <$> view headObjectResponse_metadata <$> r
+  pure $ getAmzMetaUser . (HML.toList <$> view headObjectResponse_metadata) =<< r
   where
     req k b = newHeadObject (BucketName b) (ObjectKey k)

services/cargohold/src/CargoHold/Util.hs

@@ -32,4 +32,4 @@ genSignedURL path = do
     view (aws . cloudFront) >>= \case
       Nothing -> S3.signedURL path
       Just cf -> CloudFront.signedURL cf path
-  return $! uri
+  pure $! uri

services/cargohold/test/integration/API.hs

@@ -108,7 +108,7 @@ testSimpleRoundtrip = do
       let Just date = C8.unpack <$> lookup "Date" (responseHeaders r1)
       let utc = parseTimeOrError False defaultTimeLocale rfc822DateFormat date :: UTCTime
       -- Potentially check for the expires header
-      when (isJust $ join (V3.assetRetentionSeconds <$> (sets ^. V3.setAssetRetention))) $ do
+      when (isJust $ V3.assetRetentionSeconds =<< (sets ^. V3.setAssetRetention)) $ do
         liftIO $ assertBool "invalid expiration" (Just utc < view V3.assetExpires ast)
       -- Lookup with token and download via redirect.
       r2 <-

services/cargohold/test/integration/API/V3.hs

@@ -72,7 +72,7 @@ testSimpleRoundtrip = do
       let Just date = C8.unpack <$> lookup "Date" (responseHeaders r1)
       let utc = parseTimeOrError False defaultTimeLocale rfc822DateFormat date :: UTCTime
       -- Potentially check for the expires header
-      when (isJust $ join (assetRetentionSeconds <$> (sets ^. setAssetRetention))) $ do
+      when (isJust $ assetRetentionSeconds =<< (sets ^. setAssetRetention)) $ do
         liftIO $ assertBool "invalid expiration" (Just utc < view assetExpires ast)
       -- Lookup with token and download via redirect.
       r2 <-

services/cargohold/test/integration/Main.hs

@@ -39,12 +39,12 @@ newtype ServiceConfigFile = ServiceConfigFile String
 instance IsOption ServiceConfigFile where
   defaultValue = ServiceConfigFile "/etc/wire/cargohold/conf/cargohold.yaml"
   parseValue = fmap ServiceConfigFile . safeRead
-  optionName = return "service-config"
-  optionHelp = return "Service config file to read from"
+  optionName = pure "service-config"
+  optionHelp = pure "Service config file to read from"
   optionCLParser =
     fmap ServiceConfigFile $
       strOption $
-        ( short (untag (return 's' :: Tagged ServiceConfigFile Char))
+        ( short (untag (pure 's' :: Tagged ServiceConfigFile Char))
             <> long (untag (optionName :: Tagged ServiceConfigFile String))
             <> help (untag (optionHelp :: Tagged ServiceConfigFile String))
         )