diff --git a/changelog.d/1-api-changes/WPB-1906 b/changelog.d/1-api-changes/WPB-1906 new file mode 100644 index 00000000000..25738208971 --- /dev/null +++ b/changelog.d/1-api-changes/WPB-1906 @@ -0,0 +1 @@ +Un-verified users can no longer upload assets \ No newline at end of file diff --git a/charts/cargohold/templates/configmap.yaml b/charts/cargohold/templates/configmap.yaml index 00b0bf981b3..61d5af1959a 100644 --- a/charts/cargohold/templates/configmap.yaml +++ b/charts/cargohold/templates/configmap.yaml @@ -18,6 +18,10 @@ data: port: 8080 {{- end }} + brig: + host: brig + port: 8080 + aws: {{- with .Values.config.aws }} s3Bucket: {{ .s3Bucket }} diff --git a/charts/cargohold/templates/tests/configmap.yaml b/charts/cargohold/templates/tests/configmap.yaml index 18a5b29b226..aa5a8aa4a19 100644 --- a/charts/cargohold/templates/tests/configmap.yaml +++ b/charts/cargohold/templates/tests/configmap.yaml @@ -10,3 +10,11 @@ data: cargohold: host: cargohold port: {{ .Values.service.internalPort }} + {{- if .Values.config.enableFederation }} + federator: + host: federator + port: 8080 + {{- end }} + brig: + host: brig + port: 8080 \ No newline at end of file diff --git a/integration/integration.cabal b/integration/integration.cabal index 0cd573e3160..f28655943ee 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -102,6 +102,7 @@ library SetupHelpers Test.AccessUpdate Test.AssetDownload + Test.AssetUpload Test.B2B Test.Brig Test.Client diff --git a/integration/test/Test/AssetUpload.hs b/integration/test/Test/AssetUpload.hs new file mode 100644 index 00000000000..d55eadc83c1 --- /dev/null +++ b/integration/test/Test/AssetUpload.hs @@ -0,0 +1,34 @@ +module Test.AssetUpload where + +import API.BrigInternal +import API.Cargohold +import SetupHelpers +import Testlib.Prelude + +testAssetUploadUnverifiedUser :: HasCallStack => App () +testAssetUploadUnverifiedUser = do + user <- randomUser OwnDomain $ def {activate = False} + bindResponse (uploadAsset user) $ \resp -> do + resp.status `shouldMatchInt` 403 + +testAssetUploadVerifiedUser :: HasCallStack => App () +testAssetUploadVerifiedUser = do + user <- randomUser OwnDomain def + bindResponse (uploadAsset user) $ \resp -> do + resp.status `shouldMatchInt` 201 + +testAssetUploadUnknownUser :: HasCallStack => App () +testAssetUploadUnknownUser = do + uid <- randomId + domain <- make OwnDomain + let user = + object + [ "id" .= uid, + "qualified_id" + .= object + [ "domain" .= domain, + "id" .= uid + ] + ] + bindResponse (uploadAsset user) $ \resp -> do + resp.status `shouldMatchInt` 403 diff --git a/libs/types-common/src/Data/CommaSeparatedList.hs b/libs/types-common/src/Data/CommaSeparatedList.hs index 8c13c49f4cf..36f072914be 100644 --- a/libs/types-common/src/Data/CommaSeparatedList.hs +++ b/libs/types-common/src/Data/CommaSeparatedList.hs @@ -21,14 +21,16 @@ module Data.CommaSeparatedList where import Control.Lens ((?~)) import Data.Bifunctor qualified as Bifunctor -import Data.ByteString.Conversion (FromByteString, List, fromList, parser, runParser) +import Data.ByteString (toStrict) +import Data.ByteString.Conversion (FromByteString, List (..), ToByteString, builder, fromList, parser, runParser, toByteString) import Data.OpenApi import Data.Proxy (Proxy (..)) import Data.Range (Bounds, Range) import Data.Text qualified as Text -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +import Data.Text.Encoding.Error import Imports -import Servant (FromHttpApiData (..)) +import Servant (FromHttpApiData (..), ToHttpApiData (toQueryParam)) newtype CommaSeparatedList a = CommaSeparatedList {fromCommaSeparatedList :: [a]} deriving stock (Show, Eq) @@ -39,6 +41,9 @@ instance FromByteString (List a) => FromHttpApiData (CommaSeparatedList a) where parseUrlPiece t = CommaSeparatedList . fromList <$> Bifunctor.first Text.pack (runParser parser $ encodeUtf8 t) +instance ToByteString (List a) => ToHttpApiData (CommaSeparatedList a) where + toQueryParam (CommaSeparatedList l) = decodeUtf8With lenientDecode $ toStrict $ toByteString $ builder $ List l + instance ToParamSchema (CommaSeparatedList a) where toParamSchema _ = mempty & type_ ?~ OpenApiString diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 3793ac70e0b..45e9534e5b0 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -46,6 +46,7 @@ , hspec , hspec-wai , http-api-data +, http-client , http-media , http-types , imports @@ -149,6 +150,7 @@ mkDerivation { hscim HsOpenSSL http-api-data + http-client http-media http-types imports diff --git a/libs/wire-api/src/Wire/API/Error.hs b/libs/wire-api/src/Wire/API/Error.hs index fbc743cfe65..96c827db1d9 100644 --- a/libs/wire-api/src/Wire/API/Error.hs +++ b/libs/wire-api/src/Wire/API/Error.hs @@ -66,6 +66,9 @@ import Network.Wai.Utilities.JSONResponse import Polysemy import Polysemy.Error import Servant +import Servant.Client (HasClient (Client)) +import Servant.Client.Core.HasClient (hoistClientMonad) +import Servant.Client.Streaming (HasClient (clientWithRoute)) import Servant.OpenApi import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named (UntypedNamed) @@ -191,6 +194,11 @@ instance where toOpenApi _ = addToOpenApi @e (toOpenApi (Proxy @api)) +instance HasClient m api => HasClient m (CanThrow e :> api) where + type Client m (CanThrow e :> api) = Client m api + clientWithRoute pm _ = clientWithRoute pm $ Proxy @api + hoistClientMonad pm _ = hoistClientMonad pm (Proxy @api) + type instance SpecialiseToVersion v (CanThrowMany es :> api) = CanThrowMany es :> SpecialiseToVersion v api diff --git a/libs/wire-api/src/Wire/API/Error/Cargohold.hs b/libs/wire-api/src/Wire/API/Error/Cargohold.hs index 0c4f17015cc..e40dc920012 100644 --- a/libs/wire-api/src/Wire/API/Error/Cargohold.hs +++ b/libs/wire-api/src/Wire/API/Error/Cargohold.hs @@ -26,6 +26,8 @@ data CargoholdError | AssetTooLarge | InvalidLength | NoMatchingAssetEndpoint + | UnverifiedUser + | UserNotFound instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: CargoholdError) where addToOpenApi = addStaticErrorToSwagger @(MapError e) @@ -38,5 +40,9 @@ type instance MapError 'AssetTooLarge = 'StaticError 413 "client-error" "Asset t type instance MapError 'InvalidLength = 'StaticError 400 "invalid-length" "Invalid content length" +type instance MapError 'UnverifiedUser = 'StaticError 403 "unverified-user" "Unverified user" + +type instance MapError 'UserNotFound = 'StaticError 403 "not-found" "User not found" + -- | Return `AssetNotFound` to hide there's a multi-ingress setup. type instance MapError 'NoMatchingAssetEndpoint = MapError 'AssetNotFound diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 3a131a098e7..b30e5c3f6c5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -17,6 +17,9 @@ module Wire.API.Routes.Internal.Brig ( API, + BrigInternalClient, + brigInternalClient, + runBrigInternalClient, IStatusAPI, EJPD_API, AccountAPI, @@ -48,10 +51,16 @@ import Data.OpenApi (HasInfo (info), HasTitle (title), OpenApi) import Data.OpenApi qualified as S import Data.Qualified (Qualified) import Data.Schema hiding (swaggerDoc) +import Data.Text qualified as Text +import GHC.TypeLits import Imports hiding (head) +import Network.HTTP.Client qualified as HTTP import Servant hiding (Handler, WithStatus, addHeader, respond) +import Servant.Client qualified as Servant +import Servant.Client.Core qualified as Servant import Servant.OpenApi (HasOpenApi (toOpenApi)) import Servant.OpenApi.Internal.Orphans () +import Util.Options import Wire.API.Connection import Wire.API.Error import Wire.API.Error.Brig @@ -733,3 +742,15 @@ swaggerDoc :: OpenApi swaggerDoc = toOpenApi (Proxy @API) & info . title .~ "Wire-Server internal brig API" + +newtype BrigInternalClient a = BrigInternalClient (Servant.ClientM a) + deriving newtype (Functor, Applicative, Monad, Servant.RunClient) + +brigInternalClient :: forall (name :: Symbol) endpoint. (HasEndpoint API endpoint name, Servant.HasClient BrigInternalClient endpoint) => Servant.Client BrigInternalClient endpoint +brigInternalClient = namedClient @API @name @BrigInternalClient + +runBrigInternalClient :: HTTP.Manager -> Endpoint -> BrigInternalClient a -> IO (Either Servant.ClientError a) +runBrigInternalClient httpMgr (Endpoint brigHost brigPort) (BrigInternalClient action) = do + let baseUrl = Servant.BaseUrl Servant.Http (Text.unpack brigHost) (fromIntegral brigPort) "" + clientEnv = Servant.ClientEnv httpMgr baseUrl Nothing Servant.defaultMakeClientRequest + Servant.runClientM action clientEnv diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index f7db98ea453..93297772975 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -273,6 +273,7 @@ library , hscim , HsOpenSSL , http-api-data + , http-client , http-media , http-types , imports diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e5c223e7c86..f8354d0ef4e 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -1079,7 +1079,7 @@ deleteSelfUser :: UserId -> Public.DeleteUser -> (Handler r) (Maybe Code.Timeout) -deleteSelfUser u body = +deleteSelfUser u body = do API.deleteSelfUser u (Public.deleteUserPassword body) !>> deleteUserError verifyDeleteUser :: Public.VerifyDeleteUser -> Handler r () diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 73f97184b83..15c7c662e1e 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1454,7 +1454,9 @@ testDeleteAnonUser brig = do testDeleteWithProfilePic :: Brig -> CargoHold -> Http () testDeleteWithProfilePic brig cargohold = do - uid <- userId <$> createAnonUser "anon" brig + email <- randomEmail + -- Users need to be verified if they want to upload assets, so email it is! + uid <- userId <$> createUserWithEmail "anon" email brig ast <- responseJsonError =<< uploadAsset cargohold uid Asset.defAssetSettings "this is my profile pic" -- Ensure that the asset is there downloadAsset cargohold uid (ast ^. Asset.assetKey) !!! const 200 === statusCode @@ -1469,7 +1471,7 @@ testDeleteWithProfilePic brig cargohold = do -- Update profile with the uploaded asset put (brig . path "/self" . contentJson . zUser uid . zConn "c" . body update) !!! const 200 === statusCode - deleteUser uid Nothing brig !!! const 200 === statusCode + deleteUser uid (pure defPassword) brig !!! const 200 === statusCode -- Check that the asset gets deleted downloadAsset cargohold uid (ast ^. Asset.assetKey) !!! const 404 === statusCode diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal index cbe5965a748..508eb002756 100644 --- a/services/cargohold/cargohold.cabal +++ b/services/cargohold/cargohold.cabal @@ -119,10 +119,12 @@ library , resourcet >=1.1 , retry >=0.5 , servant + , servant-client , servant-server , text >=1.1 , time >=1.4 , tinylog >=0.10 + , transformers , transitive-anns , types-common >=0.16 , types-common-aws @@ -286,6 +288,7 @@ executable cargohold-integration , mmorph , mtl , optparse-applicative + , safe , servant-client , tagged >=0.8 , tasty >=1.0 diff --git a/services/cargohold/cargohold.integration.yaml b/services/cargohold/cargohold.integration.yaml index 0f85c2b42c3..f5736ce01c8 100644 --- a/services/cargohold/cargohold.integration.yaml +++ b/services/cargohold/cargohold.integration.yaml @@ -6,6 +6,10 @@ federator: host: 127.0.0.1 port: 8097 +brig: + host: 127.0.0.1 + port: 8082 + aws: s3Bucket: dummy-bucket # <-- insert-bucket-name-here s3Endpoint: http://localhost:4570 # https://s3-eu-west-1.amazonaws.com:443 diff --git a/services/cargohold/default.nix b/services/cargohold/default.nix index 144a55f1943..8b529f96f02 100644 --- a/services/cargohold/default.nix +++ b/services/cargohold/default.nix @@ -45,6 +45,7 @@ , optparse-applicative , resourcet , retry +, safe , servant , servant-client , servant-server @@ -55,6 +56,7 @@ , text , time , tinylog +, transformers , transitive-anns , types-common , types-common-aws @@ -110,10 +112,12 @@ mkDerivation { resourcet retry servant + servant-client servant-server text time tinylog + transformers transitive-anns types-common types-common-aws @@ -152,6 +156,7 @@ mkDerivation { mmorph mtl optparse-applicative + safe servant-client tagged tasty diff --git a/services/cargohold/src/CargoHold/API/Error.hs b/services/cargohold/src/CargoHold/API/Error.hs index da82f359161..4fed14f95bd 100644 --- a/services/cargohold/src/CargoHold/API/Error.hs +++ b/services/cargohold/src/CargoHold/API/Error.hs @@ -35,6 +35,12 @@ invalidLength = errorToWai @'InvalidLength assetNotFound :: Error assetNotFound = errorToWai @'AssetNotFound +unverifiedUser :: Error +unverifiedUser = errorToWai @'UnverifiedUser + +userNotFound :: Error +userNotFound = errorToWai @'UserNotFound + invalidMD5 :: Error invalidMD5 = mkError status400 "client-error" "Invalid MD5." diff --git a/services/cargohold/src/CargoHold/API/Public.hs b/services/cargohold/src/CargoHold/API/Public.hs index a896025bdc6..4435fc9e3e1 100644 --- a/services/cargohold/src/CargoHold/API/Public.hs +++ b/services/cargohold/src/CargoHold/API/Public.hs @@ -17,6 +17,7 @@ module CargoHold.API.Public (servantSitemap, internalSitemap) where +import CargoHold.API.Error (unverifiedUser, userNotFound) import qualified CargoHold.API.Legacy as LegacyAPI import CargoHold.API.Util import qualified CargoHold.API.V3 as V3 @@ -24,6 +25,7 @@ import CargoHold.App import CargoHold.Federation import qualified CargoHold.Types.V3 as V3 import Control.Lens +import Control.Monad.Trans.Except (throwE) import Data.ByteString.Builder import qualified Data.ByteString.Lazy as LBS import Data.Domain @@ -38,8 +40,10 @@ import URI.ByteString import Wire.API.Asset import Wire.API.Federation.API import Wire.API.Routes.AssetBody +import Wire.API.Routes.Internal.Brig (brigInternalClient) import Wire.API.Routes.Internal.Cargohold import Wire.API.Routes.Public.Cargohold +import Wire.API.User (AccountStatus (Active), AccountStatusResp (..)) servantSitemap :: ServerT CargoholdAPI Handler servantSitemap = @@ -137,6 +141,15 @@ uploadAssetV3 :: Handler (Asset, AssetLocation Relative) uploadAssetV3 pid req = do let principal = mkPrincipal pid + case principal of + V3.UserPrincipal uid -> do + status <- + lift (executeBrigInteral $ brigInternalClient @"iGetUserStatus" uid) + >>= either (const $ throwE userNotFound) pure + case fromAccountStatusResp status of + Active -> pure () + _ -> throwE unverifiedUser + _ -> pure () asset <- V3.upload principal (getAssetSource req) pure (fmap tUntagged asset, mkAssetLocation @tag (asset ^. assetKey)) diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index b8d4b9c6e8d..b51edbc6228 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -41,6 +41,7 @@ module CargoHold.App App, runAppT, runAppResourceT, + executeBrigInteral, -- * Handler Monad Handler, @@ -53,7 +54,7 @@ import Bilge (Manager, MonadHttp, RequestId (..), newManager, withResponse) import qualified Bilge import Bilge.RPC (HasRequestId (..)) import qualified CargoHold.AWS as AWS -import CargoHold.Options (AWSOpts, Opts, S3Compatibility (..)) +import CargoHold.Options (AWSOpts, Opts, S3Compatibility (..), brig) import qualified CargoHold.Options as Opt import Control.Error (ExceptT, exceptT) import Control.Exception (throw) @@ -72,9 +73,12 @@ import Network.HTTP.Client.OpenSSL import Network.Wai.Utilities (Error (..)) import OpenSSL.Session (SSLContext, SSLOption (..)) import qualified OpenSSL.Session as SSL +import qualified Servant.Client as Servant import System.Logger.Class hiding (settings) import qualified System.Logger.Extended as Log import Util.Options +import Wire.API.Routes.Internal.Brig (BrigInternalClient) +import qualified Wire.API.Routes.Internal.Brig as IBrig ------------------------------------------------------------------------------- -- Environment @@ -97,28 +101,28 @@ settings :: Lens' Env Opt.Settings settings = options . Opt.settings newEnv :: Opts -> IO Env -newEnv o = do - met <- Metrics.metrics - lgr <- Log.mkLogger (o ^. Opt.logLevel) (o ^. Opt.logNetStrings) (o ^. Opt.logFormat) - checkOpts o lgr - mgr <- initHttpManager (o ^. Opt.aws . Opt.s3Compatibility) - h2mgr <- initHttp2Manager - ama <- initAws (o ^. Opt.aws) lgr mgr - multiIngressAWS <- initMultiIngressAWS lgr mgr - let loc = toLocalUnsafe (o ^. Opt.settings . Opt.federationDomain) () - pure $ Env ama met lgr mgr h2mgr def o loc multiIngressAWS +newEnv opts = do + metricsStorage <- Metrics.metrics + logger <- Log.mkLogger (opts ^. Opt.logLevel) (opts ^. Opt.logNetStrings) (opts ^. Opt.logFormat) + checkOpts opts logger + httpMgr <- initHttpManager (opts ^. Opt.aws . Opt.s3Compatibility) + http2Mgr <- initHttp2Manager + awsEnv <- initAws (opts ^. Opt.aws) logger httpMgr + multiIngressAWS <- initMultiIngressAWS logger httpMgr + let localDomain = toLocalUnsafe (opts ^. Opt.settings . Opt.federationDomain) () + pure $ Env awsEnv metricsStorage logger httpMgr http2Mgr def opts localDomain multiIngressAWS where initMultiIngressAWS :: Logger -> Manager -> IO (Map String AWS.Env) - initMultiIngressAWS lgr mgr = + initMultiIngressAWS logger httpMgr = Map.fromList <$> mapM ( \(k, v) -> - initAws (patchS3DownloadEndpoint v) lgr mgr >>= \v' -> pure (k, v') + initAws (patchS3DownloadEndpoint v) logger httpMgr >>= \v' -> pure (k, v') ) - (Map.assocs (o ^. Opt.aws . Opt.multiIngress . non Map.empty)) + (Map.assocs (opts ^. Opt.aws . Opt.multiIngress . non Map.empty)) patchS3DownloadEndpoint :: AWSEndpoint -> AWSOpts - patchS3DownloadEndpoint e = (o ^. Opt.aws) & Opt.s3DownloadEndpoint ?~ e + patchS3DownloadEndpoint e = (opts ^. Opt.aws) & Opt.s3DownloadEndpoint ?~ e -- | Validate (some) options (`Opts`) -- @@ -236,6 +240,12 @@ runAppT e (AppT a) = runReaderT a e runAppResourceT :: MonadIO m => Env -> ResourceT App a -> m a runAppResourceT e rma = liftIO . runResourceT $ transResourceT (runAppT e) rma +executeBrigInteral :: BrigInternalClient a -> App (Either Servant.ClientError a) +executeBrigInteral action = do + httpMgr <- view httpManager + brigEndpoint <- view (options . brig) + liftIO $ IBrig.runBrigInternalClient httpMgr brigEndpoint action + ------------------------------------------------------------------------------- -- Handler Monad diff --git a/services/cargohold/src/CargoHold/Options.hs b/services/cargohold/src/CargoHold/Options.hs index aa515729a1f..5152570ce6b 100644 --- a/services/cargohold/src/CargoHold/Options.hs +++ b/services/cargohold/src/CargoHold/Options.hs @@ -159,6 +159,8 @@ data Opts = Opts _settings :: !Settings, -- | Federator endpoint _federator :: Maybe Endpoint, + -- | Brig endpoint + _brig :: !Endpoint, -- Logging -- | Log level (Debug, Info, etc) diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs index ae43e1e96ae..4077976ff5f 100644 --- a/services/cargohold/src/CargoHold/Run.hs +++ b/services/cargohold/src/CargoHold/Run.hs @@ -83,16 +83,16 @@ mkApp o = Codensity $ \k -> . GZip.gzip GZip.def . catchErrors (e ^. appLogger) [Right $ e ^. metrics] servantApp :: Env -> Application - servantApp e0 r = + servantApp e0 r = do let e = set requestId (maybe def RequestId (lookupRequestId r)) e0 - in Servant.serveWithContext - (Proxy @CombinedAPI) - ((o ^. settings . federationDomain) :. Servant.EmptyContext) - ( hoistServerWithDomain @FederationAPI (toServantHandler e) federationSitemap - :<|> hoistServerWithDomain @CargoholdAPI (toServantHandler e) servantSitemap - :<|> hoistServerWithDomain @InternalAPI (toServantHandler e) internalSitemap - ) - r + Servant.serveWithContext + (Proxy @CombinedAPI) + ((o ^. settings . federationDomain) :. Servant.EmptyContext) + ( hoistServerWithDomain @FederationAPI (toServantHandler e) federationSitemap + :<|> hoistServerWithDomain @CargoholdAPI (toServantHandler e) servantSitemap + :<|> hoistServerWithDomain @InternalAPI (toServantHandler e) internalSitemap + ) + r toServantHandler :: Env -> Handler a -> Servant.Handler a toServantHandler env = liftIO . runHandler env diff --git a/services/cargohold/test/integration/API.hs b/services/cargohold/test/integration/API.hs index 781cbe125e1..47428f0ea35 100644 --- a/services/cargohold/test/integration/API.hs +++ b/services/cargohold/test/integration/API.hs @@ -28,7 +28,7 @@ import CargoHold.Types import qualified CargoHold.Types.V3 as V3 import qualified Codec.MIME.Type as MIME import Control.Exception (throw) -import Control.Lens hiding (sets) +import Control.Lens hiding (sets, (.=)) import qualified Data.Aeson as Aeson import Data.ByteString.Builder import qualified Data.ByteString.Char8 as C8 @@ -94,7 +94,7 @@ testSimpleRoundtrip = do mapM_ simpleRoundtrip sets where simpleRoundtrip sets = do - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser uid2 <- liftIO $ Id <$> nextRandom -- Initial upload let bdy = (applicationText, "Hello World") @@ -143,7 +143,7 @@ testDownloadWithAcceptHeader = do testSimpleTokens :: TestM () testSimpleTokens = do - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser uid2 <- liftIO $ Id <$> nextRandom -- Initial upload let sets = V3.defAssetSettings & set V3.setAssetRetention (Just V3.AssetVolatile) @@ -217,7 +217,7 @@ testSimpleS3ClosedConnectionReuse = go >> wait >> go where wait = liftIO $ putStrLn "Waiting for S3 idle timeout ..." >> threadDelay 7000000 go = do - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser let sets = V3.defAssetSettings & set V3.setAssetRetention (Just V3.AssetVolatile) let part2 = (MIME.Type (MIME.Text "plain") [], C8.replicate 100000 'c') uploadSimple (path "/assets/v3") uid sets part2 @@ -229,7 +229,7 @@ testDownloadURLOverride = do -- supposed to be used by cargohold to make connections. let downloadEndpoint = "external-s3-url.example" withSettingsOverrides (aws . s3DownloadEndpoint ?~ AWSEndpoint downloadEndpoint True 443) $ do - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser -- Upload, should work, shouldn't try to use the S3DownloadEndpoint let bdy = (applicationText, "Hello World") @@ -263,7 +263,7 @@ testDownloadURLOverride = do -- (just replaced the content with a shorter one and updated the MD5 header). testUploadCompatibility :: TestM () testUploadCompatibility = do - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser -- Initial upload r1 <- uploadRaw (path "/assets/v3") uid exampleMultipart diff --git a/services/cargohold/test/integration/API/Federation.hs b/services/cargohold/test/integration/API/Federation.hs index 29c2d63992b..d7bf5c87cf6 100644 --- a/services/cargohold/test/integration/API/Federation.hs +++ b/services/cargohold/test/integration/API/Federation.hs @@ -66,7 +66,7 @@ testGetAssetAvailable isPublicAsset = do defAssetSettings & set setAssetRetention (Just AssetVolatile) & set setAssetPublic isPublicAsset - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser ast :: Asset <- responseJsonError =<< uploadSimple (path "/assets/v3") uid settings bdy @@ -113,7 +113,7 @@ testGetAssetWrongToken = do -- Initial upload let bdy = (applicationOctetStream, "Hello World") settings = defAssetSettings & set setAssetRetention (Just AssetVolatile) - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser ast :: Asset <- responseJsonError =<< uploadSimple (path "/assets/v3") uid settings bdy @@ -141,7 +141,7 @@ testLargeAsset = do let settings = defAssetSettings & set setAssetRetention (Just AssetVolatile) - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser -- generate random bytes let size = 1024 * 1024 bs <- liftIO $ getRandomBytes size @@ -177,7 +177,7 @@ testStreamAsset = do settings = defAssetSettings & set setAssetRetention (Just AssetVolatile) - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser ast :: Asset <- responseJsonError =<< uploadSimple (path "/assets/v3") uid settings bdy @@ -221,7 +221,7 @@ testStreamAssetWrongToken = do -- Initial upload let bdy = (applicationOctetStream, "Hello World") settings = defAssetSettings & set setAssetRetention (Just AssetVolatile) - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser ast :: Asset <- responseJsonError =<< uploadSimple (path "/assets/v3") uid settings bdy diff --git a/services/cargohold/test/integration/API/Util.hs b/services/cargohold/test/integration/API/Util.hs index 4f0b2c1c746..59ea794f597 100644 --- a/services/cargohold/test/integration/API/Util.hs +++ b/services/cargohold/test/integration/API/Util.hs @@ -18,30 +18,62 @@ module API.Util where import Bilge hiding (body, host, port) +import qualified Bilge import CargoHold.Options import CargoHold.Run import qualified Codec.MIME.Parse as MIME import qualified Codec.MIME.Type as MIME -import Control.Lens +import Control.Lens hiding ((.=)) import Control.Monad.Codensity +import Data.Aeson (object, (.=)) import Data.ByteString.Builder +import qualified Data.ByteString.Char8 as C import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as Lazy import Data.Domain import Data.Id import Data.Qualified -import Data.Text.Encoding (decodeLatin1) +import Data.Text.Encoding (decodeLatin1, encodeUtf8) import qualified Data.UUID as UUID +import Data.UUID.V4 (nextRandom) import Federator.MockServer import Imports hiding (head) import qualified Network.HTTP.Media as HTTP import Network.HTTP.Types.Header import Network.HTTP.Types.Method import Network.Wai.Utilities.MockServer +import Safe (readNote) import TestSetup import Util.Options import Wire.API.Asset +-- Copied wholesale from gundeck/test/integration/API.hs +-- This is needed because it sets up the email on the user, verifiying it. +-- The changes to the asset routes forbidding non-verified users from uploading +-- assets breaks a lot of existing tests. +-- +-- FUTUREWORK: Move all the cargohold tests to the new integration test suite. +-- https://wearezeta.atlassian.net/browse/WPB-5382 +randomUser :: TestM UserId +randomUser = do + (Endpoint (encodeUtf8 -> eHost) ePort) <- view tsBrig + e <- liftIO $ mkEmail "success" "simulator.amazonses.com" + let p = + object + [ "name" .= e, + "email" .= e, + "password" .= ("secret-8-chars-long-at-least" :: Text) + ] + r <- post (Bilge.host eHost . Bilge.port ePort . path "/i/users" . json p) + pure + . readNote "unable to parse Location header" + . C.unpack + $ getHeader' "Location" r + where + mkEmail loc dom = do + uid <- nextRandom + pure $ loc <> "+" <> UUID.toText uid <> "@" <> dom + uploadSimple :: (Request -> Request) -> UserId -> diff --git a/services/cargohold/test/integration/API/V3.hs b/services/cargohold/test/integration/API/V3.hs index 380205bdead..5560905f928 100644 --- a/services/cargohold/test/integration/API/V3.hs +++ b/services/cargohold/test/integration/API/V3.hs @@ -57,7 +57,7 @@ testSimpleRoundtrip = do mapM_ simpleRoundtrip sets where simpleRoundtrip sets = do - uid <- liftIO $ Id <$> nextRandom + uid <- randomUser uid2 <- liftIO $ Id <$> nextRandom -- Initial upload let bdy = (applicationText, "Hello World") diff --git a/services/cargohold/test/integration/TestSetup.hs b/services/cargohold/test/integration/TestSetup.hs index 03cc3ccd330..ae8d4f7362d 100644 --- a/services/cargohold/test/integration/TestSetup.hs +++ b/services/cargohold/test/integration/TestSetup.hs @@ -21,6 +21,7 @@ module TestSetup ( test, tsManager, tsEndpoint, + tsBrig, tsOpts, TestSetup (..), Cargohold, @@ -75,6 +76,7 @@ mkRequest (Endpoint h p) = Bilge.host (encodeUtf8 h) . Bilge.port p data TestSetup = TestSetup { _tsManager :: Manager, _tsEndpoint :: Endpoint, + _tsBrig :: Endpoint, _tsOpts :: Opts } @@ -134,7 +136,8 @@ test s name action = testCase name $ do data IntegrationConfig = IntegrationConfig -- internal endpoint - { cargohold :: Endpoint + { cargohold :: Endpoint, + brig :: Endpoint } deriving (Show, Generic) @@ -155,10 +158,12 @@ createTestSetup optsPath configPath = do iConf <- handleParseError =<< decodeFileEither configPath opts <- decodeFileThrow optsPath endpoint <- optOrEnv @IntegrationConfig (.cargohold) iConf (localEndpoint . read) "CARGOHOLD_WEB_PORT" + brigEndpoint <- optOrEnv @IntegrationConfig (.brig) iConf (localEndpoint . read) "BRIG_WEB_PORT" pure $ TestSetup { _tsManager = m, _tsEndpoint = endpoint, + _tsBrig = brigEndpoint, _tsOpts = opts }