-- 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
      Key
feat <- Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
obj
      let A.String Text
nameT = Key -> Value
forall a. ToJSON a => a -> Value
toJSON Key
feat
          name :: String
name = Text -> String
Text.unpack Text
nameT
      TestCase Feature -> [TestCase Feature]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestCase Feature -> [TestCase Feature])
-> TestCase Feature -> [TestCase Feature]
forall a b. (a -> b) -> a -> b
$ String -> Feature -> TestCase Feature
forall a. String -> a -> TestCase a
MkTestCase (String
"[feature=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") (String -> Feature
Feature String
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
    ]

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
"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
    ]

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
_ = 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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  String
domain <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain user
user
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
Internal.getTeamFeature String
domain String
tidStr String
feature) ((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
    Response
resp.json App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (user -> tid -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
Public.getTeamFeatures user
user tid
tid) ((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
    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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (user -> tid -> String -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> String -> App Response
Public.getTeamFeature user
user tid
tid String
feature) ((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
    Response
resp.json App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (user -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
Public.getFeatureConfigs user
user) ((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
    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
      { $sel:lockStatus:ConfCalling :: Maybe String
lockStatus = Maybe String
forall a. Maybe a
Nothing,
        $sel:status:ConfCalling :: String
status = String
"disabled",
        $sel:sft:ConfCalling :: 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
  Value
update <- String -> Value -> App Value
forall a. (HasCallStack, MakesValue a) => String -> a -> App Value
removeField String
"ttl" Value
value
  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 WebSocket
ws.user String
tid String
featureName 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
200
  Value
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
value

  -- should receive an event
  do
    Value
notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isFeatureConfigUpdateNotif WebSocket
ws
    Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
featureName
    Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected

  String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
featureName WebSocket
ws.user String
tid Value
expected

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 = 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
domain Int
0
  Value
defFeature <- Value
defAllFeatures Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
featureName

  let valueOrDefault :: String -> App Value
      valueOrDefault :: String -> App Value
valueOrDefault String
key = do
        Maybe Value
mValue <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
patch String
key
        App Value -> (Value -> App Value) -> Maybe Value -> App Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value
defFeature Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
key) Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
mValue

  String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
featureName Value
owner String
tid Value
defFeature
  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
$ domain -> String -> String -> Value -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> Value -> App Response
Internal.patchTeamFeature domain
domain String
tid String
featureName Value
patch
    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
200
  Value
patched <- domain -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
Internal.getTeamFeature domain
domain String
tid String
featureName 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
200
  String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
featureName Value
owner String
tid Value
patched
  String
lockStatus <- Value
patched Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"lockStatus" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  if String
lockStatus String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"locked"
    then do
      -- if lock status is locked the feature status should fall back to the default
      Value
patched Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
defFeature 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
"locked")
      -- if lock status is locked, it was either locked before or changed by the patch
      Maybe Value
mPatchedLockStatus <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
patch String
"lockStatus"
      case Maybe Value
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
      Value
patched Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> App Value
valueOrDefault String
"status"
      Maybe Value
mPatchedConfig <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
patched String
"config"
      case Maybe Value
mPatchedConfig of
        Just Value
patchedConfig -> Value
patchedConfig Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> App Value
valueOrDefault String
"config"
        Maybe Value
Nothing -> do
          Maybe Value
mDefConfig <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
defFeature String
"config"
          HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"patch had an unexpected config field" (Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Value
mDefConfig)

      Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
hasExplicitLockStatus String
featureName) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
        -- if lock status is unlocked, it was either unlocked before or changed
        -- by the patch
        Maybe Value
mPatchedLockStatus <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
patch String
"lockStatus"
        case Maybe Value
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"

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
  Value
x <- user -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make user
owner
  FeatureTests -> App FeatureTests
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureTests
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
  Value
defFeature <- Value
defAllFeatures Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. FeatureTests
ft.name
  -- personal user
  do
    Value
user <- domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain
domain CreateUser
forall a. Default a => a
def
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
Public.getFeatureConfigs Value
user) ((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
      Value
feat <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. FeatureTests
ft.name
      Value
lockStatus <- Value
feat Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"lockStatus"
      Value
expected <- String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"lockStatus" Value
lockStatus Value
defFeature
      Value
feat Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expected

  -- make team
  (Value
owner, String
tid) <- case FeatureTests
ft.owner of
    Maybe Value
Nothing -> 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
domain Int
0
      (Value, String) -> App (Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
owner, String
tid)
    Just Value
owner -> do
      String
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
      (Value, String) -> App (Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
owner, String
tid)
  String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature FeatureTests
ft.name Value
owner String
tid Value
defFeature

  -- lock the feature
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
Internal.setTeamFeatureLockStatus Value
owner String
tid FeatureTests
ft.name String
"locked"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> String -> App Response
Public.getTeamFeature Value
owner String
tid FeatureTests
ft.name) ((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
    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"
    Value
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
    String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature FeatureTests
ft.name Value
owner String
tid Value
expected

  [Value] -> (Value -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ FeatureTests
ft.updates ((Value -> App Value) -> App ()) -> (Value -> 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 -> App Response)
-> (Response -> App Value) -> Value -> App Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
409)

  -- unlock the feature
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
Internal.setTeamFeatureLockStatus Value
owner String
tid FeatureTests
ft.name String
"unlocked"
  App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
owner ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
Internal.setTeamFeatureLockStatus Value
owner String
tid FeatureTests
ft.name String
"locked"
  do
    Value
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
    String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature FeatureTests
ft.name Value
owner String
tid Value
expected

  -- unlock again, should be set to the last update
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
Internal.setTeamFeatureLockStatus Value
owner String
tid FeatureTests
ft.name String
"unlocked"
  [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
take Int
1 ([Value] -> [Value]
forall a. [a] -> [a]
reverse FeatureTests
ft.updates)) ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
update -> do
    Value
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
    String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature FeatureTests
ft.name Value
owner String
tid Value
expected