failing test

wireapp · Oct 8, 2024 · 6ad53de · 6ad53de
1 parent 4de3d3a
commit 6ad53de
Show file tree

Hide file tree

Showing 3 changed files with 49 additions and 15 deletions.
diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs
@@ -290,7 +290,7 @@ testLHRequestDevice = do
   lpk <- getLastPrekey
   pks <- replicateM 3 getPrekey
 
-  withMockServer def (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do
+  withMockServer def (lhMockAppWithPrekeys V0 MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do
     let statusShouldBe :: String -> App ()
         statusShouldBe status =
           legalholdUserStatus tid alice bob `bindResponse` \resp -> do
@@ -440,7 +440,7 @@ testLHGetDeviceStatus = do
 
   withMockServer
     def
-    do lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}
+    do lhMockAppWithPrekeys V0 MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}
     \lhDomAndPort _chan -> do
       legalholdWhitelistTeam tid alice
         >>= assertStatus 200
@@ -778,7 +778,7 @@ testLHHappyFlow = do
   lpk <- getLastPrekey
   pks <- replicateM 3 getPrekey
 
-  withMockServer def (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do
+  withMockServer def (lhMockAppWithPrekeys V0 MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do
     postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201
 
     -- implicit consent
@@ -992,3 +992,11 @@ testBlockCreateMLSConvForLHUsers = do
       >>= \mp ->
         postMLSCommitBundle mp.sender (mkBundle mp)
           `bindResponse` assertLabel 409 "mls-legal-hold-not-allowed"
+
+testLHV1 :: App ()
+testLHV1 = do
+  (alice, tid, _) <- createTeam OwnDomain 2
+
+  legalholdWhitelistTeam tid alice >>= assertStatus 200
+  withMockServer def lhMockAppV1 \lhDomAndPort _chan -> do
+    postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201
diff --git a/integration/test/Testlib/MockIntegrationService.hs b/integration/test/Testlib/MockIntegrationService.hs
@@ -2,10 +2,12 @@ module Testlib.MockIntegrationService
   ( withMockServer,
     lhMockAppWithPrekeys,
     lhMockApp,
+    lhMockAppV1,
     mkLegalHoldSettings,
     CreateMock (..),
     LiftedApplication,
     MockServerSettings (..),
+    LhApiVersion (..),
   )
 where
 
@@ -65,7 +67,10 @@ withMockServer settings mkApp go = withFreePortAnyAddr \(sPort, sock) -> do
     Nothing -> error . show =<< poll srv
 
 lhMockApp :: Chan (Wai.Request, LBS.ByteString) -> LiftedApplication
-lhMockApp = lhMockAppWithPrekeys def
+lhMockApp = lhMockAppWithPrekeys V0 def
+
+lhMockAppV1 :: Chan (Wai.Request, LBS.ByteString) -> LiftedApplication
+lhMockAppV1 = lhMockAppWithPrekeys V1 def
 
 data MockServerSettings = MkMockServerSettings
   { -- | the certificate the mock service uses
@@ -98,24 +103,37 @@ instance (App ~ f) => Default (CreateMock f) where
         somePrekeys = replicateM 3 getPrekey
       }
 
+data LhApiVersion = V0 | V1
+
 -- | LegalHold service.  Just fake the API, do not maintain any internal state.
 lhMockAppWithPrekeys ::
-  CreateMock App -> Chan (Wai.Request, LBS.ByteString) -> LiftedApplication
-lhMockAppWithPrekeys mks ch req cont = withRunInIO \inIO -> do
+  LhApiVersion -> CreateMock App -> Chan (Wai.Request, LBS.ByteString) -> LiftedApplication
+lhMockAppWithPrekeys version mks ch req cont = withRunInIO \inIO -> do
   reqBody <- Wai.strictRequestBody req
   writeChan ch (req, reqBody)
   inIO do
     (nextLastPrekey, threePrekeys) <-
       (,)
         <$> mks.nextLastPrey
         <*> mks.somePrekeys
-    case (cs <$> pathInfo req, cs $ requestMethod req, cs @_ @String <$> getRequestHeader "Authorization" req) of
-      (["legalhold", "status"], "GET", _) -> cont respondOk
-      (_, _, Nothing) -> cont missingAuth
-      (["legalhold", "initiate"], "POST", Just _) -> cont (initiateResp nextLastPrekey threePrekeys)
-      (["legalhold", "confirm"], "POST", Just _) -> cont respondOk
-      (["legalhold", "remove"], "POST", Just _) -> cont respondOk
-      _ -> cont respondBad
+    case version of
+      V0 ->
+        case (cs <$> pathInfo req, cs $ requestMethod req, cs @_ @String <$> getRequestHeader "Authorization" req) of
+          (["legalhold", "status"], "GET", _) -> cont respondOk
+          (_, _, Nothing) -> cont missingAuth
+          (["legalhold", "initiate"], "POST", Just _) -> cont (initiateResp nextLastPrekey threePrekeys)
+          (["legalhold", "confirm"], "POST", Just _) -> cont respondOk
+          (["legalhold", "remove"], "POST", Just _) -> cont respondOk
+          _ -> cont respondBad
+      V1 ->
+        case (cs <$> pathInfo req, cs $ requestMethod req, cs @_ @String <$> getRequestHeader "Authorization" req) of
+          (["legalhold", "v1", "status"], "GET", _) -> cont respondOk
+          (["legalhold", "v1", "api-version"], "GET", _) -> cont apiVersionResp
+          (_, _, Nothing) -> cont missingAuth
+          (["legalhold", "v1", "initiate"], "POST", Just _) -> cont (initiateResp nextLastPrekey threePrekeys)
+          (["legalhold", "v1", "confirm"], "POST", Just _) -> cont respondOk
+          (["legalhold", "v1", "remove"], "POST", Just _) -> cont respondOk
+          _ -> cont respondBad
   where
     initiateResp :: Value -> [Value] -> Wai.Response
     initiateResp npk pks =
@@ -126,6 +144,14 @@ lhMockAppWithPrekeys mks ch req cont = withRunInIO \inIO -> do
             "last_prekey" .= npk
           ]
 
+    apiVersionResp :: Wai.Response
+    apiVersionResp =
+      responseLBS status200 [(hContentType, cs "application/json")]
+        . encode
+        . Data.Aeson.object
+        $ [ "supported" .= ([1] :: [Int])
+          ]
+
     respondOk :: Wai.Response
     respondOk = responseLBS status200 mempty mempty
 

diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs
@@ -111,9 +111,9 @@ createSettings lzusr tid newService = do
   --     . Log.field "action" (Log.val "LegalHold.createSettings")
   void $ permissionCheck ChangeLegalHoldTeamSettings zusrMembership
   (key :: ServiceKey, fpr :: Fingerprint Rsa) <-
-    LegalHoldData.validateServiceKey (newLegalHoldServiceKey newService)
+    LegalHoldData.validateServiceKey newService.newLegalHoldServiceKey
       >>= noteS @'LegalHoldServiceInvalidKey
-  LHService.checkLegalHoldServiceStatus fpr (newLegalHoldServiceUrl newService)
+  LHService.checkLegalHoldServiceStatus fpr newService.newLegalHoldServiceUrl
   let service = legalHoldService tid fpr newService key
   LegalHoldData.createSettings service
   pure . viewLegalHoldService $ service