Clean up LH tests (#3830)

* Use HasTests to save a few LOC.

* Fix/extend client CRUD api.

- moved internal add from API.Brig to API.BrigInternal
- created API.BrigCommon for data structured needed in both
- added public add

* Tranlate tests: manually add/delete client.

* Fiddle with test case type abstractions.

* Remove obsolete test from integration/test/Test/Demo.hs

changelog.d/5-internal/WPB-6254-translate-LH-tests-part-1

@@ -0,0 +1 @@
+Translate integration tests: manually add / delete LH device

integration/integration.cabal

@@ -89,6 +89,7 @@ library
   -- cabal-fmt: expand test
   exposed-modules:
     API.Brig
+    API.BrigCommon
     API.BrigInternal
     API.Cargohold
     API.Common

integration/test/API/Brig.hs

@@ -1,5 +1,6 @@
 module API.Brig where
 
+import API.BrigCommon
 import API.Common
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Base64 as Base64
@@ -148,50 +149,16 @@ deleteUser user = do
   submit "DELETE" $
     req & addJSONObject ["password" .= defPassword]
 
-data AddClient = AddClient
-  { ctype :: String,
-    internal :: Bool,
-    clabel :: String,
-    model :: String,
-    prekeys :: Maybe [Value],
-    lastPrekey :: Maybe Value,
-    password :: String,
-    acapabilities :: Maybe [String]
-  }
-
-instance Default AddClient where
-  def =
-    AddClient
-      { ctype = "permanent",
-        internal = False,
-        clabel = "Test Device",
-        model = "Test Model",
-        prekeys = Nothing,
-        lastPrekey = Nothing,
-        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 ->
   AddClient ->
   App Response
 addClient user args = do
-  req <- baseRequest user Brig Versioned $ "/clients/"
-  pks <- maybe (fmap pure getPrekey) pure args.prekeys
-  lpk <- maybe getLastPrekey pure args.lastPrekey
-  submit "POST" $
-    req
-      & addJSONObject
-        [ "prekeys" .= pks,
-          "lastkey" .= lpk,
-          "type" .= args.ctype,
-          "label" .= args.clabel,
-          "model" .= args.model,
-          "password" .= args.password,
-          "capabilities" .= args.acapabilities
-        ]
+  req <- baseRequest user Brig Versioned $ "/clients"
+  val <- mkAddClientValue args
+  submit "POST" $ req & addJSONObject val
 
 data UpdateClient = UpdateClient
   { prekeys :: [Value],
@@ -228,6 +195,7 @@ updateClient cid args = do
             <> ["mls_public_keys" .= k | k <- toList args.mlsPublicKeys]
         )
 
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/delete_clients__client_
 deleteClient ::
   (HasCallStack, MakesValue user, MakesValue client) =>
   user ->

integration/test/API/BrigCommon.hs

@@ -0,0 +1,44 @@
+module API.BrigCommon where
+
+import API.Common
+import Data.Aeson.Types (Pair)
+import Data.Maybe
+import Testlib.Prelude as Prelude
+
+data AddClient = AddClient
+  { ctype :: String, -- "temporary", "permanent", "legalhold"
+    internal :: Bool,
+    clabel :: String,
+    model :: String,
+    prekeys :: Maybe [Value],
+    lastPrekey :: Maybe Value,
+    password :: String,
+    acapabilities :: Maybe [String]
+  }
+
+instance Default AddClient where
+  def =
+    AddClient
+      { ctype = "permanent",
+        internal = False,
+        clabel = "Test Device",
+        model = "Test Model",
+        prekeys = Nothing,
+        lastPrekey = Nothing,
+        password = defPassword,
+        acapabilities = Just ["legalhold-implicit-consent"]
+      }
+
+mkAddClientValue :: AddClient -> App [Pair]
+mkAddClientValue args = do
+  pks <- maybe (fmap pure getPrekey) pure args.prekeys
+  lpk <- maybe getLastPrekey pure args.lastPrekey
+  pure
+    [ "prekeys" .= pks,
+      "lastkey" .= lpk,
+      "type" .= args.ctype,
+      "label" .= args.clabel,
+      "model" .= args.model,
+      "password" .= args.password,
+      "capabilities" .= args.acapabilities
+    ]

integration/test/API/BrigInternal.hs

@@ -1,6 +1,6 @@
 module API.BrigInternal where
 
-import API.Brig (AddClient (..))
+import API.BrigCommon
 import API.Common
 import qualified Data.Aeson as Aeson
 import Data.Aeson.Types (Pair)
@@ -28,28 +28,6 @@ instance Default CreateUser where
         supportedProtocols = Nothing
       }
 
-iAddClient ::
-  (HasCallStack, MakesValue user) =>
-  user ->
-  AddClient ->
-  App Response
-iAddClient user args = do
-  uid <- objId user
-  req <- baseRequest user Brig Unversioned $ "/i/clients/" <> uid
-  pks <- maybe (fmap pure getPrekey) pure args.prekeys
-  lpk <- maybe getLastPrekey pure args.lastPrekey
-  submit "POST" $
-    req
-      & addJSONObject
-        [ "prekeys" .= pks,
-          "lastkey" .= lpk,
-          "type" .= args.ctype,
-          "label" .= args.clabel,
-          "model" .= args.model,
-          "password" .= args.password,
-          "capabilities" .= args.acapabilities
-        ]
-
 createUser :: (HasCallStack, MakesValue domain) => domain -> CreateUser -> App Response
 createUser domain cu = do
   re <- randomEmail
@@ -246,3 +224,15 @@ getProviderActivationCodeInternal dom email = do
     rawBaseRequest d Brig Unversioned $
       joinHttpPath ["i", "provider", "activation-code"]
   submit "GET" (addQueryParams [("email", email)] req)
+
+-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients__uid_
+addClient ::
+  (HasCallStack, MakesValue user) =>
+  user ->
+  AddClient ->
+  App Response
+addClient user args = do
+  uid <- objId user
+  req <- baseRequest user Brig Unversioned $ "/i/clients/" <> uid
+  val <- mkAddClientValue args
+  submit "POST" $ req & addJSONObject val

integration/test/MLS/Util.hs

@@ -3,6 +3,7 @@
 module MLS.Util where
 
 import API.Brig
+import qualified API.BrigCommon as BrigC
 import API.Galley
 import Control.Concurrent.Async hiding (link)
 import Control.Monad
@@ -127,7 +128,7 @@ argSubst from to_ s =
 createWireClient :: (MakesValue u, HasCallStack) => u -> App ClientIdentity
 createWireClient u = do
   lpk <- getLastPrekey
-  c <- addClient u def {lastPrekey = Just lpk} >>= getJSON 201
+  c <- addClient u def {BrigC.lastPrekey = Just lpk} >>= getJSON 201
   mkClientIdentity u c
 
 data CredentialType = BasicCredentialType | X509CredentialType

integration/test/Test/Conversation.hs

@@ -20,7 +20,7 @@
 module Test.Conversation where
 
 import API.Brig
-import API.BrigInternal
+import qualified API.BrigInternal as BrigI
 import API.Galley
 import API.GalleyInternal
 import Control.Applicative
@@ -41,9 +41,9 @@ testDynamicBackendsFullyConnectedWhenAllowAll = do
   -- The default setting is 'allowAll'
   startDynamicBackends [def, def, def] $ \dynDomains -> do
     [domainA, domainB, domainC] <- pure dynDomains
-    uidA <- randomUser domainA def {team = True}
-    uidB <- randomUser domainA def {team = True}
-    uidC <- randomUser domainA def {team = True}
+    uidA <- randomUser domainA def {BrigI.team = True}
+    uidB <- randomUser domainA def {BrigI.team = True}
+    uidC <- randomUser domainA def {BrigI.team = True}
     assertConnected uidA domainB domainC
     assertConnected uidB domainA domainC
     assertConnected uidC domainA domainB
@@ -64,7 +64,7 @@ testDynamicBackendsNotFederating = do
               setField "optSettings.setFederationStrategy" "allowNone"
           }
   startDynamicBackends [overrides, overrides, overrides] $ \[domainA, domainB, domainC] -> do
