-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2023 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.FeatureFlags.Util where

import qualified API.Galley as Public
import qualified API.GalleyInternal as Internal
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Text as Text
import Notifications
import SetupHelpers
import Testlib.Prelude

data APIAccess = InternalAPI | PublicAPI
  deriving (Int -> APIAccess -> ShowS
[APIAccess] -> ShowS
APIAccess -> String
(Int -> APIAccess -> ShowS)
-> (APIAccess -> String)
-> ([APIAccess] -> ShowS)
-> Show APIAccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APIAccess -> ShowS
showsPrec :: Int -> APIAccess -> ShowS
$cshow :: APIAccess -> String
show :: APIAccess -> String
$cshowList :: [APIAccess] -> ShowS
showList :: [APIAccess] -> ShowS
Show, APIAccess -> APIAccess -> Bool
(APIAccess -> APIAccess -> Bool)
-> (APIAccess -> APIAccess -> Bool) -> Eq APIAccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APIAccess -> APIAccess -> Bool
== :: APIAccess -> APIAccess -> Bool
$c/= :: APIAccess -> APIAccess -> Bool
/= :: APIAccess -> APIAccess -> Bool
Eq)

instance TestCases APIAccess where
  mkTestCases :: IO [TestCase APIAccess]
mkTestCases =
    [TestCase APIAccess] -> IO [TestCase APIAccess]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      [ String -> APIAccess -> TestCase APIAccess
forall a. String -> a -> TestCase a
MkTestCase String
"[api=internal]" APIAccess
InternalAPI,
        String -> APIAccess -> TestCase APIAccess
forall a. String -> a -> TestCase a
MkTestCase String
"[api=public]" APIAccess
PublicAPI
      ]

newtype Feature = Feature String

instance TestCases Feature where
  mkTestCases :: IO [TestCase Feature]
mkTestCases = [TestCase Feature] -> IO [TestCase Feature]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TestCase Feature] -> IO [TestCase Feature])
-> [TestCase Feature] -> IO [TestCase Feature]
forall a b. (a -> b) -> a -> b
$ case Value
defAllFeatures of
    Object Object
obj -> do
      feat <- Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj
      let A.String nameT = toJSON feat
          name = Text -> String
Text.unpack Text
nameT
      pure $ MkTestCase ("[feature=" <> name <> "]") (Feature name)
    Value
_ -> []

setFeature :: APIAccess -> Value -> String -> String -> Value -> App Response
setFeature :: APIAccess -> Value -> String -> String -> Value -> App Response
setFeature APIAccess
InternalAPI = Value -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
Internal.setTeamFeatureConfig
setFeature APIAccess
PublicAPI = Value -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
Public.setTeamFeatureConfig

disabled :: Value
disabled :: Value
disabled = [Pair] -> Value
object [String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked", String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled", String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited"]

disabledLocked :: Value
disabledLocked :: Value
disabledLocked = [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
"disabled", String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited"]

enabled :: Value
enabled :: Value
enabled = [Pair] -> Value
object [String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked", String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled", String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited"]

defEnabledObj :: Value -> Value
defEnabledObj :: Value -> Value
defEnabledObj Value
conf =
  [Pair] -> Value
object
    [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
      String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
      String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
      String
"config" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
conf
    ]

defCellsConfig :: Value
defCellsConfig :: Value
defCellsConfig =
  [Pair] -> Value
object
    [ String
"channels"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"default" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
          ],
      String
"groups"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"default" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
          ],
      String
"one2one"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"default" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
          ],
      String
"users"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"externals" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"guests" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False
          ],
      String
"collabora"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False],
      String
"publicLinks"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"enableFiles" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"enableFolders" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"enforcePassword" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
            String
"enforceExpirationMax" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
0 :: Int),
            String
"enforceExpirationDefault" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
0 :: Int)
          ],
      String
"storage"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"perFileQuotaBytes" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"100000000",
            String
"recycle"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"autoPurgeDays" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
30 :: Int),
                  String
"disable" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
                  String
"allowSkip" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False
                ]
          ],
      String
"metadata"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"namespaces"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"usermetaTags"
                    String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                      [ String
"defaultValues" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String]),
                        String
"allowFreeValues" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
                      ]
                ]
          ]
    ]

defAllFeatures :: Value
defAllFeatures :: Value
defAllFeatures =
  [Pair] -> Value
