diff --git a/libs/ropes/package.yaml b/libs/ropes/package.yaml index 62f0f058d09..a96c0a0d218 100644 --- a/libs/ropes/package.yaml +++ b/libs/ropes/package.yaml @@ -18,7 +18,6 @@ library: source-dirs: src dependencies: - aeson >=0.6 - - aws >=0.10.2 - base ==4.* - exceptions >=0.6 - http-client >=0.5 @@ -31,34 +30,3 @@ library: - time >=1.1 - tinylog >=0.10.2 - yaml >=0.8.22 -executables: - ropes-aws-auth-test: - main: Main.hs - source-dirs: test/integration-aws-auth - ghc-options: - - -threaded - dependencies: - - base >=4 && <5 - - aws - - http-client - - ropes - - time - - tinylog - ropes-aws-test: - main: Main.hs - source-dirs: test/integration-aws - ghc-options: - - -threaded - dependencies: - - base >=4 && <5 - - aws - - exceptions - - http-client - - http-client-tls - - resourcet - - ropes - - tasty >=0.2 - - tasty-hunit >=0.2 - - text >=0.11.3 - - transformers - - tinylog diff --git a/libs/ropes/ropes.cabal b/libs/ropes/ropes.cabal index 88c710bd2e3..b87254d448f 100644 --- a/libs/ropes/ropes.cabal +++ b/libs/ropes/ropes.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8e1fc11eb8dfecf6b35bf33c8cd612ed3e50f371781a549f8728286a79acb547 +-- hash: d24f5fff02a52bee31f4c44250bf1b220b95113bb66026289808204f560ad4bd name: ropes version: 0.4.20 @@ -19,8 +19,6 @@ build-type: Simple library exposed-modules: - Ropes.Aws - Ropes.Aws.Ses Ropes.Nexmo Ropes.Twilio other-modules: @@ -31,7 +29,6 @@ library ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path build-depends: aeson >=0.6 - , aws >=0.10.2 , base ==4.* , bytestring >=0.9 , errors >=2.0 @@ -50,54 +47,3 @@ library , transformers >=0.3 , yaml >=0.8.22 default-language: Haskell2010 - -executable ropes-aws-auth-test - main-is: Main.hs - other-modules: - Paths_ropes - hs-source-dirs: - test/integration-aws-auth - default-extensions: AllowAmbiguousTypes BangPatterns ConstraintKinds DataKinds DefaultSignatures DerivingStrategies DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable EmptyCase FlexibleContexts FlexibleInstances FunctionalDependencies GADTs InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PackageImports PatternSynonyms PolyKinds QuasiQuotes RankNTypes ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators UndecidableInstances ViewPatterns - ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -threaded - build-depends: - aws - , base >=4 && <5 - , bytestring >=0.9 - , errors >=2.0 - , http-client - , imports - , mime-mail >=0.4 - , ropes - , semigroups >=0.11 - , time - , tinylog - default-language: Haskell2010 - -executable ropes-aws-test - main-is: Main.hs - other-modules: - Tests.Ropes.Aws.Ses - Paths_ropes - hs-source-dirs: - test/integration-aws - default-extensions: AllowAmbiguousTypes BangPatterns ConstraintKinds DataKinds DefaultSignatures DerivingStrategies DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable EmptyCase FlexibleContexts FlexibleInstances FunctionalDependencies GADTs InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PackageImports PatternSynonyms PolyKinds QuasiQuotes RankNTypes ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators UndecidableInstances ViewPatterns - ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -threaded - build-depends: - aws - , base >=4 && <5 - , bytestring >=0.9 - , errors >=2.0 - , exceptions - , http-client - , http-client-tls - , imports - , mime-mail >=0.4 - , resourcet - , ropes - , semigroups >=0.11 - , tasty >=0.2 - , tasty-hunit >=0.2 - , text >=0.11.3 - , tinylog - , transformers - default-language: Haskell2010 diff --git a/libs/ropes/src/Ropes/Aws.hs b/libs/ropes/src/Ropes/Aws.hs deleted file mode 100644 index 1c407d1e951..00000000000 --- a/libs/ropes/src/Ropes/Aws.hs +++ /dev/null @@ -1,216 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Ropes.Aws - ( -- * Env - AccessKeyId (..), - SecretAccessKey (..), - Env, - newEnv, - getConfig, - getCredentials, - getManager, - - -- * Sending Requests - sendRequest, - - -- * Re-exports - Configuration (..), - Credentials (..), - ServiceConfiguration, - NormalQuery, - Transaction, - ResponseMetadata, - ) -where - -import Aws (Configuration (..), aws) -import qualified Aws -import Aws.Core -import Control.Error -import Control.Monad.Catch -import Control.Monad.Trans.Resource -import Control.Retry -import Data.Aeson -import qualified Data.ByteString.Char8 as C -import qualified Data.ByteString.Lazy as LB -import Data.Text (pack, unpack) -import Data.Text.Encoding (encodeUtf8) -import Data.Time.Clock -import Imports -import Network.HTTP.Client -import System.Logger (Logger) -import qualified System.Logger as Logger - -------------------------------------------------------------------------------- --- Config - -newtype AccessKeyId = AccessKeyId - {unKey :: ByteString} - deriving (Eq, Show) - -instance FromJSON AccessKeyId where - parseJSON = - withText "Aws.AccessKeyId" $ - pure . AccessKeyId . encodeUtf8 - -newtype SecretAccessKey = SecretAccessKey - {unSecret :: ByteString} - deriving (Eq) - -instance Show SecretAccessKey where - show _ = "AWS Secret hidden" - -instance FromJSON SecretAccessKey where - parseJSON = - withText "Aws.SecretAccessKey" $ - pure . SecretAccessKey . encodeUtf8 - -data Auth - = PermAuth Configuration - | TempAuth (IORef Configuration) - --- | An environment for executing AWS requests. See 'sendRequest'. -data Env = Env - { _auth :: !Auth, - -- | Get the HTTP 'Manager' used by an 'Env'ironment. - getManager :: !Manager - } - --- | If credentials are supplied to this function, they are used to create the 'Env' --- | Otherwise, it tries to discover AWS credentials by calling the underlying --- | loadCredentialsDefault. If that does not succeed, if fallsback to instance metadata -newEnv :: Logger -> Manager -> Maybe (AccessKeyId, SecretAccessKey) -> IO Env -newEnv lgr mgr ks = do - auth <- case ks of - Just (k, s) -> permAuth =<< makeCredentials (unKey k) (unSecret s) - Nothing -> discover - return $ Env auth mgr - where - permAuth creds = PermAuth <$> newPermConfig lgr creds - tempAuth = TempAuth <$> newTempConfig lgr mgr - discover = loadCredentialsDefault >>= maybe tempAuth permAuth - --- | Get the currently used 'Credentials' from the current --- 'Configuration' used by the given 'Env'. -getCredentials :: Env -> IO Credentials -getCredentials = fmap credentials . getConfig - --- | Get the currently used 'Configuration' of the given 'Env'. -getConfig :: Env -> IO Configuration -getConfig (Env (PermAuth c) _) = return c -getConfig (Env (TempAuth r) _) = readIORef r - -------------------------------------------------------------------------------- --- Sending Requests - -sendRequest :: - (MonadIO m, Transaction r a) => - Env -> - ServiceConfiguration r NormalQuery -> - r -> - ResourceT m (ResponseMetadata a, a) -sendRequest env scfg req = transResourceT liftIO $ do - cfg <- liftIO $ getConfig env - rsp <- aws cfg scfg (getManager env) req - a <- readResponseIO rsp - return (responseMetadata rsp, a) - -------------------------------------------------------------------------------- --- Internals - -newPermConfig :: Logger -> Credentials -> IO Configuration -newPermConfig lgr creds = return $ Configuration Timestamp creds (awsLog lgr) Nothing - -newTempConfig :: Logger -> Manager -> IO (IORef Configuration) -newTempConfig lgr mgr = do - Just (c, x) <- retrying x5 (const shouldRetry) (const tryMetadata) - r <- newIORef c - schedule r x - return r - where - schedule r x = for_ x $ \expires -> do - now <- getCurrentTime - let secs = round (expires `diffUTCTime` now) - (60 * 30) - msecs = secs * 1000 * 1000 - forkIO $ threadDelay msecs >> refresh r - refresh r = do - Just (c, x) <- retrying xInf (const shouldRetry) (const tryMetadata) - writeIORef r c - schedule r x - shouldRetry = return . isNothing - tryMetadata :: IO (Maybe (Configuration, Maybe UTCTime)) - tryMetadata = do - Logger.info lgr $ Logger.msg ("Fetching instance metadata" :: String) - r <- runExceptT . syncIO $ fromMetadata mgr - case r of - Left e -> Logger.err lgr (Logger.msg $ show e) >> return Nothing - Right a -> do - keys <- newIORef [] -- V4 signing keys used by the 'aws' package - let (c, x) = mkCreds a keys - cfg = Configuration Timestamp c (awsLog lgr) Nothing - return $ Just (cfg, x) - mkCreds (TempCredentials (AccessKeyId k) (SecretAccessKey s) (SessionToken t) expiry) keys = - (Credentials k s keys (Just t), expiry) - x5 = constantDelay 1000000 <> limitRetries 5 -- every second - xInf = constantDelay (60 * 1000000) -- every minute - -awsLog :: Logger -> Aws.LogLevel -> Text -> IO () -awsLog lgr l m = Logger.log lgr (level l) (Logger.msg m) - where - level Aws.Debug = Logger.Debug - level Aws.Info = Logger.Info - level Aws.Warning = Logger.Warn - level Aws.Error = Logger.Error - -data TempCredentials = TempCredentials - { _tmpKey :: AccessKeyId, - _tmpSecret :: SecretAccessKey, - _tmpToken :: SessionToken, - _tmpExpiry :: Maybe UTCTime - } - -newtype SessionToken = SessionToken ByteString - -newtype MetadataException = MetadataException Text - deriving (Eq, Typeable) - -instance Exception MetadataException - -instance Show MetadataException where - show (MetadataException e) = "Ropes.Aws.MetadataException: " ++ unpack e - -fromMetadata :: Manager -> IO TempCredentials -fromMetadata mgr = do - req <- parseUrlThrow $ C.unpack url - role <- C.takeWhile (/= '\n') . LB.toStrict . responseBody <$> httpLbs req mgr - cred <- eitherDecode . responseBody <$> httpLbs (req {path = (path req) <> "/" <> role}) mgr - either (throwM . MetadataException . ("Failed to parse: " <>) . pack) return cred - where - url :: ByteString - url = "http://instance-data/latest/meta-data/iam/security-credentials/" - -instance FromJSON TempCredentials where - parseJSON = withObject "credentials" $ \o -> - TempCredentials - <$> (AccessKeyId . encodeUtf8 <$> o .: "AccessKeyId") - <*> (SecretAccessKey . encodeUtf8 <$> o .: "SecretAccessKey") - <*> (SessionToken . encodeUtf8 <$> o .: "Token") - <*> o .:? "Expiration" diff --git a/libs/ropes/src/Ropes/Aws/Ses.hs b/libs/ropes/src/Ropes/Aws/Ses.hs deleted file mode 100644 index 0345dab1c7e..00000000000 --- a/libs/ropes/src/Ropes/Aws/Ses.hs +++ /dev/null @@ -1,34 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Ropes.Aws.Ses where - -import Aws.Ses -import Data.ByteString.Lazy (toStrict) -import Imports -import Network.Mail.Mime - --- | Convenience function for constructing a 'SendRawEmail' command, --- which involves extracting/duplicating some data from the MIME 'Mail'. -sendRawEmail :: MonadIO m => Mail -> m SendRawEmail -sendRawEmail m = do - msg <- liftIO $ toStrict <$> renderMail' m - return $ - SendRawEmail - (map addressEmail (mailTo m)) - (RawMessage msg) - (Just . Sender . addressEmail $ mailFrom m) diff --git a/libs/ropes/test/integration-aws-auth/Main.hs b/libs/ropes/test/integration-aws-auth/Main.hs deleted file mode 100644 index c5a369a7617..00000000000 --- a/libs/ropes/test/integration-aws-auth/Main.hs +++ /dev/null @@ -1,44 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Main where - -import Data.Time.Clock -import Imports -import Network.HTTP.Client -import Ropes.Aws -import qualified System.Logger as Logger - -main :: IO () -main = do - hSetBuffering stdout NoBuffering - l <- Logger.new Logger.defSettings -- TODO: use mkLogger'? - m <- newManager defaultManagerSettings - e <- newEnv l m Nothing - forever $ do - now <- getCurrentTime - crd <- getCredentials e - putStrLn $ "Time: " ++ show now ++ " - Credentials: " ++ showCreds crd - threadDelay $ 60 * 1000 * 1000 -- every minute - where - showCreds (Credentials k s _ t) = - "AccessKeyId: " ++ show k ++ " - " - ++ "SecretAccessKey: " - ++ show s - ++ " - " - ++ "SessionToken: " - ++ show t diff --git a/libs/ropes/test/integration-aws/Main.hs b/libs/ropes/test/integration-aws/Main.hs deleted file mode 100644 index 9e868269199..00000000000 --- a/libs/ropes/test/integration-aws/Main.hs +++ /dev/null @@ -1,41 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Main - ( main, - ) -where - -import Data.ByteString.Char8 (pack) -import Imports -import Network.HTTP.Client -import Network.HTTP.Client.TLS -import Ropes.Aws -import qualified System.Logger as Logger -import Test.Tasty -import qualified Tests.Ropes.Aws.Ses as SES - -main :: IO () -main = do - l <- Logger.new Logger.defSettings -- TODO: use mkLogger'? - k <- pack <$> getEnv "AWS_ACCESS_KEY" - s <- pack <$> getEnv "AWS_SECRET_KEY" - m <- newManager tlsManagerSettings - e <- newEnv l m $ Just (AccessKeyId k, SecretAccessKey s) - defaultMain $ tests e - where - tests = SES.tests diff --git a/libs/ropes/test/integration-aws/Tests/Ropes/Aws/Ses.hs b/libs/ropes/test/integration-aws/Tests/Ropes/Aws/Ses.hs deleted file mode 100644 index a66e79d8f52..00000000000 --- a/libs/ropes/test/integration-aws/Tests/Ropes/Aws/Ses.hs +++ /dev/null @@ -1,88 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Tests.Ropes.Aws.Ses - ( tests, - ) -where - -import Aws -import Aws.Ses -import Control.Error -import Control.Monad.Catch -import Control.Monad.Trans.Resource -import qualified Data.Text.Lazy.Encoding as T -import Imports -import Network.Mail.Mime -import Ropes.Aws -import Ropes.Aws.Ses -import qualified System.Logger as Logger -import Test.Tasty -import Test.Tasty.HUnit - -sesCfg :: SesConfiguration NormalQuery -sesCfg = sesHttpsPost sesEuWest1 - -tests :: Env -> TestTree -tests e = - testGroup - "AWS SES Integration Tests" - [ testCase "Successfully send raw mail" (sendRawMailSuccess e), - testCase "Fail on invalid access key" (sendMailFailure e) - ] - -sendRawMailSuccess :: Env -> IO () -sendRawMailSuccess e = do - r <- runExceptT . trySes $ sendRequest e sesCfg =<< sendRawEmail testMimeMail - case r of - Right _ -> return () - Left x -> liftIO $ assertFailure (show x) - -sendMailFailure :: Env -> IO () -sendMailFailure e = do - l <- Logger.new Logger.defSettings -- TODO: use mkLogger'? - x <- newEnv l (getManager e) $ Just (AccessKeyId "abc", SecretAccessKey "eh?") - r <- runExceptT . trySes $ sendRequest x sesCfg =<< sendRawEmail testMimeMail - case r of - Left (SesError _ "InvalidClientTokenId" _) -> return () - _ -> assertFailure "Expected error response" - -trySes :: MonadIO m => ResourceT IO a -> ExceptT SesError m a -trySes = ExceptT . liftIO . try . runResourceT - -testMimeMail :: Mail -testMimeMail = - Mail - { mailFrom = Address (Just "Mr. Test") "backend-integration@wire.com", - mailTo = [Address (Just "Mr. Simulator") "success@simulator.amazonses.com"], - mailCc = [], - mailBcc = [], - mailHeaders = [("Subject", "Just Testing!"), ("X-Zeta-Test", "Test")], - mailParts = - [ [ Part - { partType = "text/plain; charset=UTF-8", - partEncoding = QuotedPrintableText, - partHeaders = [], - partContent = PartContent $ T.encodeUtf8 "Hi Bjørn!", - partDisposition = DefaultDisposition - } - ] - ] - } diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index f197b9f8eb4..7c8b230cb37 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -4,7 +4,7 @@ cabal-version: 2.0 -- -- see: https://github.com/sol/hpack -- --- hash: 5b6d9d31d5e95d40726d293fd31802c4a12c0d31327e3b948142f77d22117abb +-- hash: d809bb98d16ea3605158fe91187390c00a5552a47d5c27bab8d85fab8d440cf4 name: brig version: 1.35.0 @@ -121,7 +121,6 @@ library , base16-bytestring >=0.1 , base64-bytestring >=1.0 , bilge >=0.21.1 - , blaze-builder >=0.3 , bloodhound >=0.13 , brig-types >=0.91.1 , bytestring >=0.10 diff --git a/services/brig/package.yaml b/services/brig/package.yaml index 50ba0151cff..53aee10de4d 100644 --- a/services/brig/package.yaml +++ b/services/brig/package.yaml @@ -27,7 +27,6 @@ library: - base16-bytestring >=0.1 - base64-bytestring >=1.0 - bilge >=0.21.1 - - blaze-builder >=0.3 - bloodhound >=0.13 - brig-types >=0.91.1 - bytestring >=0.10 diff --git a/services/brig/src/Brig/AWS.hs b/services/brig/src/Brig/AWS.hs index 3bdda419e09..09af84e1a5d 100644 --- a/services/brig/src/Brig/AWS.hs +++ b/services/brig/src/Brig/AWS.hs @@ -44,7 +44,6 @@ module Brig.AWS ) where -import Blaze.ByteString.Builder (toLazyByteString) import qualified Brig.Options as Opt import Control.Lens hiding ((.=)) import Control.Monad.Catch @@ -52,6 +51,7 @@ import qualified Control.Monad.Trans.AWS as AWST import Control.Monad.Trans.Resource import Control.Retry import Data.Aeson hiding ((.=)) +import Data.ByteString.Builder (toLazyByteString) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as Text import qualified Data.Text.Encoding as Text diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal index c31d64b1ca2..c13e545213b 100644 --- a/services/cargohold/cargohold.cabal +++ b/services/cargohold/cargohold.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 7a319e64df8c4523bb37b4ce4f2249a99ac0db1b935aa093e8d781b726fab68a +-- hash: 8d783eed9262ccdd5d845888d2283d21217d99e85c7d1d32262a9022ab9fa1b0 name: cargohold version: 1.5.0 @@ -32,6 +32,7 @@ library CargoHold.API.V3 CargoHold.API.V3.Resumable CargoHold.App + CargoHold.AWS CargoHold.CloudFront CargoHold.Metrics CargoHold.Options @@ -50,9 +51,12 @@ library HsOpenSSL >=0.11 , HsOpenSSL-x509-system >=0.1 , aeson >=0.11 + , amazonka >=1.3.7 + , amazonka-cloudfront >=1.3.7 + , amazonka-core >=1.3.7 + , amazonka-s3 >=1.3.7 , attoparsec >=0.12 , auto-update >=0.1.4 - , aws >=0.18 , base >=4 && <5 , base16-bytestring >=0.1 , base64-bytestring >=1.0 @@ -78,8 +82,11 @@ library , http-types >=0.8 , imports , lens >=4.1 + , lifted-async >=0.9.3 + , lifted-base >=0.2 , metrics-wai >=0.4 , mime >=0.4 + , monad-control >=1.0 , mtl >=2.1 , network >=2.4 , optparse-applicative >=0.10 @@ -95,7 +102,10 @@ library , time >=1.4 , tinylog >=0.10 , transformers >=0.3 + , transformers-base >=0.3 , types-common >=0.16 + , unliftio-core >=0.1 + , unordered-containers >=0.2 , uri-bytestring >=0.2 , uuid >=1.3.5 , wai >=3.0 @@ -140,6 +150,7 @@ executable cargohold , safe >=0.3 , text >=1.1 , transformers >=0.3 + , transformers-base >=0.3 , types-common , yaml >=0.8 if flag(static) @@ -191,6 +202,7 @@ executable cargohold-integration , text >=1.1 , time >=1.5 , transformers >=0.3 + , transformers-base >=0.3 , types-common >=0.7 , uuid >=1.3 , wai-utilities >=0.12 diff --git a/services/cargohold/package.yaml b/services/cargohold/package.yaml index e48fae8e3b9..9c1e35d5aa5 100644 --- a/services/cargohold/package.yaml +++ b/services/cargohold/package.yaml @@ -30,15 +30,19 @@ dependencies: - safe >=0.3 - text >=1.1 - transformers >=0.3 +- transformers-base >=0.3 - yaml >=0.8 - imports library: source-dirs: src dependencies: - base >=4 && <5 + - amazonka >=1.3.7 + - amazonka-core >=1.3.7 + - amazonka-s3 >=1.3.7 + - amazonka-cloudfront >=1.3.7 - attoparsec >=0.12 - auto-update >=0.1.4 - - aws >=0.18 - byteable >=0.1 - base16-bytestring >=0.1 - cargohold-types >=0.5 @@ -51,7 +55,10 @@ library: - http-client-openssl >=0.2 - http-conduit >=2.1 - lens >=4.1 + - lifted-async >=0.9.3 + - lifted-base >=0.2 - metrics-wai >=0.4 + - monad-control >=1.0 - network >=2.4 - optparse-applicative >=0.10 - random >=1.1 @@ -63,6 +70,8 @@ library: - tinylog >=0.10 - types-common >=0.16 - split >=0.2 + - unliftio-core >=0.1 + - unordered-containers >=0.2 - uri-bytestring >=0.2 - uuid >=1.3.5 - wai >=3.0 diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index f6fcf21afbf..d579f764983 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/services/cargohold/src/CargoHold/API/V3.hs @@ -35,18 +35,19 @@ 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 Control.Applicative (optional) import Control.Error import Control.Lens ((^.), set, view) +import Control.Monad.Trans.Resource import Crypto.Hash +import Crypto.Random (getRandomBytes) import Data.Aeson (eitherDecodeStrict') import Data.Attoparsec.ByteString.Char8 import qualified Data.ByteString.Base64 as B64 import qualified Data.CaseInsensitive as CI import Data.Conduit -import qualified Data.Conduit as Conduit import qualified Data.Conduit.Attoparsec as Conduit -import qualified Data.Conduit.Binary as Conduit import Data.Id import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (decodeLatin1) @@ -56,10 +57,9 @@ import Data.UUID.V4 import Imports hiding (take) import Network.HTTP.Types.Header import Network.Wai.Utilities (Error (..)) -import OpenSSL.Random (randBytes) import URI.ByteString -upload :: V3.Principal -> ConduitM () ByteString IO () -> Handler V3.Asset +upload :: V3.Principal -> ConduitM () ByteString (ResourceT IO) () -> Handler V3.Asset upload own bdy = do (rsrc, sets) <- parseMetadata bdy assetSettings (src, hdrs) <- parseHeaders rsrc assetHeaders @@ -69,12 +69,11 @@ upload own bdy = do maxTotalBytes <- view (settings . setMaxTotalBytes) when (cl > maxTotalBytes) $ throwE assetTooLarge - let stream = src .| Conduit.isolate cl ast <- liftIO $ Id <$> nextRandom tok <- if sets ^. V3.setAssetPublic then return Nothing else Just <$> randToken let ret = fromMaybe V3.AssetPersistent (sets ^. V3.setAssetRetention) let key = V3.AssetKeyV3 ast ret - void $ S3.uploadV3 own key hdrs tok stream + void $ S3.uploadV3 own key hdrs tok src Metrics.s3UploadOk Metrics.s3UploadSize cl expires <- case V3.assetRetentionSeconds ret of @@ -102,7 +101,7 @@ updateToken own key tok = do S3.updateMetadataV3 key m' randToken :: MonadIO m => m V3.AssetToken -randToken = liftIO $ V3.AssetToken . Ascii.encodeBase64Url <$> randBytes 16 +randToken = liftIO $ V3.AssetToken . Ascii.encodeBase64Url <$> getRandomBytes 16 download :: V3.Principal -> V3.AssetKey -> Maybe V3.AssetToken -> Handler (Maybe URI) download own key tok = S3.getMetadataV3 key >>= maybe notFound found @@ -124,18 +123,18 @@ delete own key = do ----------------------------------------------------------------------------- -- Streaming multipart parsing -parseMetadata :: ConduitM () ByteString IO () -> Parser a -> Handler (SealedConduitT () ByteString IO (), a) +parseMetadata :: ConduitM () ByteString (ResourceT IO) () -> Parser a -> Handler (SealedConduitT () ByteString (ResourceT IO) (), a) parseMetadata src psr = do - (rsrc, meta) <- liftIO $ src $$+ sinkParser psr + (rsrc, meta) <- liftIO . runResourceT $ src $$+ sinkParser psr (rsrc,) <$> hoistEither meta -parseHeaders :: SealedConduitT () ByteString IO () -> Parser a -> Handler (ConduitM () ByteString IO (), a) +parseHeaders :: SealedConduitT () ByteString (ResourceT IO) () -> Parser a -> Handler (ConduitM () ByteString (ResourceT IO) (), a) parseHeaders src prs = do - (rsrc, hdrs) <- liftIO $ src $$++ sinkParser prs + (rsrc, hdrs) <- liftIO $ runResourceT $ src $$++ sinkParser prs let src' = Conduit.unsealConduitT rsrc (src',) <$> hoistEither hdrs -sinkParser :: Parser a -> ConduitM ByteString o IO (Either Error a) +sinkParser :: Parser a -> ConduitM ByteString o (ResourceT IO) (Either Error a) sinkParser p = fmapL mkError <$> Conduit.sinkParserEither p where mkError = clientError . LT.pack . mkMsg diff --git a/services/cargohold/src/CargoHold/AWS.hs b/services/cargohold/src/CargoHold/AWS.hs new file mode 100644 index 00000000000..fe967ace206 --- /dev/null +++ b/services/cargohold/src/CargoHold/AWS.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module CargoHold.AWS + ( -- * Monad + Env, + mkEnv, + useDownloadEndpoint, + Amazon, + amazonkaEnv, + execute, + s3Bucket, + cloudFront, + Error (..), + + -- * AWS + send, + sendCatch, + exec, + execCatch, + ) +where + +import CargoHold.CloudFront +import CargoHold.Options +import Control.Lens hiding ((.=)) +import Control.Monad.Catch +import qualified Control.Monad.Trans.AWS as AWST +import Control.Monad.Trans.Resource +import Control.Retry +import Data.ByteString.Builder (toLazyByteString) +import Imports +import Network.AWS (AWSRequest, Rs) +import qualified Network.AWS as AWS +import qualified Network.AWS.Env as AWS +import qualified Network.AWS.S3 as S3 +import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), Manager) +import qualified System.Logger as Logger +import qualified System.Logger.Class as Log +import System.Logger.Class (Logger, MonadLogger (log), (~~)) +import Util.Options (AWSEndpoint (..)) + +data Env = Env + { _logger :: !Logger, + _s3Bucket :: !Text, + _amazonkaEnv :: !AWS.Env, + -- | Endpoint for downloading assets (for the external world). + -- This gets used with Minio, which Cargohold can reach using a cluster-internal endpoint, + -- but clients can't, so we need to use a public one for pre-signed URLs we redirect to. + _amazonkaDownloadEndpoint :: !AWSEndpoint, + _cloudFront :: !(Maybe CloudFront) + } + +makeLenses ''Env + +-- | Override the endpoint in the '_amazonkaEnv' with '_amazonkaDownloadEndpoint'. +useDownloadEndpoint :: Env -> Env +useDownloadEndpoint e = + e & amazonkaEnv %~ AWS.override (setAWSEndpoint (e ^. amazonkaDownloadEndpoint)) + +setAWSEndpoint :: AWSEndpoint -> AWS.Service -> AWS.Service +setAWSEndpoint e = AWS.setEndpoint (_awsSecure e) (_awsHost e) (_awsPort e) + +newtype Amazon a = Amazon + { unAmazon :: ReaderT Env (ResourceT IO) a + } + deriving + ( Functor, + Applicative, + Monad, + MonadIO, + MonadThrow, + MonadCatch, + MonadMask, + MonadReader Env, + MonadResource + ) + +instance MonadLogger Amazon where + log l m = view logger >>= \g -> Logger.log g l m + +instance MonadUnliftIO Amazon where + askUnliftIO = Amazon $ ReaderT $ \r -> + withUnliftIO $ \u -> + return (UnliftIO (unliftIO u . flip runReaderT r . unAmazon)) + +instance AWS.MonadAWS Amazon where + liftAWS a = view amazonkaEnv >>= flip AWS.runAWS a + +mkEnv :: + Logger -> + -- | S3 endpoint + AWSEndpoint -> + -- | Endpoint for downloading assets (for the external world) + AWSEndpoint -> + -- | Bucket + Text -> + Maybe CloudFrontOpts -> + Manager -> + IO Env +mkEnv lgr s3End s3Download bucket cfOpts mgr = do + let g = Logger.clone (Just "aws.cargohold") lgr + e <- mkAwsEnv g (setAWSEndpoint s3End S3.s3) + cf <- mkCfEnv cfOpts + return (Env g bucket e s3Download cf) + where + mkCfEnv (Just o) = Just <$> initCloudFront (o ^. cfPrivateKey) (o ^. cfKeyPairId) 300 (o ^. cfDomain) + mkCfEnv Nothing = return Nothing + mkAwsEnv g s3 = + AWS.newEnvWith AWS.Discover Nothing mgr + <&> set AWS.envLogger (awsLogger g) + <&> AWS.configure s3 + awsLogger g l = Logger.log g (mapLevel l) . Log.msg . toLazyByteString + mapLevel AWS.Info = Logger.Info + mapLevel AWS.Debug = Logger.Trace + mapLevel AWS.Trace = Logger.Trace + mapLevel AWS.Error = Logger.Debug + +execute :: MonadIO m => Env -> Amazon a -> m a +execute e m = liftIO $ runResourceT (runReaderT (unAmazon m) e) + +data Error where + GeneralError :: (Show e, AWS.AsError e) => e -> Error + +deriving instance Show Error + +deriving instance Typeable Error + +instance Exception Error + +-------------------------------------------------------------------------------- +-- Utilities + +sendCatch :: AWSRequest r => r -> Amazon (Either AWS.Error (Rs r)) +sendCatch = AWST.trying AWS._Error . AWS.send + +send :: AWSRequest r => r -> Amazon (Rs r) +send r = throwA =<< sendCatch r + +throwA :: Either AWS.Error a -> Amazon a +throwA = either (throwM . GeneralError) return + +exec :: + (AWSRequest r, MonadIO m) => + Env -> + (Text -> r) -> + m (Rs r) +exec env request = do + let bucket = _s3Bucket env + execute env (AWS.send $ request bucket) + +execCatch :: + (AWSRequest r, Show r, MonadLogger m, MonadIO m) => + Env -> + (Text -> r) -> + m (Maybe (Rs r)) +execCatch env request = do + let req = request (_s3Bucket env) + resp <- execute env (retrying retry5x (const canRetry) (const (sendCatch req))) + case resp of + Left err -> do + Log.debug $ + Log.field "remote" (Log.val "S3") + ~~ Log.msg (show err) + ~~ Log.msg (show req) + return Nothing + Right r -> return $ Just r + +canRetry :: MonadIO m => Either AWS.Error a -> m Bool +canRetry (Right _) = pure False +canRetry (Left e) = case e of + AWS.TransportError (HttpExceptionRequest _ ResponseTimeout) -> pure True + AWS.ServiceError se | se ^. AWS.serviceCode == AWS.ErrorCode "RequestThrottled" -> pure True + _ -> pure False + +retry5x :: (Monad m) => RetryPolicyM m +retry5x = limitRetries 5 <> exponentialBackoff 100000 diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index 9745abf08e5..74657f73e39 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -22,10 +22,9 @@ module CargoHold.App ( -- * Environment Env, - AwsEnv (..), newEnv, closeEnv, - CargoHold.App.aws, + aws, httpManager, metrics, appLogger, @@ -44,13 +43,10 @@ module CargoHold.App ) where -import qualified Aws -import qualified Aws.Core as Aws -import qualified Aws.S3 as Aws import Bilge (Manager, MonadHttp, RequestId (..), newManager, withResponse) import qualified Bilge import Bilge.RPC (HasRequestId (..)) -import CargoHold.CloudFront +import qualified CargoHold.AWS as AWS import CargoHold.Options as Opt import Control.Error (ExceptT, exceptT) import Control.Lens ((^.), makeLenses, set, view) @@ -69,16 +65,14 @@ import qualified Network.Wai.Utilities.Server as Server import OpenSSL.Session (SSLContext, SSLOption (..)) import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL -import qualified Ropes.Aws as Aws import System.Logger.Class hiding (settings) import qualified System.Logger.Extended as Log -import Util.Options ------------------------------------------------------------------------------- -- Environment data Env = Env - { _aws :: AwsEnv, + { _aws :: AWS.Env, _metrics :: Metrics, _appLogger :: Logger, _httpManager :: Manager, @@ -86,16 +80,6 @@ data Env = Env _settings :: Opt.Settings } -data AwsEnv = AwsEnv - { awsEnv :: Aws.Env, - -- | Needed for presigned, S3 requests (Only works with GET) - s3UriOnly :: Aws.S3Configuration Aws.UriOnlyQuery, - -- | For all other requests - s3Config :: Aws.S3Configuration Aws.NormalQuery, - s3Bucket :: Text, - cloudFront :: Maybe CloudFront - } - makeLenses ''Env newEnv :: Opts -> IO Env @@ -103,38 +87,14 @@ newEnv o = do met <- Metrics.metrics lgr <- Log.mkLogger (o ^. optLogLevel) (o ^. optLogNetStrings) (o ^. optLogFormat) mgr <- initHttpManager - awe <- initAws o lgr mgr - return $ Env awe met lgr mgr def (o ^. optSettings) - -initAws :: Opts -> Logger -> Manager -> IO AwsEnv -initAws o l m = do - let awsOpts = o ^. optAws - amz <- Aws.newEnv l m $ liftM2 (,) (awsOpts ^. awsKeyId) (awsOpts ^. awsSecretKey) - sig <- newCloudFrontEnv (o ^. optAws . awsCloudFront) (o ^. optSettings . setDownloadLinkTTL) - let s3cfg :: Aws.S3Configuration queryType - s3cfg = endpointToConfig (awsOpts ^. awsS3Endpoint) - s3cfgDownload = maybe s3cfg endpointToConfig (awsOpts ^. awsS3DownloadEndpoint) - return $! AwsEnv amz s3cfgDownload s3cfg (awsOpts ^. awsS3Bucket) sig - where - newCloudFrontEnv Nothing _ = return Nothing - newCloudFrontEnv (Just cf) ttl = - return . Just - =<< initCloudFront - (cf ^. cfPrivateKey) - (cf ^. cfKeyPairId) - ttl - (cf ^. cfDomain) - -endpointToConfig :: AWSEndpoint -> Aws.S3Configuration qt -endpointToConfig (AWSEndpoint host secure port) = - (Aws.s3 (toProtocol secure) host False) - { Aws.s3Port = port, - Aws.s3RequestStyle = Aws.PathStyle - } + ama <- initAws (o ^. optAws) lgr mgr + return $ Env ama met lgr mgr def (o ^. optSettings) + +initAws :: AWSOpts -> Logger -> Manager -> IO AWS.Env +initAws o l m = + AWS.mkEnv l (o ^. awsS3Endpoint) downloadEndpoint (o ^. awsS3Bucket) (o ^. awsCloudFront) m where - toProtocol :: Bool -> Aws.Protocol - toProtocol True = Aws.HTTPS - toProtocol False = Aws.HTTP + downloadEndpoint = fromMaybe (o ^. awsS3Endpoint) (o ^. awsS3DownloadEndpoint) initHttpManager :: IO Manager initHttpManager = diff --git a/services/cargohold/src/CargoHold/Options.hs b/services/cargohold/src/CargoHold/Options.hs index 540a1e56864..6e55de6257b 100644 --- a/services/cargohold/src/CargoHold/Options.hs +++ b/services/cargohold/src/CargoHold/Options.hs @@ -23,7 +23,6 @@ import CargoHold.CloudFront (Domain (..), KeyPairId (..)) import Control.Lens hiding (Level) import Data.Aeson.TH import Imports -import qualified Ropes.Aws as Aws import System.Logger.Extended (Level, LogFormat) import Util.Options import Util.Options.Common @@ -44,13 +43,7 @@ deriveFromJSON toOptionFieldName ''CloudFrontOpts makeLenses ''CloudFrontOpts data AWSOpts = AWSOpts - { -- | Key ID; if 'Nothing', will be taken from the environment or from instance metadata - -- (when running on an AWS instance) - _awsKeyId :: !(Maybe Aws.AccessKeyId), - -- | Secret key - _awsSecretKey :: !(Maybe Aws.SecretAccessKey), - -- | S3 endpoint - _awsS3Endpoint :: !AWSEndpoint, + { _awsS3Endpoint :: !AWSEndpoint, -- | S3 endpoint for generating download links. Useful if Cargohold is configured to use -- an S3 replacement running inside the internal network (in which case internally we -- would use one hostname for S3, and when generating an asset link for a client app, we diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index bdbcba4ccb5..7d99498cd5c 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -49,29 +49,26 @@ module CargoHold.S3 ) where -import qualified Aws as Aws -import Aws.Core (ResponseConsumer (..), SignQuery (..), throwStatusCodeException) -import qualified Aws.Core as Aws -import Aws.S3 -import qualified Bilge.Retry as Retry import CargoHold.API.Error -import CargoHold.App hiding (Handler) +import qualified CargoHold.AWS as AWS +import CargoHold.App hiding (Env, Handler) import CargoHold.Options import qualified CargoHold.Types.V3 as V3 import qualified CargoHold.Types.V3.Resumable as V3 import qualified Codec.MIME.Parse as MIME import qualified Codec.MIME.Type as MIME +import Conduit import Control.Error (ExceptT, throwE) -import Control.Lens (view) -import Control.Monad.Catch -import Control.Monad.Trans.Resource -import Control.Retry +import Control.Lens hiding ((.=), (:<), (:>), parts) +import Data.ByteString.Builder (toLazyByteString) import qualified Data.ByteString.Char8 as C8 import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LBS -import Data.Conduit +import qualified Data.CaseInsensitive as CI import qualified Data.Conduit.Binary as Conduit +import qualified Data.HashMap.Lazy as HML import Data.Id +import qualified Data.List.NonEmpty as NE import Data.Sequence (Seq, ViewL (..), ViewR (..)) import qualified Data.Sequence as Seq import qualified Data.Text as Text @@ -81,17 +78,14 @@ import qualified Data.Text.Encoding as Text import Data.Time.Clock import qualified Data.UUID as UUID import Imports -import Network.HTTP.Client -import Network.HTTP.Client.Conduit (requestBodySource) -import qualified Network.HTTP.Conduit as Http -import Network.HTTP.Types (toQuery) -import Network.HTTP.Types.Status +import Network.AWS hiding (Error) +import Network.AWS.Data.Body +import Network.AWS.Data.Crypto +import Network.AWS.S3 import Network.Wai.Utilities.Error (Error (..)) -import qualified Ropes.Aws as Aws import Safe (readMay) import qualified System.Logger.Class as Log -import System.Logger.Message -import Text.XML.Cursor (($/), (&|), laxElement) +import System.Logger.Message ((.=), msg, val, (~~)) import URI.ByteString newtype S3AssetKey = S3AssetKey {s3Key :: Text} @@ -103,13 +97,14 @@ data S3AssetMeta = S3AssetMeta v3AssetToken :: Maybe V3.AssetToken, v3AssetType :: MIME.Type } + deriving (Show) uploadV3 :: V3.Principal -> V3.AssetKey -> V3.AssetHeaders -> Maybe V3.AssetToken -> - ConduitM () ByteString IO () -> + Conduit.ConduitM () ByteString (ResourceT IO) () -> ExceptT Error App () uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do Log.debug $ @@ -119,31 +114,37 @@ uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do ~~ "asset.type" .= MIME.showType ct ~~ "asset.size" .= cl ~~ msg (val "Uploading asset") - b <- s3Bucket <$> view aws - let body = requestBodySource (fromIntegral cl) src - void . tryS3 . exec $ - (putObject b key body) - { poContentMD5 = Just md5, - poContentType = Just (encodeMIMEType ct), - poExpect100Continue = True, - poMetadata = - catMaybes - [ setAmzMetaToken <$> tok, - Just (setAmzMetaPrincipal prc) - ] - } + void $ exec req + where + stream = + src + -- Rechunk bytestream to ensure we satisfy AWS's minimum chunk size + -- on uploads + .| Conduit.chunksOfCE (fromIntegral defaultChunkSize) + -- Ignore any 'junk' after the content; take only 'cl' bytes. + .| Conduit.isolate (fromIntegral cl) + reqBdy = ChunkedBody defaultChunkSize (fromIntegral cl) stream + md5Res = Text.decodeLatin1 $ digestToBase Base64 md5 + req b = + putObject (BucketName b) (ObjectKey key) (toBody reqBdy) + & poContentType ?~ MIME.showType ct + & poContentMD5 ?~ md5Res + & poMetadata .~ metaHeaders tok prc getMetadataV3 :: V3.AssetKey -> ExceptT Error App (Maybe S3AssetMeta) getMetadataV3 (s3Key . mkKey -> key) = do Log.debug $ "remote" .= val "S3" ~~ "asset.key" .= key - ~~ msg (val "Getting asset metadata") - b <- s3Bucket <$> view aws - (_, r) <- tryS3 . recovering x3 handlers . const . exec $ headObjectX b key - let ct = fromMaybe octets (parseMIMEType =<< horxContentType r) - return $ parse ct =<< (omUserMetadata <$> horxMetadata r) + ~~ msg + (val "Getting asset metadata") + maybe (return Nothing) handle =<< execCatch req where + req b = headObject (BucketName b) (ObjectKey key) + handle r = do + let ct = fromMaybe octets (MIME.parseMIMEType =<< r ^. horsContentType) + let meta = HML.toList $ r ^. horsMetadata + return $ parse ct meta parse ct h = S3AssetMeta <$> getAmzMetaPrincipal h @@ -156,8 +157,13 @@ deleteV3 (s3Key . mkKey -> key) = do "remote" .= val "S3" ~~ "asset.key" .= key ~~ msg (val "Deleting asset") - b <- s3Bucket <$> view aws - void . tryS3 $ exec (DeleteObject key b) + Log.debug $ + "remote" .= val "S3" + ~~ "asset.key" .= key + ~~ msg (val "Deleting asset") + void $ exec req + where + req b = deleteObject (BucketName b) (ObjectKey key) updateMetadataV3 :: V3.AssetKey -> S3AssetMeta -> ExceptT Error App () updateMetadataV3 (s3Key . mkKey -> key) (S3AssetMeta prc tok ct) = do @@ -166,29 +172,29 @@ updateMetadataV3 (s3Key . mkKey -> key) (S3AssetMeta prc tok ct) = do ~~ "asset.owner" .= show prc ~~ "asset.key" .= key ~~ msg (val "Updating asset metadata") - b <- s3Bucket <$> view aws - let hdrs = - catMaybes - [ setAmzMetaToken <$> tok, - Just (setAmzMetaPrincipal prc) - ] - let meta = ReplaceMetadata hdrs - void . tryS3 . recovering x3 handlers . const . exec $ - (copyObject b key (ObjectId b key Nothing) meta) - { coContentType = Just (encodeMIMEType ct) - } + void $ exec req + where + copySrc b = + decodeLatin1 . LBS.toStrict . toLazyByteString + $ urlEncode [] + $ Text.encodeUtf8 (b <> "/" <> key) + req b = + copyObject (BucketName b) (copySrc b) (ObjectKey key) + & coContentType ?~ MIME.showType ct + & coMetadataDirective ?~ MDReplace + & coMetadata .~ metaHeaders tok prc signedURL :: (ToByteString p) => p -> ExceptT Error App URI signedURL path = do e <- view aws - b <- s3Bucket <$> view aws - cfg' <- liftIO $ Aws.getConfig (awsEnv e) + let b = view AWS.s3Bucket e + now <- liftIO getCurrentTime ttl <- view (settings . setDownloadLinkTTL) - let cfg = cfg' {Aws.timeInfo = Aws.ExpiresIn (fromIntegral ttl)} - uri <- - liftIO $ Aws.awsUri cfg (s3UriOnly e) $ - getObject b (Text.decodeLatin1 $ toByteString' path) - return =<< toUri uri + let req = getObject (BucketName b) (ObjectKey . Text.decodeLatin1 $ toByteString' path) + signed <- + AWS.execute (AWS.useDownloadEndpoint e) $ + presignURL now (Seconds (fromIntegral ttl)) req + toUri signed where toUri x = case parseURI strictURIParserOptions x of Left e -> do @@ -205,6 +211,14 @@ mkKey (V3.AssetKeyV3 i r) = S3AssetKey $ "v3/" <> retention <> "/" <> key key = UUID.toText (toUUID i) retention = V3.retentionToTextRep r +metaHeaders :: Maybe V3.AssetToken -> V3.Principal -> HML.HashMap Text Text +metaHeaders tok prc = + HML.fromList $ + catMaybes + [ setAmzMetaToken <$> tok, + Just (setAmzMetaPrincipal prc) + ] + ------------------------------------------------------------------------------- -- Resumable Uploads @@ -325,25 +339,24 @@ minBigSize = 5 * 1024 * 1024 -- 5 MiB getResumable :: V3.AssetKey -> ExceptT Error App (Maybe S3Resumable) getResumable k = do - let rk = mkResumableKey k - mk = mkResumableKeyMeta k Log.debug $ "remote" .= val "S3" ~~ "asset" .= toByteString k ~~ "asset.key" .= toByteString rk ~~ "asset.key.meta" .= toByteString mk ~~ msg (val "Getting resumable asset metadata") - b <- s3Bucket <$> view aws - (_, hor) <- - tryS3 . recovering x3 handlers . const . exec $ - headObjectX b (s3ResumableKey mk) - let ct = fromMaybe octets (horxContentType hor >>= parseMIMEType) - let meta = omUserMetadata <$> horxMetadata hor - case meta >>= parse rk ct of - Nothing -> return Nothing - Just r -> fmap (\cs -> r {resumableChunks = cs}) <$> listChunks r + maybe (return Nothing) handle =<< execCatch req where - parse rk ct h = + rk = mkResumableKey k + mk = mkResumableKeyMeta k + req b = headObject (BucketName b) (ObjectKey $ s3ResumableKey mk) + handle r = do + let ct = fromMaybe octets (MIME.parseMIMEType =<< view horsContentType r) + let meta = HML.toList $ view horsMetadata r + case parse ct meta of + Nothing -> return Nothing + Just r' -> fmap (\cs -> r' {resumableChunks = cs}) <$> listChunks r' + parse ct h = S3Resumable rk k <$> getAmzMetaPrincipal h <*> getAmzMetaChunkSize h @@ -365,32 +378,26 @@ createResumable k p typ size tok = do let csize = calculateChunkSize size ex <- addUTCTime V3.assetVolatileSeconds <$> liftIO getCurrentTime let key = mkResumableKey k + mk = mkResumableKeyMeta k let res = S3Resumable key k p csize size typ tok ex Nothing Seq.empty - b <- s3Bucket <$> view aws - up <- initMultipart b res + up <- initMultipart res let ct = resumableType res - let mk = mkResumableKeyMeta k - void . tryS3 . recovering x3 handlers . const . exec $ - (putObject b (s3ResumableKey mk) mempty) - { poContentType = Just (encodeMIMEType ct), - poMetadata = resumableMeta csize ex up - } + void . exec $ first (s3ResumableKey mk) ct (resumableMeta csize ex up) return res {resumableUploadId = up} where - initMultipart b r + initMultipart r | canUseMultipart r = do - (_, imur) <- - tryS3 . recovering x3 handlers . const . exec $ - (postInitiateMultipartUpload b (s3Key (mkKey k))) - { imuContentType = Just (MIME.showType (resumableType r)), - imuMetadata = - catMaybes - [ setAmzMetaToken <$> resumableToken r, - Just (setAmzMetaPrincipal p) - ] - } - return $! Just $! imurUploadId imur + let cmu b = + createMultipartUpload (BucketName b) (ObjectKey $ s3Key (mkKey k)) + & cmuContentType ?~ MIME.showType (resumableType r) + & cmuMetadata .~ metaHeaders (resumableToken r) p + imur <- exec cmu + return $! view cmursUploadId imur | otherwise = return Nothing + first key ct meta b = + putObject (BucketName b) (ObjectKey key) (toBody (mempty :: ByteString)) + & poContentType ?~ MIME.showType ct + & poMetadata .~ HML.fromList meta -- Determine whether a given 'S3Resumable' is eligible for the -- S3 multipart upload API. That is the case if the chunk size -- is >= 5 MiB or if there is only 1 chunk (<= 'minSmallSize'). @@ -411,10 +418,9 @@ createResumable k p typ size tok = do uploadChunk :: S3Resumable -> V3.Offset -> - SealedConduitT () ByteString IO () -> - ExceptT Error App (S3Resumable, SealedConduitT () ByteString IO ()) + Conduit.SealedConduitT () ByteString IO () -> + ExceptT Error App (S3Resumable, Conduit.SealedConduitT () ByteString IO ()) uploadChunk r offset rsrc = do - b <- s3Bucket <$> view aws let chunkSize = fromIntegral (resumableChunkSize r) (rest, chunk) <- liftIO $ rsrc $$++ Conduit.take chunkSize let size = fromIntegral (LBS.length chunk) @@ -428,38 +434,33 @@ uploadChunk r offset rsrc = do ~~ "asset.size" .= toByteString size ~~ msg (val "Uploading chunk") c <- case resumableUploadId r of - Nothing -> putChunk b chunk size - Just up -> putPart b up chunk size + Nothing -> putChunk chunk size + Just up -> putPart up chunk size let r' = r {resumableChunks = resumableChunks r Seq.|> c} return (r', rest) where nr = mkChunkNr r offset - ct = encodeMIMEType (resumableType r) - putChunk b chunk size = do + ct = MIME.showType (resumableType r) + putChunk chunk size = do let S3ChunkKey k = mkChunkKey (resumableKey r) nr - void . tryS3 . recovering x3 handlers . const . exec $ - (putObject b k (RequestBodyLBS chunk)) - { poContentType = Just ct, - poExpect100Continue = True - } + let req b = + putObject (BucketName b) (ObjectKey k) (toBody chunk) + & poContentType ?~ ct + void $ exec req return $! S3Chunk nr offset size (S3ETag "") - putPart b up chunk size = do + putPart up chunk size = do let S3AssetKey k = mkKey (resumableAsset r) - (_, upr) <- - tryS3 . recovering x3 handlers . const . exec $ - (uploadPart b k (fromIntegral nr) up (RequestBodyLBS chunk)) - { upContentType = Just ct, - upExpect100Continue = True, - upContentMD5 = Nothing - } - let etag = S3ETag (uprETag upr) + let req b = + uploadPart (BucketName b) (ObjectKey k) (fromIntegral nr) up (toBody chunk) + tg <- view uprsETag <$> exec req + etag <- case tg of + Just (ETag t) -> return $ S3ETag (Text.decodeLatin1 t) + Nothing -> throwE serverError return $! S3Chunk nr offset size etag -- | Complete a resumable upload, assembling all chunks into a final asset. completeResumable :: S3Resumable -> ExceptT Error App () completeResumable r = do - let own = resumableOwner r - let ast = resumableAsset r Log.debug $ "remote" .= val "S3" ~~ "asset" .= toByteString ast @@ -468,10 +469,9 @@ completeResumable r = do ~~ msg (val "Completing resumable upload") let chunks = resumableChunks r verifyChunks chunks - b <- s3Bucket <$> view aws case resumableUploadId r of - Nothing -> assembleLocal b chunks - Just up -> assembleRemote b up chunks + Nothing -> assembleLocal chunks + Just up -> assembleRemote up (NE.nonEmpty $ toList chunks) Log.debug $ "remote" .= val "S3" ~~ "asset" .= toByteString ast @@ -479,26 +479,21 @@ completeResumable r = do ~~ "asset.key" .= toByteString (resumableKey r) ~~ msg (val "Resumable upload completed") where + (own, ast) = (resumableOwner r, resumableAsset r) -- Local assembly for small chunk sizes (< 5 MiB): Download and re-upload -- the chunks in a streaming fashion one-by-one to create the final object. - assembleLocal b chunks = do - env <- awsEnv <$> view aws - s3c <- s3Config <$> view aws - man <- view httpManager - let own = resumableOwner r - let ast = resumableAsset r - let size = fromIntegral (resumableTotalSize r) - let body = Http.requestBodySource size (chunkSource man env s3c b chunks) - void . tryS3 . exec $ - (putObject b (s3Key (mkKey ast)) body) - { poContentType = Just (encodeMIMEType (resumableType r)), - poExpect100Continue = True, - poMetadata = - catMaybes - [ setAmzMetaToken <$> resumableToken r, - Just (setAmzMetaPrincipal own) - ] - } + assembleLocal :: Seq S3Chunk -> ExceptT Error App () + assembleLocal chunks = do + e <- view aws + let totalSize = fromIntegral (resumableTotalSize r) + let chunkSize = calcChunkSize chunks + let reqBdy = Chunked $ ChunkedBody chunkSize totalSize (chunkSource e chunks) + let putRq b = + putObject (BucketName b) (ObjectKey (s3Key (mkKey ast))) reqBdy + & poContentType ?~ MIME.showType (resumableType r) + & poMetadata .~ metaHeaders (resumableToken r) own + void $ exec putRq + -- For symmetry with the behavior of the S3 multipart API, where the -- resumable upload and all parts are removed upon completion, we do -- the same here. @@ -506,21 +501,31 @@ completeResumable r = do let keys = s3ResumableKey rk : map (s3ChunkKey . mkChunkKey rk . chunkNr) (toList chunks) - void . tryS3 . exec $ (deleteObjects b keys) {dosQuiet = True} + let del = + delete' & dObjects .~ map (objectIdentifier . ObjectKey) keys + & dQuiet ?~ True + let delRq b = deleteObjects (BucketName b) del + void $ exec delRq + + -- All chunks except for the last should be of the same size so it makes + -- sense to use that as our default + calcChunkSize cs = case Seq.viewl cs of + EmptyL -> defaultChunkSize + c :< _ -> ChunkSize $ fromIntegral (chunkSize c) -- Remote assembly for large(r) chunk sizes (>= 5 MiB) via the -- S3 multipart upload API. - assembleRemote b up chunks = do - let ast = resumableAsset r + assembleRemote _ Nothing = throwE serverError + assembleRemote up (Just chunks) = do let key = s3Key (mkKey ast) - let parts = map mkPart (toList chunks) - void . tryS3 . exec $ postCompleteMultipartUpload b key up parts + let parts = fmap mkPart chunks + let completeRq b = + completeMultipartUpload (BucketName b) (ObjectKey key) up + & cMultipartUpload ?~ (completedMultipartUpload & cmuParts ?~ parts) + void $ exec completeRq let S3ResumableKey rkey = resumableKey r - void . tryS3 . exec $ - DeleteObject - { doBucket = b, - doObjectName = rkey - } - mkPart c = (fromIntegral (chunkNr c), s3ETag (chunkETag c)) + let delRq b = deleteObject (BucketName b) (ObjectKey rkey) + void $ exec delRq + mkPart c = completedPart (fromIntegral (chunkNr c)) (ETag . Text.encodeUtf8 $ s3ETag (chunkETag c)) -- Verify that the chunks constitute the full asset, i.e. that the -- upload is complete. verifyChunks cs = do @@ -529,24 +534,20 @@ completeResumable r = do $ throwE $ uploadIncomplete (resumableTotalSize r) total -- Construct a 'Source' by downloading the chunks. - chunkSource :: - Manager -> - Aws.Env -> - S3Configuration Aws.NormalQuery -> - Bucket -> - Seq S3Chunk -> - ConduitT () ByteString (ResourceT IO) () - chunkSource man env s3c b cs = case Seq.viewl cs of + -- chunkSource :: AWS.Env + -- -> Seq S3Chunk + -- -> Source (ResourceT IO) ByteString + chunkSource env cs = case Seq.viewl cs of EmptyL -> mempty c :< cc -> do - src <- lift $ do - let S3ChunkKey ck = mkChunkKey (resumableKey r) (chunkNr c) - (_, gor) <- - recovering x3 handlers $ const - $ Aws.sendRequest env s3c - $ getObject b ck - return $ responseBody (gorResponse gor) - src >> chunkSource man env s3c b cc + let S3ChunkKey ck = mkChunkKey (resumableKey r) (chunkNr c) + let b = view AWS.s3Bucket env + let req = getObject (BucketName b) (ObjectKey ck) + v <- + lift $ AWS.execute env $ + AWS.send req + >>= flip sinkBody Conduit.sinkLbs . view gorsBody + Conduit.yield (LBS.toStrict v) >> chunkSource env cc listChunks :: S3Resumable -> ExceptT Error App (Maybe (Seq S3Chunk)) listChunks r = do @@ -557,43 +558,48 @@ listChunks r = do ~~ "asset" .= toByteString ast ~~ "asset.resumable" .= key ~~ msg (val "Listing chunks") - b <- s3Bucket <$> view aws fmap Seq.fromList <$> case resumableUploadId r of - Nothing -> listBucket b key - Just up -> listParts b up + Nothing -> listBucket key + Just up -> listMultiParts up where - listBucket b k = do - (_, gbr) <- - tryS3 . recovering x3 handlers . const . exec $ - GetBucket - { gbBucket = b, - gbDelimiter = Nothing, - gbMarker = Nothing, - gbMaxKeys = Just (fromIntegral maxTotalChunks), - gbPrefix = Just (k <> "/") - } - return . Just $ mapMaybe chunkFromObject (gbrContents gbr) - listParts b up = do - (_, lpr) <- - tryS3 . recovering x3 handlers . const . exec $ - ListParts - { lpBucket = b, - lpObject = s3Key (mkKey (resumableAsset r)), - lpUploadId = up - } - return $ map chunkFromPart <$> lprsParts lpr + listBucket k = do + let req b = + listObjects (BucketName b) + & loPrefix ?~ (k <> "/") + & loMaxKeys ?~ fromIntegral maxTotalChunks + maybe (return Nothing) parseObjects =<< execCatch req + parseObjects = + return . Just . mapMaybe chunkFromObject + . view lorsContents + listMultiParts up = do + let req b = + listParts + (BucketName b) + (ObjectKey $ s3Key (mkKey (resumableAsset r))) + up + maybe (return Nothing) parseParts =<< execCatch req + parseParts = + return . Just . mapMaybe chunkFromPart + . view lprsParts + chunkFromObject :: Object -> Maybe S3Chunk chunkFromObject o = do - nr <- parseNr (objectKey o) - let etag = S3ETag (objectETag o) - let size = fromIntegral (objectSize o) + let (ObjectKey okey) = view oKey o + nr <- parseNr okey + let etag = + let (ETag t) = (view oETag o) + in S3ETag (Text.decodeLatin1 t) + let size = fromIntegral (view oSize o) let off = mkOffset r nr Just $! S3Chunk nr off size etag - chunkFromPart p = - let nr = S3ChunkNr (piNr p) - off = mkOffset r nr - size = piSize p - etag = S3ETag (piETag p) - in S3Chunk nr off size etag + chunkFromPart :: Part -> Maybe S3Chunk + chunkFromPart p = case (view pPartNumber p, view pETag p, view pSize p) of + (Just x, Just (ETag y), Just z) -> + let nr = S3ChunkNr (fromIntegral x) + off = mkOffset r nr + size = (fromIntegral z) + etag = S3ETag (Text.decodeLatin1 y) + in Just $! S3Chunk nr off size etag + _ -> Nothing parseNr = fmap S3ChunkNr . readMay . Text.unpack . snd . Text.breakOnEnd "/" mkResumableKey :: V3.AssetKey -> S3ResumableKey @@ -674,6 +680,9 @@ 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)) + getAmzMetaPrincipal :: [(Text, Text)] -> Maybe V3.Principal getAmzMetaPrincipal h = (V3.UserPrincipal <$> getAmzMetaUser h) @@ -692,12 +701,12 @@ getAmzMetaProvider = parseAmzMeta hAmzMetaProvider getAmzMetaToken :: [(Text, Text)] -> Maybe V3.AssetToken getAmzMetaToken h = V3.AssetToken . Ascii.unsafeFromText - <$> lookup hAmzMetaToken h + <$> lookupCI hAmzMetaToken h getAmzMetaUploadExpires :: [(Text, Text)] -> Maybe UTCTime getAmzMetaUploadExpires h = readMay . C8.unpack . encodeUtf8 - =<< lookup hAmzMetaUploadExpires h + =<< lookupCI hAmzMetaUploadExpires h getAmzMetaTotalSize :: [(Text, Text)] -> Maybe V3.TotalSize getAmzMetaTotalSize = parseAmzMeta hAmzMetaSize @@ -706,147 +715,29 @@ getAmzMetaChunkSize :: [(Text, Text)] -> Maybe V3.ChunkSize getAmzMetaChunkSize = parseAmzMeta hAmzMetaChunkSize getAmzMetaUploadId :: [(Text, Text)] -> Maybe Text -getAmzMetaUploadId = lookup hAmzMetaUploadId +getAmzMetaUploadId = lookupCI hAmzMetaUploadId parseAmzMeta :: FromByteString a => Text -> [(Text, Text)] -> Maybe a -parseAmzMeta k h = lookup k h >>= fromByteString . encodeUtf8 +parseAmzMeta k h = lookupCI k h >>= fromByteString . encodeUtf8 ------------------------------------------------------------------------------- -- Utilities -tryS3 :: ResourceT App a -> ExceptT Error App a -tryS3 action = do - e <- lift ask - runAppResourceT e action - `catch` \(ex :: S3Error) -> case s3ErrorCode ex of - "InvalidDigest" -> throwE invalidMD5 - "BadDigest" -> throwE invalidMD5 - "RequestTimeout" -> throwE requestTimeout - _ -> do - lift . Log.err $ msg (show ex) - throwE serverError - -exec :: - (Aws.Transaction r a, ServiceConfiguration r ~ S3Configuration) => - r -> - ResourceT App (ResponseMetadata a, a) -exec req = do - env <- awsEnv <$> view aws - s3c <- s3Config <$> view aws - Aws.sendRequest env s3c req - -x3 :: RetryPolicy -x3 = limitRetries 3 <> exponentialBackoff 200000 - -handlers :: Monad m => [RetryStatus -> Handler m Bool] -handlers = - Retry.httpHandlers - ++ [ const $ Handler $ \(S3Error s _ _ _ _ _ _ _ _ _) -> - return $ statusIsServerError s - ] - -parseMIMEType :: ByteString -> Maybe MIME.Type -parseMIMEType = MIME.parseMIMEType . decodeLatin1 - -encodeMIMEType :: MIME.Type -> ByteString -encodeMIMEType = Text.encodeUtf8 . MIME.showType - octets :: MIME.Type octets = MIME.Type (MIME.Application "octet-stream") [] --------------------------------------------------------------------------------- --- A custom HeadObject / HeadObjectResponse command pair, so we can --- have access to some more metadata, like the Content-Type header --- which we need to preserve when updating asset metadata in S3. --- This should not be necessary any longer once cargohold is migrated --- to use 'amazonka' instead of the 'aws' package. - -newtype HeadObjectX = HeadObjectX HeadObject - deriving (Show) - -headObjectX :: Text -> Text -> HeadObjectX -headObjectX bucket key = HeadObjectX (headObject bucket key) - -data HeadObjectResponseX = HeadObjectResponseX - { horxContentType :: Maybe ByteString, - horxMetadata :: Maybe ObjectMetadata - } - -instance ResponseConsumer HeadObjectX HeadObjectResponseX where - type ResponseMetadata HeadObjectResponseX = S3Metadata - responseConsumer rq (HeadObjectX ho) meta rsp = do - hor <- responseConsumer rq ho meta rsp - let ct = lookup "Content-Type" (responseHeaders rsp) - return $! HeadObjectResponseX ct (horMetadata hor) - -instance Aws.Transaction HeadObjectX HeadObjectResponseX - -instance SignQuery HeadObjectX where - type ServiceConfiguration HeadObjectX = S3Configuration - signQuery (HeadObjectX ho) = signQuery ho - --------------------------------------------------------------------------------- --- S3 Multipart "List Parts" Operation --- The 'aws' package does not currently provide this operation, so we --- have our own minimal implementation. This should no longer be necessary --- once cargohold is migrated to use 'amazonka'. - -data ListParts = ListParts - { lpUploadId :: Text, - lpBucket :: Text, - lpObject :: Text - } - -newtype ListPartsResponse = ListPartsResponse - { lprsParts :: Maybe [PartInfo] - } - -data PartInfo = PartInfo - { piNr :: Word, - piETag :: Text, - piSize :: Word - } +exec :: (AWSRequest r) => (Text -> r) -> ExceptT Error App (Rs r) +exec req = do + env <- view aws + AWS.exec env req -instance SignQuery ListParts where - type ServiceConfiguration ListParts = S3Configuration - signQuery ListParts {..} = - s3SignQuery - S3Query - { s3QMethod = Aws.Get, - s3QBucket = Just $! Text.encodeUtf8 lpBucket, - s3QObject = Just $! Text.encodeUtf8 lpObject, - s3QSubresources = toQuery [("uploadId" :: ByteString, Just lpUploadId)], - s3QQuery = [], - s3QContentType = Nothing, - s3QContentMd5 = Nothing, - s3QAmzHeaders = [], - s3QOtherHeaders = [], - s3QRequestBody = Nothing - } - -instance ResponseConsumer ListParts ListPartsResponse where - type ResponseMetadata ListPartsResponse = S3Metadata - - responseConsumer rq _ rm rs - | status == status200 = parse rm rs - | status == status404 = return $ ListPartsResponse Nothing - | otherwise = throwStatusCodeException rq rs - where - status = responseStatus rs - parse = s3XmlResponseConsumer $ \cursor -> do - parts <- sequence $ cursor $/ laxElement "Part" &| parsePart - return $! ListPartsResponse (Just parts) - parsePart el = do - nr <- Aws.force "Missing Part Number" $ el $/ Aws.elContent "PartNumber" - et <- Aws.force "Missing ETag" $ el $/ Aws.elContent "ETag" - sz <- Aws.force "Missing Size" $ el $/ Aws.elContent "Size" - PartInfo <$> Aws.textReadInt nr <*> pure et <*> Aws.textReadInt sz - -instance Aws.Transaction ListParts ListPartsResponse - -instance Aws.AsMemoryResponse ListPartsResponse where - type MemoryResponse ListPartsResponse = ListPartsResponse - loadToMemory = return +execCatch :: + (AWSRequest r, Show r) => + (Text -> r) -> + ExceptT Error App (Maybe (Rs r)) +execCatch req = do + env <- view aws + AWS.execCatch env req -------------------------------------------------------------------------------- -- Legacy @@ -858,20 +749,19 @@ otrKey :: ConvId -> AssetId -> S3AssetKey otrKey c a = S3AssetKey $ "otr/" <> Text.pack (show c) <> "/" <> Text.pack (show a) getMetadata :: AssetId -> ExceptT Error App (Maybe Bool) -getMetadata aId = do - b <- s3Bucket <$> view aws - (_, r) <- - tryS3 . recovering x3 handlers . const . exec $ - headObject b (Text.pack $ show aId) - return $ parse <$> (omUserMetadata <$> horMetadata r) +getMetadata ast = do + r <- execCatch req + return $ parse <$> HML.toList <$> view horsMetadata <$> r where + req b = headObject (BucketName b) (ObjectKey . Text.pack $ show ast) parse = maybe False (Text.isInfixOf "public=true" . Text.toLower) - . lookup "zasset" + . lookupCI "zasset" getOtrMetadata :: ConvId -> AssetId -> ExceptT Error App (Maybe UserId) getOtrMetadata cnv ast = do - b <- s3Bucket <$> view aws let S3AssetKey key = otrKey cnv ast - (_, r) <- tryS3 . recovering x3 handlers . const $ exec (headObject b key) - return $ (omUserMetadata <$> horMetadata r) >>= getAmzMetaUser + r <- execCatch (req key) + return $ getAmzMetaUser =<< HML.toList <$> view horsMetadata <$> r + where + req k b = headObject (BucketName b) (ObjectKey k) diff --git a/services/cargohold/src/CargoHold/Util.hs b/services/cargohold/src/CargoHold/Util.hs index 6a5909d89cc..bfd9c9a29ef 100644 --- a/services/cargohold/src/CargoHold/Util.hs +++ b/services/cargohold/src/CargoHold/Util.hs @@ -17,6 +17,7 @@ module CargoHold.Util where +import CargoHold.AWS import CargoHold.App import qualified CargoHold.CloudFront as CloudFront import qualified CargoHold.S3 as S3 @@ -27,7 +28,7 @@ import URI.ByteString hiding (urlEncode) genSignedURL :: (ToByteString p) => p -> Handler URI genSignedURL path = do - uri <- cloudFront <$> view aws >>= \case + uri <- view (aws . cloudFront) >>= \case Nothing -> S3.signedURL path Just cf -> CloudFront.signedURL cf path return $! uri diff --git a/services/cargohold/src/Main.hs b/services/cargohold/src/Main.hs index afdd222b7c4..b0c1aecc4c7 100644 --- a/services/cargohold/src/Main.hs +++ b/services/cargohold/src/Main.hs @@ -26,9 +26,9 @@ import OpenSSL (withOpenSSL) import Util.Options main :: IO () -main = withOpenSSL $ do - options <- getOptions desc Nothing defaultPath - run options +main = + withOpenSSL $ + getOptions desc Nothing defaultPath >>= run where desc = "Cargohold - Asset Storage" defaultPath = "/etc/wire/cargohold/conf/cargohold.yaml" diff --git a/services/cargohold/test/integration/Main.hs b/services/cargohold/test/integration/Main.hs index f4f5a61662c..68620c43103 100644 --- a/services/cargohold/test/integration/Main.hs +++ b/services/cargohold/test/integration/Main.hs @@ -34,7 +34,6 @@ import qualified Metrics import Network.HTTP.Client (responseTimeoutMicro) import Network.HTTP.Client.TLS import Network.Wai.Utilities.Server (compile) -import OpenSSL import Options.Applicative import Test.Tasty import Test.Tasty.HUnit @@ -81,7 +80,7 @@ runTests run = defaultMainWithIngredients ings : defaultIngredients main :: IO () -main = withOpenSSL $ runTests go +main = runTests go where go c i = withResource (getOpts c i) releaseOpts $ \opts -> testGroup diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 137f2a6e6bd..8366b6753c5 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: d61c32c046efc149b7de08f80cc5f16ac31a6c90f59d51f04b53949da3a3c1b8 +-- hash: 85f04ae9c723a855be519c59f49ed58d99684c46e4541c67b15592f702fa26ea name: galley version: 0.83.0 @@ -87,7 +87,6 @@ library , base >=4.6 && <5 , base64-bytestring >=1.0 , bilge >=0.21.1 - , blaze-builder >=0.3 , brig-types >=0.73.1 , bytestring >=0.9 , bytestring-conversion >=0.2 diff --git a/services/galley/package.yaml b/services/galley/package.yaml index de589aedf05..81fc9d5884b 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -28,7 +28,6 @@ library: - base >=4.6 && <5 - base64-bytestring >=1.0 - bilge >=0.21.1 - - blaze-builder >=0.3 - brig-types >=0.73.1 - bytestring >=0.9 - bytestring-conversion >=0.2 diff --git a/services/galley/src/Galley/Aws.hs b/services/galley/src/Galley/Aws.hs index f0d86c1882a..0284eff6a67 100644 --- a/services/galley/src/Galley/Aws.hs +++ b/services/galley/src/Galley/Aws.hs @@ -32,13 +32,13 @@ module Galley.Aws ) where -import Blaze.ByteString.Builder (toLazyByteString) import Control.Lens hiding ((.=)) import Control.Monad.Catch import qualified Control.Monad.Trans.AWS as AWST import Control.Monad.Trans.Resource import Control.Retry (exponentialBackoff, limitRetries, retrying) import qualified Data.ByteString.Base64 as B64 +import Data.ByteString.Builder (toLazyByteString) import Data.ProtoLens.Encoding import Data.Text.Encoding (decodeLatin1) import Data.UUID (toText) diff --git a/services/gen-aws-conf.sh b/services/gen-aws-conf.sh index faaf6315a02..202bf473f7a 100755 --- a/services/gen-aws-conf.sh +++ b/services/gen-aws-conf.sh @@ -56,6 +56,11 @@ done # aws: # s3Bucket: # s3Endpoint: https://s3.eu-west-1.amazonaws.com +# # Uncomment the lines below if you want to test cloudfront too +# # cloudFront: +# # domain: +# # keyPairId: +# # privateKey: /tmp/cargohold/cf-pk.pem # # galley: # journal: diff --git a/services/gundeck/gundeck.cabal b/services/gundeck/gundeck.cabal index 0152d2726be..606584b7f51 100644 --- a/services/gundeck/gundeck.cabal +++ b/services/gundeck/gundeck.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 1af4e3338a6ac8d494ebb8f9b4adfc3f786c87b1919e63c73841e9d4be6c7811 +-- hash: 4a119da87d623ed68d204d4b28a7f65ea3c098fee20179700bee34a417431ab6 name: gundeck version: 1.45.0 @@ -72,7 +72,6 @@ library , base >=4.7 && <5 , base64-bytestring >=1.0 , bilge >=0.21 - , blaze-builder >=0.3 , bytestring >=0.9 , bytestring-conversion >=0.2 , case-insensitive >=1.0 diff --git a/services/gundeck/package.yaml b/services/gundeck/package.yaml index 64bbf246e0d..e52443136f8 100644 --- a/services/gundeck/package.yaml +++ b/services/gundeck/package.yaml @@ -25,7 +25,6 @@ library: - auto-update >=0.1 - base >=4.7 && <5 - bilge >=0.21 - - blaze-builder >=0.3 - bytestring >=0.9 - bytestring-conversion >=0.2 - base64-bytestring >=1.0 diff --git a/services/gundeck/src/Gundeck/Aws.hs b/services/gundeck/src/Gundeck/Aws.hs index d4b02893a06..aac05c7ad49 100644 --- a/services/gundeck/src/Gundeck/Aws.hs +++ b/services/gundeck/src/Gundeck/Aws.hs @@ -50,7 +50,6 @@ module Gundeck.Aws ) where -import Blaze.ByteString.Builder (toLazyByteString) import Control.Error hiding (err, isRight) import Control.Lens hiding ((.=)) import Control.Monad.Catch @@ -59,6 +58,7 @@ import Control.Monad.Trans.Resource import Control.Retry (limitRetries, retrying) import Data.Aeson (decodeStrict) import Data.Attoparsec.Text +import Data.ByteString.Builder (toLazyByteString) import qualified Data.HashMap.Strict as Map import Data.Id import qualified Data.Set as Set diff --git a/stack.yaml b/stack.yaml index 5b3331df26e..e4b80a6b2f4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -82,10 +82,6 @@ extra-deps: - git: https://github.com/wireapp/haskell-multihash.git commit: 300a6f46384bfca33e545c8bab52ef3717452d12 -# Our fork of aws with minor fixes -- git: https://github.com/wireapp/aws - commit: 42695688fc20f80bf89cec845c57403954aab0a2 - # https://github.com/hspec/hspec-wai/pull/49 - git: https://github.com/wireapp/hspec-wai commit: 0a5142cd3ba48116ff059c041348b817fb7bdb25 @@ -96,31 +92,28 @@ extra-deps: # For bloodhound - deriving-aeson-0.2.5@sha256:a1efa4ab7ff94f73e6d2733a9d4414cb4c3526761295722cff28027b5b3da1a4,1277 - aeson-1.4.7.1@sha256:6d8d2fd959b7122a1df9389cf4eca30420a053d67289f92cdc0dbc0dab3530ba,7098 -# amazonka-1.6.1 is buggy: https://github.com/brendanhay/amazonka/issues/466 -# Therefore we pin an unreleased commit directly. + +# amazonka-1.6.1 is buggy: +# https://github.com/brendanhay/amazonka/pull/493 +# Also, we needed a fix to make V4 signatures work with custom ports: +# https://github.com/brendanhay/amazonka/pull/588 # -# More precisely, we pull just some libraries out of it, -# the other packages weren't changed between 1.6.1 and this commit, -# so we can use Stackage-supplied versions for them. -# See https://github.com/brendanhay/amazonka/compare/1.6.1...9cf5b5777b69ac494d23d43a692294882927df34 +# Therefore we pin an unreleased commit directly. # -# Once there has been made a new hackage release, we can use that instead. -- archive: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f - size: 11137527 +# Once the fix has been merged (and released on hackage), we can pin that instead. +- archive: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 + size: 11138812 subdirs: - amazonka - - amazonka-elb - - amazonka-redshift - - amazonka-route53 + - amazonka-cloudfront + - amazonka-dynamodb + - amazonka-s3 + - amazonka-ses + - amazonka-sns + - amazonka-sqs - core -# Was dropped from LTS -- amazonka-dynamodb-1.6.1@sha256:6b8852049c65207a7b3741aafa3e4e6c77cfa115e05de3c74868218ae642b6b0,4459 -- amazonka-ses-1.6.1@sha256:335796c855121ca34affd35097676587d5ebe0b2e576da42faaedd9d163881b0,6425 -- amazonka-sns-1.6.1@sha256:b07fbf8a2806fe775b25ea74d0d78f14f286811e4aa59f9c50e97ed99f2a14a6,4271 -- amazonka-sqs-1.6.1@sha256:1578844a31a2e53f9f21fd217e14406a3f02aefa637678ef88b201b01fbed492,3708 - ############################################################ # Wire packages diff --git a/stack.yaml.lock b/stack.yaml.lock index a9c2d45d492..0fea55f66bc 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -97,20 +97,6 @@ packages: original: git: https://github.com/wireapp/haskell-multihash.git commit: 300a6f46384bfca33e545c8bab52ef3717452d12 -- completed: - cabal-file: - size: 14131 - sha256: 1fb476b11373acad65a203fb6c1bea2b92c2603da3ad77c9c64e8155991e5aa7 - name: aws - version: '0.20' - git: https://github.com/wireapp/aws - pantry-tree: - size: 7219 - sha256: 25fb343439f2f14ced7a8c587a7f0647275d0eddc70a719c5ebde33637607be4 - commit: 42695688fc20f80bf89cec845c57403954aab0a2 - original: - git: https://github.com/wireapp/aws - commit: 42695688fc20f80bf89cec845c57403954aab0a2 - completed: cabal-file: size: 2289 @@ -154,123 +140,149 @@ packages: original: hackage: aeson-1.4.7.1@sha256:6d8d2fd959b7122a1df9389cf4eca30420a053d67289f92cdc0dbc0dab3530ba,7098 - completed: - size: 11137527 + size: 11138812 subdir: amazonka - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz cabal-file: - size: 3420 - sha256: fe5d9d604135b54c0fed2e695c089586f8b66409a43f038db7ed08adaa2f7484 + size: 3457 + sha256: 7ac360751e371ba853f56d357e861c5fe103b1da17f045ac47fd285c164a37f7 name: amazonka version: 1.6.1 - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: size: 1038 - sha256: 7b9c7488007e3d803516121fe89d7674918a6e6dd09a22ac9ecabc2eed48346d + sha256: 59c7840fe6c9609d1d5022149010e72db5778e4978b9384b6dee8a4a207c96b3 original: - size: 11137527 + size: 11138812 subdir: amazonka - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: - size: 11137527 - subdir: amazonka-elb - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz + size: 11138812 + subdir: amazonka-cloudfront + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz cabal-file: - size: 4462 - sha256: a208c16093be1afc6e616a61ae436079829d6d9234a06a7fc61581ba4a3b2e6f - name: amazonka-elb + size: 5668 + sha256: 79c95e0ec544437a613cab891a2057bc35f1b0fed2361b36e7f05437839bdce2 + name: amazonka-cloudfront version: 1.6.1 - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: - size: 8370 - sha256: 881b55c8859c59765ab7b5e51401257687a4a86e249e4da20f9f7cf8ffde0d65 + size: 12839 + sha256: f0f27588c628d9996c298ab035b19999572ad8432ea05526497b608b009b1258 original: - size: 11137527 - subdir: amazonka-elb - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + size: 11138812 + subdir: amazonka-cloudfront + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: - size: 11137527 - subdir: amazonka-redshift - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz + size: 11138812 + subdir: amazonka-dynamodb + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz cabal-file: - size: 6412 - sha256: c67838874f38dd3add8017a0be83c726b3f77760c25e2c2bcc43acdc37fc8bfd - name: amazonka-redshift + size: 4459 + sha256: 6b8852049c65207a7b3741aafa3e4e6c77cfa115e05de3c74868218ae642b6b0 + name: amazonka-dynamodb version: 1.6.1 - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: - size: 16687 - sha256: 3f14ef6b9291c4080ee39cb0e32e763eae6a1f6e74e4a325a0042e9e9be35eb4 + size: 8379 + sha256: d513775676879e3b2ff8393528882df1670a79110120b65ce6c68765581a2473 original: - size: 11137527 - subdir: amazonka-redshift - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + size: 11138812 + subdir: amazonka-dynamodb + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: - size: 11137527 - subdir: amazonka-route53 - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz + size: 11138812 + subdir: amazonka-s3 + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz cabal-file: - size: 5949 - sha256: a9839d8fc55de06a4fb242bc6597d454251363478909d4fe7dca8832c2a1fd73 - name: amazonka-route53 + size: 6317 + sha256: 9d07240fca59ad5197fb614ce3051e701e4951e6d4625a2dab4a9c17a1900194 + name: amazonka-s3 version: 1.6.1 - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: - size: 14795 - sha256: d842125c99d714a09c49a951bb99ea67efd679170a40e82f575f583a8dcf09ca + size: 18431 + sha256: a19d02da301bbcad502e6092d7418a59543747c8bb6f12932bcbc4606f7814ab original: - size: 11137527 - subdir: amazonka-route53 - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f + size: 11138812 + subdir: amazonka-s3 + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: - size: 11137527 - subdir: core - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz + size: 11138812 + subdir: amazonka-ses + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz cabal-file: - size: 4957 - sha256: 8ff9614130407588370e12e905f3539a733b76f6d9397ed3522ce54fc154d918 - name: amazonka-core + size: 6425 + sha256: 335796c855121ca34affd35097676587d5ebe0b2e576da42faaedd9d163881b0 + name: amazonka-ses version: 1.6.1 - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f - pantry-tree: - size: 3484 - sha256: fc9c1a8d6a8fefa4432c42c3b104e910d214cded3d0795f8bf46cc85f4f9d838 - original: - size: 11137527 - subdir: core - url: https://github.com/brendanhay/amazonka/archive/9cf5b5777b69ac494d23d43a692294882927df34.tar.gz - sha256: c3044f803a7652aee88fe600a97321175cdc1443d671246ba7ff78e14bf5b49f -- completed: - hackage: amazonka-dynamodb-1.6.1@sha256:6b8852049c65207a7b3741aafa3e4e6c77cfa115e05de3c74868218ae642b6b0,4459 + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: - size: 8333 - sha256: bd7469b4077272ecf37fe30dcff64c3af0a820b610ca592c172d7fa97d9e6833 + size: 18197 + sha256: cd9b02c30d7571dc87868b054ed3826d5b8d26b717f3158da6443377e8dfd563 original: - hackage: amazonka-dynamodb-1.6.1@sha256:6b8852049c65207a7b3741aafa3e4e6c77cfa115e05de3c74868218ae642b6b0,4459 + size: 11138812 + subdir: amazonka-ses + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: - hackage: amazonka-ses-1.6.1@sha256:335796c855121ca34affd35097676587d5ebe0b2e576da42faaedd9d163881b0,6425 + size: 11138812 + subdir: amazonka-sns + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + cabal-file: + size: 4271 + sha256: b07fbf8a2806fe775b25ea74d0d78f14f286811e4aa59f9c50e97ed99f2a14a6 + name: amazonka-sns + version: 1.6.1 + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: - size: 18151 - sha256: 1b4746acac660d5418731b3972c4ff2285ee3435c709dfda67df49665f781d0a + size: 7905 + sha256: e5a6d407b92e423ccf58d784fe42d4a0598204f65c0e7753569c130428bfb5eb original: - hackage: amazonka-ses-1.6.1@sha256:335796c855121ca34affd35097676587d5ebe0b2e576da42faaedd9d163881b0,6425 + size: 11138812 + subdir: amazonka-sns + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: - hackage: amazonka-sns-1.6.1@sha256:b07fbf8a2806fe775b25ea74d0d78f14f286811e4aa59f9c50e97ed99f2a14a6,4271 + size: 11138812 + subdir: amazonka-sqs + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + cabal-file: + size: 3708 + sha256: 1578844a31a2e53f9f21fd217e14406a3f02aefa637678ef88b201b01fbed492 + name: amazonka-sqs + version: 1.6.1 + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: - size: 7859 - sha256: d7791240fd6ed273f602e7739c141c56dd9f08ea37cc1ea7d0cfb095489e595d + size: 5351 + sha256: 990b7e4467d557e43959483063f7229f5039857a8cd67decb53f9a5c513db7f8 original: - hackage: amazonka-sns-1.6.1@sha256:b07fbf8a2806fe775b25ea74d0d78f14f286811e4aa59f9c50e97ed99f2a14a6,4271 + size: 11138812 + subdir: amazonka-sqs + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: - hackage: amazonka-sqs-1.6.1@sha256:1578844a31a2e53f9f21fd217e14406a3f02aefa637678ef88b201b01fbed492,3708 + size: 11138812 + subdir: core + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + cabal-file: + size: 4957 + sha256: 8ff9614130407588370e12e905f3539a733b76f6d9397ed3522ce54fc154d918 + name: amazonka-core + version: 1.6.1 + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 pantry-tree: - size: 5305 - sha256: 4ba2af33686b13cdfb473035500c7e07028564ed4b6ab2a4a6e0bd027b919ef8 + size: 3484 + sha256: d4e427a362d66c9ee0dc0de810015633e43e3953944a84b24cfa2e71bcf0ed4d original: - hackage: amazonka-sqs-1.6.1@sha256:1578844a31a2e53f9f21fd217e14406a3f02aefa637678ef88b201b01fbed492,3708 + size: 11138812 + subdir: core + url: https://github.com/wireapp/amazonka/archive/9de5e0e4b2511ec555fb0975581b3087a94c1b4a.tar.gz + sha256: b9277a51b60d639fbd91b630f353bf9db305f5759f8e1ee48f0ab026e6b43d00 - completed: cabal-file: size: 1150 diff --git a/tools/stern/package.yaml b/tools/stern/package.yaml index 4aaeee08381..7fea9dac2c9 100644 --- a/tools/stern/package.yaml +++ b/tools/stern/package.yaml @@ -21,7 +21,6 @@ library: - aeson >= 0.11 - attoparsec >= 0.12 - bilge >= 0.12 - - blaze-builder >= 0.3 - brig-types >= 0.9.6 - bytestring >= 0.10 - bytestring-conversion >= 0.2 diff --git a/tools/stern/stern.cabal b/tools/stern/stern.cabal index 9e8ed217a32..d7df5e33263 100644 --- a/tools/stern/stern.cabal +++ b/tools/stern/stern.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 359297a5d2e072c399e6e27b49065ef7ca860f07e1fb84b106df4f3eca12d21a +-- hash: d47906946bda6a0b6f632f1e110faf587549509d2a81d5216e445ff7651434f8 name: stern version: 1.7.2 @@ -42,7 +42,6 @@ library , attoparsec >=0.12 , base >=4.5 && <5 , bilge >=0.12 - , blaze-builder >=0.3 , brig-types >=0.9.6 , bytestring >=0.10 , bytestring-conversion >=0.2