-    uidA <- randomUser domainA def {team = True}
+    uidA <- randomUser domainA def {BrigI.team = True}
     retryT
       $ bindResponse
         (getFederationStatus uidA [domainB, domainC])
@@ -78,14 +78,14 @@ testDynamicBackendsFullyConnectedWhenAllowDynamic = do
     -- Allowing 'full_search' or any type of search is how we enable federation
     -- between backends when the federation strategy is 'allowDynamic'.
     sequence_
-      [ createFedConn x (FedConn y "full_search" Nothing)
+      [ BrigI.createFedConn x (BrigI.FedConn y "full_search" Nothing)
         | x <- [domainA, domainB, domainC],
           y <- [domainA, domainB, domainC],
           x /= y
       ]
-    uidA <- randomUser domainA def {team = True}
-    uidB <- randomUser domainB def {team = True}
-    uidC <- randomUser domainC def {team = True}
+    uidA <- randomUser domainA def {BrigI.team = True}
+    uidB <- randomUser domainB def {BrigI.team = True}
+    uidC <- randomUser domainC def {BrigI.team = True}
     let assertConnected u d d' =
           bindResponse
             (getFederationStatus u [d, d'])
@@ -100,11 +100,11 @@ testDynamicBackendsNotFullyConnected :: HasCallStack => App ()
 testDynamicBackendsNotFullyConnected = do
   withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do
     -- A is connected to B and C, but B and C are not connected to each other
-    void $ createFedConn domainA $ FedConn domainB "full_search" Nothing
-    void $ createFedConn domainB $ FedConn domainA "full_search" Nothing
-    void $ createFedConn domainA $ FedConn domainC "full_search" Nothing
-    void $ createFedConn domainC $ FedConn domainA "full_search" Nothing
-    uidA <- randomUser domainA def {team = True}
+    void $ BrigI.createFedConn domainA $ BrigI.FedConn domainB "full_search" Nothing
+    void $ BrigI.createFedConn domainB $ BrigI.FedConn domainA "full_search" Nothing
+    void $ BrigI.createFedConn domainA $ BrigI.FedConn domainC "full_search" Nothing
+    void $ BrigI.createFedConn domainC $ BrigI.FedConn domainA "full_search" Nothing
+    uidA <- randomUser domainA def {BrigI.team = True}
     retryT
       $ bindResponse
         (getFederationStatus uidA [domainB, domainC])
@@ -115,7 +115,7 @@ testDynamicBackendsNotFullyConnected = do
 
 testFederationStatus :: HasCallStack => App ()
 testFederationStatus = do
-  uid <- randomUser OwnDomain def {team = True}
+  uid <- randomUser OwnDomain def {BrigI.team = True}
   federatingRemoteDomain <- asString OtherDomain
   let invalidDomain = "c.example.com" -- Does not have any srv records
   bindResponse
@@ -149,10 +149,10 @@ testCreateConversationNonFullyConnected :: HasCallStack => App ()
 testCreateConversationNonFullyConnected = do
   withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do
     -- A is connected to B and C, but B and C are not connected to each other
-    void $ createFedConn domainA $ FedConn domainB "full_search" Nothing
-    void $ createFedConn domainB $ FedConn domainA "full_search" Nothing
-    void $ createFedConn domainA $ FedConn domainC "full_search" Nothing
-    void $ createFedConn domainC $ FedConn domainA "full_search" Nothing
+    void $ BrigI.createFedConn domainA $ BrigI.FedConn domainB "full_search" Nothing
+    void $ BrigI.createFedConn domainB $ BrigI.FedConn domainA "full_search" Nothing
+    void $ BrigI.createFedConn domainA $ BrigI.FedConn domainC "full_search" Nothing
+    void $ BrigI.createFedConn domainC $ BrigI.FedConn domainA "full_search" Nothing
     liftIO $ threadDelay (2 * 1000 * 1000)
 
     u1 <- randomUser domainA def
@@ -184,10 +184,10 @@ testAddMembersFullyConnectedProteus = do
 testAddMembersNonFullyConnectedProteus :: HasCallStack => App ()
 testAddMembersNonFullyConnectedProteus = do
   withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do
-    void $ createFedConn domainA (FedConn domainB "full_search" Nothing)
-    void $ createFedConn domainB (FedConn domainA "full_search" Nothing)
-    void $ createFedConn domainA (FedConn domainC "full_search" Nothing)
-    void $ createFedConn domainC (FedConn domainA "full_search" Nothing)
+    void $ BrigI.createFedConn domainA (BrigI.FedConn domainB "full_search" Nothing)
+    void $ BrigI.createFedConn domainB (BrigI.FedConn domainA "full_search" Nothing)
+    void $ BrigI.createFedConn domainA (BrigI.FedConn domainC "full_search" Nothing)
+    void $ BrigI.createFedConn domainC (BrigI.FedConn domainA "full_search" Nothing)
     liftIO $ threadDelay (2 * 1000 * 1000) -- wait for federation status to be updated
 
     -- add users
@@ -386,7 +386,7 @@ testAddingUserNonFullyConnectedFederation = do
 
     -- Ensure that dynamic backend only federates with own domain, but not other
     -- domain.
-    void $ createFedConn dynBackend (FedConn own "full_search" Nothing)
+    void $ BrigI.createFedConn dynBackend (BrigI.FedConn own "full_search" Nothing)
 
     alice <- randomUser own def
     bob <- randomUser other def
@@ -818,7 +818,7 @@ testUpdateConversationByRemoteAdmin = do
 
 testGuestCreatesConversation :: HasCallStack => App ()
 testGuestCreatesConversation = do
-  alice <- randomUser OwnDomain def {activate = False}
+  alice <- randomUser OwnDomain def {BrigI.activate = False}
   bindResponse (postConversation alice defProteus) $ \resp -> do
     resp.status `shouldMatchInt` 403
     resp.json %. "label" `shouldMatch` "operation-denied"

integration/test/Test/Demo.hs

@@ -12,17 +12,6 @@ import GHC.Stack
 import SetupHelpers
 import Testlib.Prelude
 
--- | Legalhold clients cannot be deleted.
-testCantDeleteLHClient :: HasCallStack => App ()
-testCantDeleteLHClient = do
-  user <- randomUser OwnDomain def
-  client <-
-    BrigI.iAddClient user def {BrigP.ctype = "legalhold", BrigP.internal = True}
-      >>= getJSON 201
-
-  bindResponse (BrigP.deleteClient user client) $ \resp -> do
-    resp.status `shouldMatchInt` 400
-
 -- | Deleting unknown clients should fail with 404.
 testDeleteUnknownClient :: HasCallStack => App ()
 testDeleteUnknownClient = do