WPB-22814 allow ephemeral users to upload files

changelog.d/2-features/WPB-22814

@@ -0,0 +1 @@
+Ephemeral users are now allowed to upload and download files

integration/test/Test/Cargohold/AssetDownload.hs

@@ -18,6 +18,7 @@
 module Test.Cargohold.AssetDownload where
 
 import API.Cargohold
+import qualified Data.ByteString.Char8 as BSC
 import GHC.Stack
 import SetupHelpers
 import Testlib.Prelude
@@ -32,9 +33,7 @@ testDownloadAsset = do
 
   bindResponse (downloadAsset user user key "nginz-https.example.com" id) $ \resp -> do
     resp.status `shouldMatchInt` 200
-    assertBool
-      ("Expect 'Hello World!' as text asset content. Got: " ++ show resp.body)
-      (resp.body == fromString "Hello World!")
+    BSC.unpack resp.body `shouldMatch` "Hello World!"
 
 testDownloadAssetMultiIngressS3DownloadUrl :: (HasCallStack) => App ()
 testDownloadAssetMultiIngressS3DownloadUrl = do
@@ -91,3 +90,34 @@ testDownloadAssetMultiIngressS3DownloadUrl = do
     doUploadAsset user = bindResponse (uploadSomeAsset user) $ \resp -> do
       resp.status `shouldMatchInt` 201
       resp.json %. "key"
+
+testUploadDownloadAssetEphemeralUser :: (HasCallStack) => App ()
+testUploadDownloadAssetEphemeralUser = do
+  user <- ephemeralUser OwnDomain
+
+  key <- bindResponse (uploadSomeAsset user) $ \resp -> do
+    resp.status `shouldMatchInt` 201
+    resp.json %. "key"
+
+  bindResponse (downloadAsset user user key "nginz-https.example.com" id) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    BSC.unpack resp.body `shouldMatch` "Hello World!"
+
+testUploadDownloadAssetEphemeralUserExpiration :: (HasCallStack) => App ()
+testUploadDownloadAssetEphemeralUserExpiration = do
+  let modifiedConfig = def {brigCfg = setField "zauth.authSettings.sessionTokenTimeout" (2 :: Int)}
+
+  withModifiedBackend modifiedConfig $ \domain -> do
+    user <- ephemeralUser domain
+
+    key <- bindResponse (uploadSomeAsset user) $ \resp -> do
+      resp.status `shouldMatchInt` 201
+      resp.json %. "key"
+
+    eventually $ bindResponse (downloadAsset user user key "nginz-https.example.com" id) $ \resp -> do
+      resp.status `shouldMatchInt` 403
+      resp.json %. "label" `shouldMatch` "unverified-user"
+
+    eventually $ bindResponse (uploadSomeAsset user) $ \resp -> do
+      resp.status `shouldMatchInt` 403
+      resp.json %. "label" `shouldMatch` "unverified-user"

integration/test/Test/Cargohold/AssetUpload.hs

@@ -17,17 +17,10 @@
 
 module Test.Cargohold.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 (uploadSomeAsset user) $ \resp -> do
-    resp.status `shouldMatchInt` 403
-
 testAssetUploadVerifiedUser :: (HasCallStack) => App ()
 testAssetUploadVerifiedUser = do
   user <- randomUser OwnDomain def

libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs

@@ -418,6 +418,13 @@ type AccountAPI =
                :> "users"
                :> Capture "uid" UserId
                :> "status"
+               :> QueryParam'
+                    [ Optional,
+                      Strict,
+                      Description "When true, enqueue deletion of expired ephemeral users before returning status"
+                    ]
+                    "gc"
+                    Bool
                :> Get '[Servant.JSON] AccountStatusResp
            )
     :<|> Named

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

@@ -58,11 +58,13 @@ import Data.Domain (Domain)
 import Data.Handle
 import Data.HavePendingInvitations
 import Data.Id as Id
+import Data.Json.Util (fromUTCTimeMillis)
 import Data.Map.Strict qualified as Map
 import Data.Misc (PlainTextPassword8)
 import Data.Qualified
 import Data.Set qualified as Set
 import Data.Text qualified as T
