module Test.FeatureFlags.MlsE2EId where

import qualified API.Galley as Public
import qualified Data.Aeson as A
import SetupHelpers
import Test.FeatureFlags.Util
import Testlib.Prelude

mlsE2EId1 :: Value
mlsE2EId1 :: Value
mlsE2EId1 =
  [Pair] -> Value
object
    [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
      String
"config"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"crlProxy" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://example.com",
            String
"verificationExpiration" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
86400,
            String
"useProxyOnMobile" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False
          ]
    ]

testMLSE2EId :: (HasCallStack) => APIAccess -> App ()
testMLSE2EId :: HasCallStack => APIAccess -> App ()
testMLSE2EId APIAccess
access = do
  Value
invalid <-
    Value
mlsE2EId1
      Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& if (APIAccess
access APIAccess -> APIAccess -> Bool
forall a. Eq a => a -> a -> Bool
== APIAccess
InternalAPI)
        then -- the internal API is not as strict as the public one, so we need to tweak the invalid config some more
          String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.crlProxy" ([Pair] -> Value
object [])
        else String -> Value -> App Value
forall a. (HasCallStack, MakesValue a) => String -> a -> App Value
removeField String
"config.crlProxy"
  Value
mlsE2EId2 <-
    Value
mlsE2EId1
      Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.verificationExpiration" (Scientific -> Value
A.Number Scientific
86401)
      App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> Bool -> App Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.useProxyOnMobile" Bool
True
  String -> FeatureTests
mkFeatureTests String
"mlsE2EId"
    FeatureTests -> (FeatureTests -> FeatureTests) -> FeatureTests
forall a b. a -> (a -> b) -> b
& Value -> FeatureTests -> FeatureTests
addUpdate Value
mlsE2EId1
    FeatureTests -> (FeatureTests -> FeatureTests) -> FeatureTests
forall a b. a -> (a -> b) -> b
& Value -> FeatureTests -> FeatureTests
addUpdate Value
mlsE2EId2
    FeatureTests -> (FeatureTests -> FeatureTests) -> FeatureTests
forall a b. a -> (a -> b) -> b
& Value -> FeatureTests -> FeatureTests
addInvalidUpdate Value
invalid
    FeatureTests -> (FeatureTests -> App ()) -> App ()
forall a b. a -> (a -> b) -> b
& Domain -> APIAccess -> FeatureTests -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> APIAccess -> FeatureTests -> App ()
runFeatureTests Domain
OwnDomain APIAccess
access

testPatchE2EId :: (HasCallStack) => App ()
testPatchE2EId :: HasCallStack => App ()
testPatchE2EId = do
  Domain -> String -> Value -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App ()
checkPatch Domain
OwnDomain String
"mlsE2EId" ([Pair] -> Value
object [String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"locked"])
  Domain -> String -> Value -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App ()
checkPatch Domain
OwnDomain String
"mlsE2EId" ([Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"])
  Domain -> String -> Value -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App ()
checkPatch Domain
OwnDomain String
"mlsE2EId"
    (Value -> App ()) -> Value -> App ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"locked", String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"]
  Domain -> String -> Value -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App ()
checkPatch Domain
OwnDomain String
"mlsE2EId"
    (Value -> App ()) -> Value -> App ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
      [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
        String
"config"
          String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
            [ String
"crlProxy" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://example.com",
              String
"verificationExpiration" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
86401,
              String
"useProxyOnMobile" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
            ]
      ]

  Domain -> String -> Value -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App ()
checkPatch Domain
OwnDomain String
"mlsE2EId"
    (Value -> App ()) -> Value -> App ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
      [ String
"config"
          String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
            [ String
"crlProxy" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://example.com",
              String
"verificationExpiration" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
86401,
              String
"useProxyOnMobile" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
            ]
      ]

testMlsE2EConfigCrlProxyRequired :: (HasCallStack) => App ()
testMlsE2EConfigCrlProxyRequired :: HasCallStack => App ()
testMlsE2EConfigCrlProxyRequired = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  let configWithoutCrlProxy :: Value
configWithoutCrlProxy =
        [Pair] -> Value
object
          [ String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"useProxyOnMobile" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
                  String
"verificationExpiration" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
86400
                ],
            String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
          ]

  -- From API version 6 onwards, the CRL proxy is required, so the request should fail when it's not provided
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
Public.setTeamFeatureConfig Value
owner String
tid String
"mlsE2EId" Value
configWithoutCrlProxy) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-e2eid-missing-crl-proxy"

  Value
configWithCrlProxy <-
    Value
configWithoutCrlProxy
      Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> Bool -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.useProxyOnMobile" Bool
True
      App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> String -> App Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.crlProxy" String
"https://crl-proxy.example.com"
      App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> String -> App Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"status" String
"enabled"

  -- The request should succeed when the CRL proxy is provided
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
Public.setTeamFeatureConfig Value
owner String
tid String
"mlsE2EId" Value
configWithCrlProxy) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- Assert that the feature config got updated correctly
  Value
expectedResponse <- Value
configWithCrlProxy Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"lockStatus" String
"unlocked" App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> String -> App Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"ttl" String
"unlimited"
  String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
"mlsE2EId" Value
owner String
tid Value
expectedResponse

testMlsE2EConfigCrlProxyNotRequiredInV5 :: (HasCallStack) => App ()
testMlsE2EConfigCrlProxyNotRequiredInV5 :: HasCallStack => App ()
testMlsE2EConfigCrlProxyNotRequiredInV5 = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  let configWithoutCrlProxy :: Value
configWithoutCrlProxy =
        [Pair] -> Value
object
          [ String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"useProxyOnMobile" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
                  String
"verificationExpiration" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
86400
                ],
            String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
          ]

  -- In API version 5, the CRL proxy is not required, so the request should succeed
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Versioned -> Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
Versioned -> user -> team -> featureName -> payload -> App Response
Public.setTeamFeatureConfigVersioned (Int -> Versioned
ExplicitVersion Int
5) Value
owner String
tid String
"mlsE2EId" Value
configWithoutCrlProxy) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- Assert that the feature config got updated correctly
  Value
expectedResponse <-
    Value
configWithoutCrlProxy
      Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"lockStatus" String
"unlocked"
      App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> String -> App Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"ttl" String
"unlimited"
      App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> String -> App Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.crlProxy" String
"https://crlproxy.example.com"
  String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
"mlsE2EId" Value
owner String
tid Value
expectedResponse