From 4b71d35dd9210634c028351adbf39433b8e9d11b Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 2 Jun 2022 07:18:11 +0000 Subject: [PATCH 1/2] Linted cargohold. --- services/cargohold/src/CargoHold/API/Federation.hs | 2 -- services/cargohold/src/CargoHold/API/Public.hs | 4 ++-- services/cargohold/src/CargoHold/API/V3.hs | 2 +- services/cargohold/src/CargoHold/App.hs | 3 +-- services/cargohold/src/CargoHold/S3.hs | 8 ++++---- services/cargohold/test/integration/API.hs | 2 +- services/cargohold/test/integration/API/V3.hs | 2 +- 7 files changed, 10 insertions(+), 13 deletions(-) diff --git a/services/cargohold/src/CargoHold/API/Federation.hs b/services/cargohold/src/CargoHold/API/Federation.hs index 33b8f2f585..934aedca3f 100644 --- a/services/cargohold/src/CargoHold/API/Federation.hs +++ b/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 diff --git a/services/cargohold/src/CargoHold/API/Public.hs b/services/cargohold/src/CargoHold/API/Public.hs index 7278124e69..43cc72b1d1 100644 --- a/services/cargohold/src/CargoHold/API/Public.hs +++ b/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 = diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index dfd3f7305b..d9f9e7e37f 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/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, (^.)) diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index 63e4d10baa..aef6c94510 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -98,8 +98,7 @@ newEnv o = do return $ 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) diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index f0a34a241f..ff2375a36b 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/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. @@ -69,6 +68,7 @@ import Network.Wai.Utilities.Error (Error (..)) import qualified System.Logger.Class as Log import System.Logger.Message (msg, val, (.=), (~~)) import URI.ByteString +import Data.Bifunctor (first) newtype S3AssetKey = S3AssetKey {s3Key :: Text} deriving (Eq, Show, ToByteString) @@ -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 + return $ (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 + return $ getAmzMetaUser . (HML.toList <$> view headObjectResponse_metadata) =<< r where req k b = newHeadObject (BucketName b) (ObjectKey k) diff --git a/services/cargohold/test/integration/API.hs b/services/cargohold/test/integration/API.hs index c1c81a0143..39b35dac67 100644 --- a/services/cargohold/test/integration/API.hs +++ b/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 <- diff --git a/services/cargohold/test/integration/API/V3.hs b/services/cargohold/test/integration/API/V3.hs index 4204510f32..380205bdea 100644 --- a/services/cargohold/test/integration/API/V3.hs +++ b/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 <- From b2c2f4570cdee37d8985e94464c390038e2b4619 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 2 Jun 2022 08:06:11 +0000 Subject: [PATCH 2/2] Replace return with pure for Cargohold. --- .../cargohold/src/CargoHold/API/Legacy.hs | 10 +++++----- services/cargohold/src/CargoHold/API/V3.hs | 20 +++++++++---------- services/cargohold/src/CargoHold/AWS.hs | 12 +++++------ services/cargohold/src/CargoHold/App.hs | 4 ++-- .../cargohold/src/CargoHold/CloudFront.hs | 6 +++--- services/cargohold/src/CargoHold/S3.hs | 12 +++++------ services/cargohold/src/CargoHold/Util.hs | 2 +- services/cargohold/test/integration/Main.hs | 6 +++--- 8 files changed, 36 insertions(+), 36 deletions(-) diff --git a/services/cargohold/src/CargoHold/API/Legacy.hs b/services/cargohold/src/CargoHold/API/Legacy.hs index a28da0d79c..d203e52c62 100644 --- a/services/cargohold/src/CargoHold/API/Legacy.hs +++ b/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 diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index d9f9e7e37f..5cd52a6683 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/services/cargohold/src/CargoHold/API/V3.hs @@ -73,7 +73,7 @@ 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 @@ -81,8 +81,8 @@ upload own bdy = do 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 @@ -90,14 +90,14 @@ 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 () diff --git a/services/cargohold/src/CargoHold/AWS.hs b/services/cargohold/src/CargoHold/AWS.hs index bacb72ac89..f7d0fd2df4 100644 --- a/services/cargohold/src/CargoHold/AWS.hs +++ b/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 diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index aef6c94510..bd0635e456 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -95,7 +95,7 @@ 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 = AWS.mkEnv l (o ^. awsS3Endpoint) downloadEndpoint (o ^. awsS3Bucket) (o ^. awsCloudFront) @@ -135,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 diff --git a/services/cargohold/src/CargoHold/CloudFront.hs b/services/cargohold/src/CargoHold/CloudFront.hs index 5ac34b0c5b..be93827aa2 100644 --- a/services/cargohold/src/CargoHold/CloudFront.hs +++ b/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 = diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index ff2375a36b..404abb79e8 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -50,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 @@ -68,7 +69,6 @@ import Network.Wai.Utilities.Error (Error (..)) import qualified System.Logger.Class as Log import System.Logger.Message (msg, val, (.=), (~~)) import URI.ByteString -import Data.Bifunctor (first) newtype S3AssetKey = S3AssetKey {s3Key :: Text} deriving (Eq, Show, ToByteString) @@ -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 @@ -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) diff --git a/services/cargohold/src/CargoHold/Util.hs b/services/cargohold/src/CargoHold/Util.hs index cbc43db380..f14a6a2b7b 100644 --- a/services/cargohold/src/CargoHold/Util.hs +++ b/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 diff --git a/services/cargohold/test/integration/Main.hs b/services/cargohold/test/integration/Main.hs index 419786e39d..ec5be0ba91 100644 --- a/services/cargohold/test/integration/Main.hs +++ b/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)) )