+import Data.Time (diffUTCTime)
 import Data.Time.Clock.System
 import Data.ZAuth.CryptoSign (CryptoSign)
 import Imports hiding (head)
@@ -99,7 +101,7 @@ import Wire.ActivationCodeStore (ActivationCodeStore)
 import Wire.AuthenticationSubsystem (AuthenticationSubsystem)
 import Wire.AuthenticationSubsystem.Config (AuthenticationSubsystemConfig)
 import Wire.BlockListStore (BlockListStore)
-import Wire.DeleteQueue (DeleteQueue)
+import Wire.DeleteQueue (DeleteQueue, enqueueUserDeletion)
 import Wire.DomainRegistrationStore hiding (domain)
 import Wire.EmailSubsystem (EmailSubsystem)
 import Wire.EnterpriseLoginSubsystem
@@ -124,8 +126,10 @@ import Wire.RateLimit
 import Wire.Rpc
 import Wire.Sem.Concurrency
 import Wire.Sem.Now (Now)
+import Wire.Sem.Now qualified as Now
 import Wire.Sem.Random (Random)
 import Wire.SparAPIAccess (SparAPIAccess)
+import Wire.StoredUser (StoredUser (..))
 import Wire.TeamInvitationSubsystem
 import Wire.TeamSubsystem (TeamSubsystem)
 import Wire.UserGroupSubsystem
@@ -247,7 +251,8 @@ accountAPI ::
     Member RateLimit r,
     Member SparAPIAccess r,
     Member EnterpriseLoginSubsystem r,
-    Member (Concurrency Unsafe) r
+    Member (Concurrency Unsafe) r,
+    Member Now r
   ) =>
   ServerT BrigIRoutes.AccountAPI (Handler r)
 accountAPI =
@@ -802,13 +807,33 @@ changeAccountStatusH usr (suStatus -> status) = do
   API.changeSingleAccountStatus usr status !>> accountStatusError -- FUTUREWORK: use CanThrow and related machinery
   pure NoContent
 
-getAccountStatusH :: (Member UserStore r) => UserId -> (Handler r) AccountStatusResp
-getAccountStatusH uid = do
+getAccountStatusH ::
+  ( Member UserStore r,
+    Member DeleteQueue r,
+    Member Now r
+  ) =>
+  UserId ->
+  Maybe Bool ->
+  (Handler r) AccountStatusResp
+getAccountStatusH uid mGc = do
   status <- lift $ liftSem $ lookupStatus uid
