Various improvements around LH policy conflict detection. (#3773)

* Move integration tests from galley/lh to /integration

* Improve test coverage

* Remove optimization for corner case of self messages

* Resolve trivial FUTUREWORK

changelog.d/3-bug-fixes/WPB-5803-users-under-legal-hold-can-not-exchange-messages

@@ -0,0 +1,5 @@
+Various improvements around LH policy conflict detection:
+* Fix LH policy conflict detection logic when posting messages
+* Better policy conflict error messages (distinguish between old clients and missing consent)
+* Add first LH scaffolding and tests to `/integration`
+* Annotate some API functions in `/integration` with links to openapi3 docs

integration/integration.cabal

@@ -122,6 +122,7 @@ library
     Test.FeatureFlags
     Test.Federation
     Test.Federator
+    Test.LegalHold
     Test.MessageTimer
     Test.MLS
     Test.MLS.KeyPackage
@@ -142,6 +143,7 @@ library
     Testlib.HTTP
     Testlib.JSON
     Testlib.Mock
+    Testlib.MockIntegrationService
     Testlib.ModService
     Testlib.One2One
     Testlib.Options

integration/test/API/Brig.hs

@@ -160,7 +160,8 @@ data AddClient = AddClient
     model :: String,
     prekeys :: Maybe [Value],
     lastPrekey :: Maybe Value,
-    password :: String
+    password :: String,
+    acapabilities :: Maybe [String]
   }
 
 instance Default AddClient where
@@ -172,9 +173,11 @@ instance Default AddClient where
         model = "Test Model",
         prekeys = Nothing,
         lastPrekey = Nothing,
-        password = defPassword
+        password = defPassword,
+        acapabilities = Just ["legalhold-implicit-consent"]
       }
 
+-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients__uid_
 addClient ::
   (HasCallStack, MakesValue user) =>
   user ->
@@ -193,14 +196,15 @@ addClient user args = do
           "type" .= args.ctype,
           "label" .= args.clabel,
           "model" .= args.model,
-          "password" .= args.password
+          "password" .= args.password,
+          "capabilities" .= args.acapabilities
         ]
 
 data UpdateClient = UpdateClient
   { prekeys :: [Value],
     lastPrekey :: Maybe Value,
     label :: Maybe String,
-    capabilities :: Maybe [Value],
+    capabilities :: Maybe [String],
     mlsPublicKeys :: Maybe Value
   }
 