object
    [ String
"legalhold" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabled,
      String
"sso" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabled,
      String
"searchVisibility" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabled,
      String
"validateSAMLemails" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
enabled,
      String
"digitalSignatures" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabled,
      String
"appLock" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value -> Value
defEnabledObj ([Pair] -> Value
object [String
"enforceAppLock" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False, String
"inactivityTimeoutSecs" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
60]),
      String
"fileSharing" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
enabled,
      String
"classifiedDomains" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value -> Value
defEnabledObj ([Pair] -> Value
object [String
"domains" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"example.com"]]),
      String
"conferenceCalling" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ConfCalling -> Value
confCalling ConfCalling
forall a. Default a => a
def {lockStatus = Just "locked"},
      String
"selfDeletingMessages"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value -> Value
defEnabledObj ([Pair] -> Value
object [String
"enforcedTimeoutSeconds" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
0]),
      String
"conversationGuestLinks" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
enabled,
      String
"sndFactorPasswordChallenge" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"mls"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
            String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"protocolToggleUsers" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String]),
                  String
"defaultProtocol" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"proteus",
                  String
"supportedProtocols" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"proteus", String
"mls"],
                  String
"allowedCipherSuites" String -> [Int] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([Int
2] :: [Int]),
                  String
"defaultCipherSuite" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Scientific -> Value
A.Number Scientific
2,
                  String
"groupInfoDiagnostics" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False
                ]
          ],
      String
"searchVisibilityInbound" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabled,
      String
"exposeInvitationURLsToTeamAdmin" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"outlookCalIntegration" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"mlsE2EId"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
            String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ 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,
                  String
"crlProxy" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://crlproxy.example.com"
                ]
          ],
      String
"mlsMigration"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [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",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"startTime" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"2029-05-16T10:11:12.123Z",
                  String
"finaliseRegardlessAfter" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"2029-10-17T00:00:00Z"
                ]
          ],
      String
"enforceFileDownloadLocation"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
            String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"enforcedDownloadLocation" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"downloads"
                ]
          ],
      String
"limitedEventFanout" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabled,
      String
"domainRegistration" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"channels"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [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
"disabled",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"allowed_to_create_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team-members",
                  String
"allowed_to_open_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team-members"
                ]
          ],
      String
"cells"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
            String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
defCellsConfig
          ],
      String
"assetAuditLog" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"allowedGlobalOperations"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [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",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"mlsConversationReset" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False
                ]
          ],
      String
"consumableNotifications" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"chatBubbles" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"apps" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"simplifiedUserConnectionRequestQRCode" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
enabled,
      String
"stealthUsers" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked,
      String
"cellsInternal"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
            String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
            String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
            String
"config"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"backend" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://cells-beta.wire.com"],
                  String
"collabora" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"edition" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"COOL"],
                  String
"storage" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"teamQuotaBytes" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"1000000000000"]
                ]
          ],
      String
"meetings" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
enabled,
      String
"meetingsPremium" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
disabledLocked
    ]

hasExplicitLockStatus :: String -> Bool
hasExplicitLockStatus :: String -> Bool
hasExplicitLockStatus String
"fileSharing" = Bool
True
hasExplicitLockStatus String
"conferenceCalling" = Bool
True
hasExplicitLockStatus String
"selfDeletingMessages" = Bool
True
hasExplicitLockStatus String
"guestLinks" = Bool
True
hasExplicitLockStatus String
"sndFactorPasswordChallenge" = Bool
True
hasExplicitLockStatus String
"outlookCalIntegration" = Bool
True
hasExplicitLockStatus String
"enforceFileDownloadLocation" = Bool
True
hasExplicitLockStatus String
"domainRegistration" = Bool
True
hasExplicitLockStatus String
_ = Bool
False

checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App ()
checkFeature :: forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
feature user
user tid
tid Value
expected = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  domain <- objDomain user
  bindResponse (Internal.getTeamFeature domain tidStr feature) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected
  bindResponse (Public.getTeamFeatures user tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
feature App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected
  bindResponse (Public.getTeamFeature user tid feature) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected
  bindResponse (Public.getFeatureConfigs user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
feature App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected

assertForbidden :: (HasCallStack) => Response -> App ()
assertForbidden :: HasCallStack => Response -> App ()
assertForbidden = HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"no-team-member"

data ConfCalling = ConfCalling
  { ConfCalling -> Maybe String
lockStatus :: Maybe String,
    ConfCalling -> String
status :: String,
    ConfCalling -> Value
sft :: Value
  }

instance Default ConfCalling where
  def :: ConfCalling
def =
    ConfCalling
      { lockStatus :: Maybe String
lockStatus = Maybe String
forall a. Maybe a
Nothing,
        status :: String
status = String
"disabled",
        sft :: Value
sft = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
False
      }

confCalling :: ConfCalling -> Value
confCalling :: ConfCalling -> Value
confCalling ConfCalling
args =
  [Pair] -> Value
object
    ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
s | String
s <- Maybe String -> [String]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ConfCalling
args.lockStatus]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited"]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ConfCalling
args.status,
         String
"config"
           String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"useSFTForOneToOneCalls" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ConfCalling
args.sft]
       ]