-  maybe
-    (throwStd (errorToWai @'E.UserNotFound))
-    (pure . AccountStatusResp)
-    status
+  case status of
+    Nothing -> throwStd (errorToWai @'E.UserNotFound)
+    Just st -> do
+      when (fromMaybe False mGc) $ do
+        mUser <- lift $ liftSem $ getUser uid
+        for_ mUser enqueueIfExpired
+      pure (AccountStatusResp st)
+  where
+    enqueueIfExpired :: (Member DeleteQueue r, Member Now r) => StoredUser -> Handler r ()
+    enqueueIfExpired StoredUser {status = mStatus, expires = mExpires, id = _} =
+      case (mStatus, mExpires) of
+        (Just Ephemeral, Just (fromUTCTimeMillis -> e)) -> do
+          t <- lift $ liftSem Now.get
+          when (diffUTCTime e t < 0) $ do
+            lift $ liftSem $ enqueueUserDeletion uid
+            throwStd (errorToWai @'E.UserNotFound)
+        _ -> pure ()
 
 getConnectionsStatusUnqualified :: ConnectionsStatusRequest -> Maybe Relation -> (Handler r) [ConnectionStatus]
 getConnectionsStatusUnqualified ConnectionsStatusRequest {csrFrom, csrTo} flt = lift $ do

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

@@ -17,7 +17,7 @@
 
 module CargoHold.API.Public (servantSitemap, internalSitemap) where
 
-import CargoHold.API.Error (unverifiedUser, userNotFound)
+import CargoHold.API.Error (unverifiedUser)
 import qualified CargoHold.API.Legacy as LegacyAPI
 import CargoHold.API.Util
 import qualified CargoHold.API.V3 as V3
@@ -42,11 +42,10 @@ import Servant.Server hiding (Handler)
 import URI.ByteString as URI
 import Wire.API.Asset
 import Wire.API.Routes.AssetBody
-import Wire.API.Routes.Internal.Brig (brigInternalClient)
 import Wire.API.Routes.Internal.Cargohold
 import Wire.API.Routes.Named
 import Wire.API.Routes.Public.Cargohold
-import Wire.API.User (AccountStatus (Active), AccountStatusResp (..))
+import Wire.API.User (AccountStatus (..))
 
 servantSitemap :: ServerT CargoholdAPI Handler
 servantSitemap =
@@ -80,8 +79,7 @@ servantSitemap =
         :<|> Named @"assets-conv-otr-download-legacy" legacyDownloadOtr
     qualifiedAPI :: ServerT QualifiedAPI Handler
     qualifiedAPI =
-      Named @"assets-download-v4"
-        downloadAssetV4
+      Named @"assets-download-v4" downloadAssetV4
         :<|> Named @"assets-delete-v4" deleteAssetV4
     mainAPI :: ServerT MainAPI Handler
     mainAPI =
@@ -177,11 +175,10 @@ 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
+      status <- getUserStatus uid True
+      case status of
         Active -> pure ()
+        Ephemeral -> pure ()
         _ -> throwE unverifiedUser
     _ -> pure ()
   asset <- V3.upload principal (getAssetSource req)

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

@@ -18,14 +18,19 @@
 module CargoHold.API.Util
   ( ensureLocal,
     qualifyLocal,
+    getUserStatus,
   )
 where
 
+import CargoHold.API.Error (userNotFound)
 import CargoHold.App
 import Control.Error
+import Data.Id
 import Data.Qualified
 import Imports
 import Wire.API.Federation.Error
+import Wire.API.Routes.Internal.Brig
+import Wire.API.User (AccountStatus (..), AccountStatusResp (..))
 
 ensureLocal :: Qualified a -> Handler (Local a)
 ensureLocal value = do
@@ -36,3 +41,8 @@ qualifyLocal :: a -> Handler (Local a)
 qualifyLocal x = do
   loc <- asks (.localUnit)
   pure (qualifyAs loc x)
+
+getUserStatus :: UserId -> Bool -> Handler AccountStatus
+getUserStatus uid gc = do
+  result <- lift $ executeBrigInteral $ brigInternalClient @"iGetUserStatus" uid (Just gc)
+  either (const $ throwE userNotFound) (pure . fromAccountStatusResp) result

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

@@ -65,6 +65,7 @@ import Network.HTTP.Types.Header
 import Network.Wai.Utilities (Error (..))
 import URI.ByteString
 import Wire.API.Asset
+import Wire.API.User (AccountStatus (..))
 
 upload :: V3.Principal -> ConduitM () ByteString (ResourceT IO) () -> Handler (Asset' (Local AssetKey))
 upload own bdy = do
@@ -126,6 +127,14 @@ randToken = liftIO $ V3.AssetToken . Ascii.encodeBase64Url <$> getRandomBytes 16
 download :: V3.Principal -> V3.AssetKey -> Maybe V3.AssetToken -> Maybe Text -> Handler (Maybe URI)
 download own key tok mbHost = runMaybeT $ do
   qown <- lift $ qualifyLocal own
+  case own of
+    V3.UserPrincipal uid -> do
+      status <- lift $ getUserStatus uid True
+      case status of
+        Active -> pure ()
+        Ephemeral -> pure ()
+        _ -> lift $ throwE unverifiedUser
+    _ -> pure ()
   meta <- checkMetadata (tUntagged qown) key tok
   lift $ genSignedURL (Just $ tUntagged qown) (Just meta) (S3.mkKey key) mbHost