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

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

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

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

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

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

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

libs/wire-api/wire-api.cabal

@@ -273,6 +273,7 @@ library
     , hscim
     , HsOpenSSL
     , http-api-data
+    , http-client
     , http-media
     , http-types
     , imports

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 ()

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
 

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
 
+unverifiedUser :: Error
+unverifiedUser = errorToWai @'UnverifiedUser
+
+userNotFound :: Error
+userNotFound = errorToWai @'UserNotFound
+
 invalidMD5 :: Error
 invalidMD5 = mkError status400 "client-error" "Invalid MD5."
 

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

@@ -17,13 +17,15 @@
 
 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
 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))