setFlag :: (HasCallStack) => APIAccess -> WebSocket -> String -> String -> Value -> App ()
setFlag :: HasCallStack =>
APIAccess -> WebSocket -> String -> String -> Value -> App ()
setFlag APIAccess
access WebSocket
ws String
tid String
featureName Value
value = do
  update <- String -> Value -> App Value
forall a. (HasCallStack, MakesValue a) => String -> a -> App Value
removeField String
"ttl" Value
value
  void
    $ setFeature access ws.user tid featureName update
    >>= getJSON 200
  expected <-
    setField "ttl" "unlimited"
      =<< setField "lockStatus" "unlocked" value

  -- should receive an event
  do
    notif <- awaitMatch isFeatureConfigUpdateNotif ws
    notif %. "payload.0.name" `shouldMatch` featureName
    notif %. "payload.0.data" `shouldMatch` expected

  checkFeature featureName ws.user tid expected

checkPatchWithComputeExpected ::
  (HasCallStack, MakesValue domain) =>
  domain ->
  String ->
  Value ->
  (String -> Value -> Value -> App Value) ->
  App ()
checkPatchWithComputeExpected :: forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> String
-> Value
-> (String -> Value -> Value -> App Value)
-> App ()
checkPatchWithComputeExpected domain
domain String
featureName Value
patch String -> Value -> Value -> App Value
computeExpectedValue = do
  (owner, tid, _) <- domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam domain
domain Int
0
  defFeature <- defAllFeatures %. featureName

  checkFeature featureName owner tid defFeature
  void
    $ Internal.patchTeamFeature domain tid featureName patch
    >>= getJSON 200
  patched <- Internal.getTeamFeature domain tid featureName >>= getJSON 200
  checkFeature featureName owner tid patched
  lockStatus <- patched %. "lockStatus" >>= asString
  if lockStatus == "locked"
    then do
      -- if lock status is locked the feature status should fall back to the default
      patched `shouldMatch` (defFeature & setField "lockStatus" "locked")
      -- if lock status is locked, it was either locked before or changed by the patch
      mPatchedLockStatus <- lookupField patch "lockStatus"
      case mPatchedLockStatus of
        Just Value
ls -> Value
ls Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"locked"
        Maybe Value
Nothing -> Value
defFeature Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"lockStatus" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"locked"
    else do
      patched %. "status" `shouldMatch` computeExpectedValue "status" defFeature patch
      mPatchedConfig <- lookupField patched "config"
      case mPatchedConfig of
        Just Value
patchedConfig -> Value
patchedConfig Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> Value -> Value -> App Value
computeExpectedValue String
"config" Value
defFeature Value
patch
        Maybe Value
Nothing -> do
          mDefConfig <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
defFeature String
"config"
          assertBool "patch had an unexpected config field" (isNothing mDefConfig)

      when (hasExplicitLockStatus featureName) $ do
        -- if lock status is unlocked, it was either unlocked before or changed
        -- by the patch
        mPatchedLockStatus <- lookupField patch "lockStatus"
        case mPatchedLockStatus of
          Just Value
ls -> Value
ls Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"unlocked"
          Maybe Value
Nothing -> Value
defFeature Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"lockStatus" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"unlocked"

checkPatch ::
  (HasCallStack, MakesValue domain) =>
  domain ->
  String ->
  Value ->
  App ()
checkPatch :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App ()
checkPatch domain
domain String
featureName Value
patch = domain
-> String
-> Value
-> (String -> Value -> Value -> App Value)
-> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> String
-> Value
-> (String -> Value -> Value -> App Value)
-> App ()
checkPatchWithComputeExpected domain
domain String
featureName Value
patch String -> Value -> Value -> App Value
forall {a} {a}.
(MakesValue a, MakesValue a) =>
String -> a -> a -> App Value
computeExpectedValue
  where
    computeExpectedValue :: String -> a -> a -> App Value
computeExpectedValue String
key a
defFeature a
p = do
      mValue <- a -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField a
