WPB-1906 - Unverified users can no longer create assets

changelog.d/1-api-changes/WPB-1906

@@ -0,0 +1 @@
+Un-verified users can no longer upload assets

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

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

integration/integration.cabal

@@ -101,6 +101,7 @@ library
     SetupHelpers
     Test.AccessUpdate
     Test.AssetDownload
+    Test.AssetUpload
     Test.B2B
     Test.Brig
     Test.Client

integration/test/Test/AssetUpload.hs

@@ -0,0 +1,18 @@
+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

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
 

libs/wire-api/src/Wire/API/Error/Cargohold.hs

@@ -26,6 +26,8 @@ data CargoholdError
   | AssetTooLarge
   | InvalidLength
   | NoMatchingAssetEndpoint
+  | Unverified
+  | 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 'Unverified = '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

services/brig/src/Brig/API/Public.hs

@@ -1064,7 +1064,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 ()

services/brig/test/integration/API/User/Account.hs

@@ -1454,7 +1454,10 @@ testDeleteAnonUser brig = do
 
 testDeleteWithProfilePic :: Brig -> CargoHold -> Http ()
 testDeleteWithProfilePic brig cargohold = do
-  uid <- userId <$> createAnonUser "anon" brig
+  -- A random local part, with nice, email-friendly characters
+  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 +1472,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
 

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

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

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

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

@@ -35,6 +35,12 @@ invalidLength = errorToWai @'InvalidLength
 assetNotFound :: Error
 assetNotFound = errorToWai @'AssetNotFound
 
+unverified :: Error
+unverified = errorToWai @'Unverified
+
+userNotFound :: Error
+userNotFound = errorToWai @'UserNotFound
+
 invalidMD5 :: Error
 invalidMD5 = mkError status400 "client-error" "Invalid MD5."
 

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

@@ -17,29 +17,36 @@
 
 module CargoHold.API.Public (servantSitemap, internalSitemap) where
 
+import CargoHold.API.Error (unverified, userNotFound)
 import qualified CargoHold.API.Legacy as LegacyAPI
 import CargoHold.API.Util
 import qualified CargoHold.API.V3 as V3
 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.CommaSeparatedList (CommaSeparatedList (..))
 import Data.Domain
 import Data.Id
 import Data.Kind
 import Data.Qualified
 import Imports hiding (head)
 import qualified Network.HTTP.Types as HTTP
 import Servant.API
+import Servant.Client
 import Servant.Server hiding (Handler)
 import URI.ByteString
 import Wire.API.Asset
 import Wire.API.Federation.API
 import Wire.API.Routes.AssetBody
+import qualified Wire.API.Routes.Internal.Brig as IBrig
 import Wire.API.Routes.Internal.Cargohold
+import Wire.API.Routes.Named (namedClient)
 import Wire.API.Routes.Public.Cargohold
+import Wire.API.User (accountUser, userIdentity)
 
 servantSitemap :: ServerT CargoholdAPI Handler
 servantSitemap =
@@ -136,9 +143,28 @@ uploadAssetV3 ::
   AssetSource ->
   Handler (Asset, AssetLocation Relative)
 uploadAssetV3 pid req = do
+  clientEnv <- asks $ view brigClientEnv
   let principal = mkPrincipal pid
+      getUser uid = runClientM (client' uid) clientEnv
+  case principal of
+    V3.UserPrincipal uid -> do
+      resp <- liftIO $ getUser uid
+      users <- either (const $ throwE userNotFound) pure resp
+      maybe
+        (throwE unverified)
+        (const (pure ()) . userIdentity . accountUser)
+        (listToMaybe users)
+    _ -> pure ()
   asset <- V3.upload principal (getAssetSource req)
   pure (fmap tUntagged asset, mkAssetLocation @tag (asset ^. assetKey))
+  where
+    client' uid =
+      namedClient @IBrig.API @"iGetUsersByVariousKeys"
+        (pure $ CommaSeparatedList [uid])
+        Nothing
+        Nothing
+        Nothing
+        Nothing
 
 downloadAssetV3 ::
   MakePrincipal tag id =>

services/cargohold/src/CargoHold/App.hs

@@ -35,6 +35,7 @@ module CargoHold.App
     localUnit,
     options,
     settings,
+    brigClientEnv,
 
     -- * App Monad
     AppT,
@@ -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)
@@ -65,13 +66,15 @@ import qualified Data.Map as Map
 import Data.Metrics.Middleware (Metrics)
 import qualified Data.Metrics.Middleware as Metrics
 import Data.Qualified
+import qualified Data.Text as T
 import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx)
 import Imports hiding (log)
-import Network.HTTP.Client (ManagerSettings (..), requestHeaders, responseTimeoutMicro)
+import Network.HTTP.Client (ManagerSettings (..), defaultManagerSettings, requestHeaders, responseTimeoutMicro)
 import Network.HTTP.Client.OpenSSL
 import Network.Wai.Utilities (Error (..))
 import OpenSSL.Session (SSLContext, SSLOption (..))
 import qualified OpenSSL.Session as SSL
+import Servant.Client
 import System.Logger.Class hiding (settings)
 import qualified System.Logger.Extended as Log
 import Util.Options
@@ -88,7 +91,8 @@ data Env = Env
     _requestId :: RequestId,
     _options :: Opt.Opts,
     _localUnit :: Local (),
-    _multiIngress :: Map String AWS.Env
+    _multiIngress :: Map String AWS.Env,
+    _brigClientEnv :: ClientEnv
   }
 
 makeLenses ''Env
@@ -106,7 +110,10 @@ newEnv o = do
   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
+      (Endpoint h p) = o ^. brig
+      baseUrl = BaseUrl Http (T.unpack h) (fromIntegral p) ""
+  clientEnv <- liftIO $ newManager defaultManagerSettings <&> \m -> ClientEnv m baseUrl Nothing defaultMakeClientRequest
+  pure $ Env ama met lgr mgr h2mgr def o loc multiIngressAWS clientEnv
   where
     initMultiIngressAWS :: Logger -> Manager -> IO (Map String AWS.Env)
     initMultiIngressAWS lgr mgr =

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)

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