@@ -245,6 +249,7 @@ deleteClient user client = do
         [ "password" .= defPassword
         ]
 
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_users__uid_domain___uid__clients
 getClientsQualified ::
   ( HasCallStack,
     MakesValue user,
@@ -267,6 +272,7 @@ getClientsQualified user domain otherUser = do
         <> "/clients"
   submit "GET" req
 
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_users_list_clients
 listUsersClients :: (HasCallStack, MakesValue user, MakesValue qualifiedUserIds) => user -> [qualifiedUserIds] -> App Response
 listUsersClients usr qualifiedUserIds = do
   qUsers <- mapM objQidObject qualifiedUserIds
@@ -588,3 +594,25 @@ updateService dom providerId serviceId mAcceptHeader newName = do
     . addHdrs
     . addJSONObject ["name" .= n | n <- maybeToList newName]
     $ req
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_users__uid_domain___uid__prekeys__client_
+getUsersPrekeysClient :: (HasCallStack, MakesValue caller, MakesValue targetUser) => caller -> targetUser -> String -> App Response
+getUsersPrekeysClient caller targetUser targetClient = do
+  dom <- asString $ targetUser %. "domain"
+  uid <- asString $ targetUser %. "id"
+  req <- baseRequest caller Brig Versioned $ joinHttpPath ["users", dom, uid, "prekeys", targetClient]
+  submit "GET" req
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_users__uid_domain___uid__prekeys
+getUsersPrekeyBundle :: (HasCallStack, MakesValue caller, MakesValue targetUser) => caller -> targetUser -> App Response
+getUsersPrekeyBundle caller targetUser = do
+  dom <- asString $ targetUser %. "domain"
+  uid <- asString $ targetUser %. "id"
+  req <- baseRequest caller Brig Versioned $ joinHttpPath ["users", dom, uid, "prekeys"]
+  submit "GET" req
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_users_list_prekeys
+getMultiUserPrekeyBundle :: (HasCallStack, MakesValue caller, ToJSON userClients) => caller -> userClients -> App Response
+getMultiUserPrekeyBundle caller userClients = do
+  req <- baseRequest caller Brig Versioned $ joinHttpPath ["users", "list-prekeys"]
+  submit "POST" (addJSON userClients req)

integration/test/API/Galley.hs

@@ -6,6 +6,7 @@ module API.Galley where
 import API.Common
 import Control.Lens hiding ((.=))
 import Control.Monad.Reader
+import Control.Retry
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 import qualified Data.ByteString.Base64 as B64
@@ -513,3 +514,55 @@ getTeamMembers user tid = do
   tidStr <- asString tid
   req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "members"])
   submit "GET" req
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings
+enableLegalHold :: (HasCallStack, MakesValue tid, MakesValue ownerid) => tid -> ownerid -> App Response
+enableLegalHold tid ownerid = do
+  tidStr <- asString tid
+  req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"])
+  submit "PUT" (addJSONObject ["status" .= "enabled", "ttl" .= "unlimited"] req)
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings
+postLegalHoldSettings :: (HasCallStack, MakesValue owner, MakesValue tid, MakesValue newService) => owner -> tid -> newService -> App Response
+postLegalHoldSettings owner tid newSettings = retrying policy only412 $ \_ -> do
+  tidStr <- asString tid
+  req <- baseRequest owner Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"])
+  newSettingsObj <- make newSettings
+  submit "POST" (addJSON newSettingsObj req)
+  where
+    policy :: RetryPolicy
+    policy = limitRetriesByCumulativeDelay 5_000_000 $ exponentialBackoff 50
+
+    only412 :: RetryStatus -> Response -> App Bool
+    only412 _ resp = pure $ resp.status == 412
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold__uid_
+requestLegalHoldDevice :: (HasCallStack, MakesValue tid, MakesValue ownerid, MakesValue uid) => tid -> ownerid -> uid -> App Response
+requestLegalHoldDevice tid ownerid uid = do
+  tidStr <- asString tid
+  uidStr <- objId uid
+  req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
+  submit "POST" req
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__legalhold__uid__approve
+approveLegalHoldDevice :: (HasCallStack, MakesValue tid, MakesValue uid) => tid -> uid -> String -> App Response
+approveLegalHoldDevice tid uid pwd = do
+  tidStr <- asString tid
+  uidStr <- asString $ uid %. "id"
+  req <- baseRequest uid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr, "approve"])
+  submit "PUT" (addJSONObject ["password" .= pwd] req)
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_consent
+consentToLegalHold :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> String -> App Response
+consentToLegalHold tid zusr pwd = do
+  tidStr <- asString tid
+  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "consent"])
+  submit "POST" (addJSONObject ["password" .= pwd] req)
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__legalhold__uid_
+getLegalHoldStatus :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> App Response
+getLegalHoldStatus tid zusr = do
+  tidStr <- asString tid
+  uidStr <- asString $ zusr %. "id"
+  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
+  submit "GET" req

integration/test/API/GalleyInternal.hs

@@ -58,3 +58,15 @@ getFederationStatus user domains =
         submit
           "GET"
           $ req & addJSONObject ["domains" .= domainList]
+
+legalholdWhitelistTeam :: (HasCallStack, MakesValue uid, MakesValue tid) => uid -> tid -> App Response
+legalholdWhitelistTeam uid tid = do
+  tidStr <- asString tid
+  req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr]
+  submit "PUT" req
+
+legalholdIsTeamInWhitelist :: (HasCallStack, MakesValue uid, MakesValue tid) => uid -> tid -> App Response
+legalholdIsTeamInWhitelist uid tid = do
+  tidStr <- asString tid
+  req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr]
+  submit "GET" req