p String
key
      maybe (defFeature %. key) pure mValue

data FeatureTests = FeatureTests
  { FeatureTests -> String
name :: String,
    -- | valid config values used to update the feature setting (should not
    -- include the lock status and ttl, as these are not part of the request
    -- payload)
    FeatureTests -> [Value]
updates :: [Value],
    FeatureTests -> [Value]
invalidUpdates :: [Value],
    FeatureTests -> Maybe Value
owner :: Maybe Value
  }

mkFeatureTests :: String -> FeatureTests
mkFeatureTests :: String -> FeatureTests
mkFeatureTests String
name = String -> [Value] -> [Value] -> Maybe Value -> FeatureTests
FeatureTests String
name [] [] Maybe Value
forall a. Maybe a
Nothing

addUpdate :: Value -> FeatureTests -> FeatureTests
addUpdate :: Value -> FeatureTests -> FeatureTests
addUpdate Value
up FeatureTests
ft = FeatureTests
ft {updates = ft.updates <> [up]}

addInvalidUpdate :: Value -> FeatureTests -> FeatureTests
addInvalidUpdate :: Value -> FeatureTests -> FeatureTests
addInvalidUpdate Value
up FeatureTests
ft = FeatureTests
ft {invalidUpdates = ft.invalidUpdates <> [up]}

setOwner :: (MakesValue user) => user -> FeatureTests -> App FeatureTests
setOwner :: forall user.
MakesValue user =>
user -> FeatureTests -> App FeatureTests
setOwner user
owner FeatureTests
ft = do
  x <- user -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make user
owner
  pure ft {owner = Just x}

runFeatureTests ::
  (HasCallStack, MakesValue domain) =>
  domain ->
  APIAccess ->
  FeatureTests ->
  App ()
runFeatureTests :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> APIAccess -> FeatureTests -> App ()
runFeatureTests domain
domain APIAccess
access FeatureTests
ft = do
  defFeature <- Value
defAllFeatures Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. FeatureTests
ft.name
  -- personal user
  do
    user <- randomUser domain def
    bindResponse (Public.getFeatureConfigs user) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      feat <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. FeatureTests
ft.name
      lockStatus <- feat %. "lockStatus"
      expected <- setField "lockStatus" lockStatus defFeature
      feat `shouldMatch` expected

  -- make team
  (owner, tid) <- case ft.owner of
    Maybe Value
Nothing -> do
      (owner, tid, _) <- domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam domain
domain Int
0
      pure (owner, tid)
    Just Value
owner -> do
      tid <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      pure (owner, tid)
  checkFeature ft.name owner tid defFeature

  -- lock the feature
  Internal.setTeamFeatureLockStatus owner tid ft.name "locked"
  bindResponse (Public.getTeamFeature owner tid ft.name) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"lockStatus" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"locked"
    expected <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"lockStatus" String
"locked" Value
defFeature
    checkFeature ft.name owner tid expected

  for_ ft.updates $ (setFeature access owner tid ft.name >=> getJSON 409)

  -- unlock the feature
  Internal.setTeamFeatureLockStatus owner tid ft.name "unlocked"
  void $ withWebSocket owner $ \WebSocket
ws -> do
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ FeatureTests
ft.updates ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
update -> do
      HasCallStack =>
APIAccess -> WebSocket -> String -> String -> Value -> App ()
APIAccess -> WebSocket -> String -> String -> Value -> App ()
setFlag APIAccess
access WebSocket
ws String
tid FeatureTests
ft.name Value
update

    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ FeatureTests
ft.invalidUpdates ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
update -> do
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ APIAccess -> Value -> String -> String -> Value -> App Response
setFeature APIAccess
access Value
owner String
tid FeatureTests
ft.name Value
update App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
400
      HasCallStack => Int -> WebSocket -> App ()
Int -> WebSocket -> App ()
assertNoEvent Int
2 WebSocket
ws

  -- lock again, should be set to default value
  Internal.setTeamFeatureLockStatus owner tid ft.name "locked"
  do
    expected <- setField "lockStatus" "locked" defFeature
    checkFeature ft.name owner tid expected

  -- unlock again, should be set to the last update
  Internal.setTeamFeatureLockStatus owner tid ft.name "unlocked"
  for_ (take 1 (reverse ft.updates)) $ \Value
update -> do
    expected <-
      String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"ttl" String
"unlimited"
        (Value -> App Value) -> App Value -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"lockStatus" String
"unlocked" Value
update
    checkFeature ft.name owner tid expected