{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- | State transition machine DSL for running various operations on spar and maintaining
-- internal invariants.  At the time of writing this, supported operations on wire teams are:
-- add scim peer, remove scim peer, add saml idp.
--
-- See the test cases why all the abstractions and boilerplates may be worth it already, but
-- since the DSL embedding is deep, it is also straight-forward to generate random "programs"
-- and thus get property-based integration tests!
module Test.Spar.STM (testCreateIdpsAndScimsV7) where

import API.Common (defPassword)
import API.GalleyInternal (setTeamFeatureStatus)
import API.Nginz (login)
import API.Spar
import qualified Data.Map as Map
import qualified SAML2.WebSSO as SAML
import SetupHelpers
import Test.Spar
import Testlib.JSON
import Testlib.Prelude
import qualified Text.XML.DSig as SAML

-- | This is a bit silly, but it allows us to write more straight-forward code and still get
-- better error messages than "something went wrong in your code, please try again".
(!) :: (HasCallStack, Ord k, Show k, Show a) => Map k a -> k -> a
Map k a
m ! :: forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
! k
k = case Map k a
m Map k a -> k -> Maybe a
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? k
k of
  Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"(!) failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Map k a, k) -> String
forall a. Show a => a -> String
show (Map k a
m, k
k)
  Just a
a -> a
a

infixl 9 !

-- | Create a few saml IdPs and a few scim peers.  Randomize the order in which they are
-- created, and which peers / IdPs they are associated with.
testCreateIdpsAndScimsV7 :: (HasCallStack) => App ()
testCreateIdpsAndScimsV7 :: HasCallStack => App ()
testCreateIdpsAndScimsV7 = do
  HasCallStack => [Step] -> App ()
[Step] -> App ()
runSteps
    [ SamlRef -> ExpectedResult -> Step
MkSaml (String -> SamlRef
SamlRef String
"saml1") ExpectedResult
ExpectSuccess
    ]

  HasCallStack => [Step] -> App ()
[Step] -> App ()
runSteps
    [ -- create a single, unassociated scim.
      ScimRef -> Maybe SamlRef -> ExpectedResult -> Step
MkScim (String -> ScimRef
ScimRef String
"scim1") Maybe SamlRef
forall a. Maybe a
Nothing ExpectedResult
ExpectSuccess,
      -- create a single, unassociated saml idp.
      SamlRef -> ExpectedResult -> Step
MkSaml (String -> SamlRef
SamlRef String
"saml1") ExpectedResult
ExpectSuccess,
      -- new in V7: if there is a saml idp but not referenced in request, do not connect.
      ScimRef -> Maybe SamlRef -> ExpectedResult -> Step
MkScim (String -> ScimRef
ScimRef String
"scim1-solo") Maybe SamlRef
forall a. Maybe a
Nothing ExpectedResult
ExpectSuccess,
      -- 2 idps with scim is ok now.
      SamlRef -> ExpectedResult -> Step
MkSaml (String -> SamlRef
SamlRef String
"saml2") ExpectedResult
ExpectSuccess,
      -- two scims can be associated with one idp
      ScimRef -> Maybe SamlRef -> ExpectedResult -> Step
MkScim (String -> ScimRef
ScimRef String
"scim2") (SamlRef -> Maybe SamlRef
forall a. a -> Maybe a
Just (String -> SamlRef
SamlRef String
"saml1")) ExpectedResult
ExpectSuccess,
      ScimRef -> Maybe SamlRef -> ExpectedResult -> Step
MkScim (String -> ScimRef
ScimRef String
"scim3") (SamlRef -> Maybe SamlRef
forall a. a -> Maybe a
Just (String -> SamlRef
SamlRef String
"saml1")) ExpectedResult
ExpectSuccess
    ]

  -- two saml idps cannot associate with the same scim peer: it would be unclear which idp the
  -- next user is supposed to be provisioned for.  (not need to test, because it cannot be
  -- expressed in the API.)  but two scim can connect to the same saml:
  HasCallStack => [Step] -> App ()
[Step] -> App ()
runSteps
    [ SamlRef -> ExpectedResult -> Step
MkSaml (String -> SamlRef
SamlRef String
"saml1") ExpectedResult
ExpectSuccess,
      ScimRef -> Maybe SamlRef -> ExpectedResult -> Step
MkScim (String -> ScimRef
ScimRef String
"scim1") (SamlRef -> Maybe SamlRef
forall a. a -> Maybe a
Just (String -> SamlRef
SamlRef String
"saml1")) ExpectedResult
ExpectSuccess,
      ScimRef -> Step
RmScim (String -> ScimRef
ScimRef String
"scim1"),
      ScimRef -> Maybe SamlRef -> ExpectedResult -> Step
MkScim (String -> ScimRef
ScimRef String
"scim2") (SamlRef -> Maybe SamlRef
forall a. a -> Maybe a
Just (String -> SamlRef
SamlRef String
"saml1")) ExpectedResult
ExpectSuccess
    ]

-- | DSL with relevant api calls (not test cases).  This should make writing down different
-- test cases very concise and not cost any generality.
data Step
  = MkScim ScimRef (Maybe SamlRef) ExpectedResult
  | -- | `RmScim` has expected result: delete is idempotent.
    RmScim ScimRef
  | -- | you can't associate a saml idp with a existing scim peer when creating the idp.
    -- do that by replacing the scim token and associating the new one during creation.
    MkSaml SamlRef ExpectedResult
  deriving (Int -> Step -> String -> String
[Step] -> String -> String
Step -> String
(Int -> Step -> String -> String)
-> (Step -> String) -> ([Step] -> String -> String) -> Show Step
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Step -> String -> String
showsPrec :: Int -> Step -> String -> String
$cshow :: Step -> String
show :: Step -> String
$cshowList :: [Step] -> String -> String
showList :: [Step] -> String -> String
Show)

data ExpectedResult = ExpectSuccess | ExpectFailure Int String
  deriving (ExpectedResult -> ExpectedResult -> Bool
(ExpectedResult -> ExpectedResult -> Bool)
-> (ExpectedResult -> ExpectedResult -> Bool) -> Eq ExpectedResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpectedResult -> ExpectedResult -> Bool
== :: ExpectedResult -> ExpectedResult -> Bool
$c/= :: ExpectedResult -> ExpectedResult -> Bool
/= :: ExpectedResult -> ExpectedResult -> Bool
Eq, Int -> ExpectedResult -> String -> String
[ExpectedResult] -> String -> String
ExpectedResult -> String
(Int -> ExpectedResult -> String -> String)
-> (ExpectedResult -> String)
-> ([ExpectedResult] -> String -> String)
-> Show ExpectedResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ExpectedResult -> String -> String
showsPrec :: Int -> ExpectedResult -> String -> String
$cshow :: ExpectedResult -> String
show :: ExpectedResult -> String
$cshowList :: [ExpectedResult] -> String -> String
showList :: [ExpectedResult] -> String -> String
Show, (forall x. ExpectedResult -> Rep ExpectedResult x)
-> (forall x. Rep ExpectedResult x -> ExpectedResult)
-> Generic ExpectedResult
forall x. Rep ExpectedResult x -> ExpectedResult
forall x. ExpectedResult -> Rep ExpectedResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpectedResult -> Rep ExpectedResult x
from :: forall x. ExpectedResult -> Rep ExpectedResult x
$cto :: forall x. Rep ExpectedResult x -> ExpectedResult
to :: forall x. Rep ExpectedResult x -> ExpectedResult
Generic)

data State = State
  { State -> Map SamlRef SamlId
allIdps :: Map SamlRef SamlId,
    State -> Map SamlId (IdPMetadata, SignPrivCreds)
allIdpCredsById :: Map SamlId (SAML.IdPMetadata, SAML.SignPrivCreds),
    State -> Map ScimRef (ScimId, ScimToken)
allScims :: Map ScimRef (ScimId, ScimToken),
    State -> Map ScimId SamlId
allScimAssocs :: Map ScimId SamlId
  }
  deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State -> State -> Bool
== :: State -> State -> Bool
$c/= :: State -> State -> Bool
/= :: State -> State -> Bool
Eq, Int -> State -> String -> String
[State] -> String -> String
State -> String
(Int -> State -> String -> String)
-> (State -> String) -> ([State] -> String -> String) -> Show State
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> State -> String -> String
showsPrec :: Int -> State -> String -> String
$cshow :: State -> String
show :: State -> String
$cshowList :: [State] -> String -> String
showList :: [State] -> String -> String
Show)

emptyState :: State
emptyState :: State
emptyState = Map SamlRef SamlId
-> Map SamlId (IdPMetadata, SignPrivCreds)
-> Map ScimRef (ScimId, ScimToken)
-> Map ScimId SamlId
-> State
State Map SamlRef SamlId
forall a. Monoid a => a
mempty Map SamlId (IdPMetadata, SignPrivCreds)
forall a. Monoid a => a
mempty Map ScimRef (ScimId, ScimToken)
forall a. Monoid a => a
mempty Map ScimId SamlId
forall a. Monoid a => a
mempty

-- (SamlName)
newtype SamlRef = SamlRef {SamlRef -> String
_unSamlRef :: String}
  deriving newtype (SamlRef -> SamlRef -> Bool
(SamlRef -> SamlRef -> Bool)
-> (SamlRef -> SamlRef -> Bool) -> Eq SamlRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SamlRef -> SamlRef -> Bool
== :: SamlRef -> SamlRef -> Bool
$c/= :: SamlRef -> SamlRef -> Bool
/= :: SamlRef -> SamlRef -> Bool
Eq, Int -> SamlRef -> String -> String
[SamlRef] -> String -> String
SamlRef -> String
(Int -> SamlRef -> String -> String)
-> (SamlRef -> String)
-> ([SamlRef] -> String -> String)
-> Show SamlRef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SamlRef -> String -> String
showsPrec :: Int -> SamlRef -> String -> String
$cshow :: SamlRef -> String
show :: SamlRef -> String
$cshowList :: [SamlRef] -> String -> String
showList :: [SamlRef] -> String -> String
Show, Eq SamlRef
Eq SamlRef =>
(SamlRef -> SamlRef -> Ordering)
-> (SamlRef -> SamlRef -> Bool)
-> (SamlRef -> SamlRef -> Bool)
-> (SamlRef -> SamlRef -> Bool)
-> (SamlRef -> SamlRef -> Bool)
-> (SamlRef -> SamlRef -> SamlRef)
-> (SamlRef -> SamlRef -> SamlRef)
-> Ord SamlRef
SamlRef -> SamlRef -> Bool
SamlRef -> SamlRef -> Ordering
SamlRef -> SamlRef -> SamlRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SamlRef -> SamlRef -> Ordering
compare :: SamlRef -> SamlRef -> Ordering
$c< :: SamlRef -> SamlRef -> Bool
< :: SamlRef -> SamlRef -> Bool
$c<= :: SamlRef -> SamlRef -> Bool
<= :: SamlRef -> SamlRef -> Bool
$c> :: SamlRef -> SamlRef -> Bool
> :: SamlRef -> SamlRef -> Bool
$c>= :: SamlRef -> SamlRef -> Bool
>= :: SamlRef -> SamlRef -> Bool
$cmax :: SamlRef -> SamlRef -> SamlRef
max :: SamlRef -> SamlRef -> SamlRef
$cmin :: SamlRef -> SamlRef -> SamlRef
min :: SamlRef -> SamlRef -> SamlRef
Ord, [SamlRef] -> Value
[SamlRef] -> Encoding
SamlRef -> Value
SamlRef -> Encoding
(SamlRef -> Value)
-> (SamlRef -> Encoding)
-> ([SamlRef] -> Value)
-> ([SamlRef] -> Encoding)
-> ToJSON SamlRef
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SamlRef -> Value
toJSON :: SamlRef -> Value
$ctoEncoding :: SamlRef -> Encoding
toEncoding :: SamlRef -> Encoding
$ctoJSONList :: [SamlRef] -> Value
toJSONList :: [SamlRef] -> Value
$ctoEncodingList :: [SamlRef] -> Encoding
toEncodingList :: [SamlRef] -> Encoding
ToJSON)

-- (ScimName)
newtype ScimRef = ScimRef {ScimRef -> String
unScimRef :: String}
  deriving newtype (ScimRef -> ScimRef -> Bool
(ScimRef -> ScimRef -> Bool)
-> (ScimRef -> ScimRef -> Bool) -> Eq ScimRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimRef -> ScimRef -> Bool
== :: ScimRef -> ScimRef -> Bool
$c/= :: ScimRef -> ScimRef -> Bool
/= :: ScimRef -> ScimRef -> Bool
Eq, Int -> ScimRef -> String -> String
[ScimRef] -> String -> String
ScimRef -> String
(Int -> ScimRef -> String -> String)
-> (ScimRef -> String)
-> ([ScimRef] -> String -> String)
-> Show ScimRef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ScimRef -> String -> String
showsPrec :: Int -> ScimRef -> String -> String
$cshow :: ScimRef -> String
show :: ScimRef -> String
$cshowList :: [ScimRef] -> String -> String
showList :: [ScimRef] -> String -> String
Show, Eq ScimRef
Eq ScimRef =>
(ScimRef -> ScimRef -> Ordering)
-> (ScimRef -> ScimRef -> Bool)
-> (ScimRef -> ScimRef -> Bool)
-> (ScimRef -> ScimRef -> Bool)
-> (ScimRef -> ScimRef -> Bool)
-> (ScimRef -> ScimRef -> ScimRef)
-> (ScimRef -> ScimRef -> ScimRef)
-> Ord ScimRef
ScimRef -> ScimRef -> Bool
ScimRef -> ScimRef -> Ordering
ScimRef -> ScimRef -> ScimRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScimRef -> ScimRef -> Ordering
compare :: ScimRef -> ScimRef -> Ordering
$c< :: ScimRef -> ScimRef -> Bool
< :: ScimRef -> ScimRef -> Bool
$c<= :: ScimRef -> ScimRef -> Bool
<= :: ScimRef -> ScimRef -> Bool
$c> :: ScimRef -> ScimRef -> Bool
> :: ScimRef -> ScimRef -> Bool
$c>= :: ScimRef -> ScimRef -> Bool
>= :: ScimRef -> ScimRef -> Bool
$cmax :: ScimRef -> ScimRef -> ScimRef
max :: ScimRef -> ScimRef -> ScimRef
$cmin :: ScimRef -> ScimRef -> ScimRef
min :: ScimRef -> ScimRef -> ScimRef
Ord, [ScimRef] -> Value
[ScimRef] -> Encoding
ScimRef -> Value
ScimRef -> Encoding
(ScimRef -> Value)
-> (ScimRef -> Encoding)
-> ([ScimRef] -> Value)
-> ([ScimRef] -> Encoding)
-> ToJSON ScimRef
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ScimRef -> Value
toJSON :: ScimRef -> Value
$ctoEncoding :: ScimRef -> Encoding
toEncoding :: ScimRef -> Encoding
$ctoJSONList :: [ScimRef] -> Value
toJSONList :: [ScimRef] -> Value
$ctoEncodingList :: [ScimRef] -> Encoding
toEncodingList :: [ScimRef] -> Encoding
ToJSON)

-- (UUID)
newtype SamlId = SamlId {SamlId -> String
unSamlId :: String}
  deriving newtype (SamlId -> SamlId -> Bool
(SamlId -> SamlId -> Bool)
-> (SamlId -> SamlId -> Bool) -> Eq SamlId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SamlId -> SamlId -> Bool
== :: SamlId -> SamlId -> Bool
$c/= :: SamlId -> SamlId -> Bool
/= :: SamlId -> SamlId -> Bool
Eq, Int -> SamlId -> String -> String
[SamlId] -> String -> String
SamlId -> String
(Int -> SamlId -> String -> String)
-> (SamlId -> String)
-> ([SamlId] -> String -> String)
-> Show SamlId
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SamlId -> String -> String
showsPrec :: Int -> SamlId -> String -> String
$cshow :: SamlId -> String
show :: SamlId -> String
$cshowList :: [SamlId] -> String -> String
showList :: [SamlId] -> String -> String
Show, Eq SamlId
Eq SamlId =>
(SamlId -> SamlId -> Ordering)
-> (SamlId -> SamlId -> Bool)
-> (SamlId -> SamlId -> Bool)
-> (SamlId -> SamlId -> Bool)
-> (SamlId -> SamlId -> Bool)
-> (SamlId -> SamlId -> SamlId)
-> (SamlId -> SamlId -> SamlId)
-> Ord SamlId
SamlId -> SamlId -> Bool
SamlId -> SamlId -> Ordering
SamlId -> SamlId -> SamlId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SamlId -> SamlId -> Ordering
compare :: SamlId -> SamlId -> Ordering
$c< :: SamlId -> SamlId -> Bool
< :: SamlId -> SamlId -> Bool
$c<= :: SamlId -> SamlId -> Bool
<= :: SamlId -> SamlId -> Bool
$c> :: SamlId -> SamlId -> Bool
> :: SamlId -> SamlId -> Bool
$c>= :: SamlId -> SamlId -> Bool
>= :: SamlId -> SamlId -> Bool
$cmax :: SamlId -> SamlId -> SamlId
max :: SamlId -> SamlId -> SamlId
$cmin :: SamlId -> SamlId -> SamlId
min :: SamlId -> SamlId -> SamlId
Ord, [SamlId] -> Value
[SamlId] -> Encoding
SamlId -> Value
SamlId -> Encoding
(SamlId -> Value)
-> (SamlId -> Encoding)
-> ([SamlId] -> Value)
-> ([SamlId] -> Encoding)
-> ToJSON SamlId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SamlId -> Value
toJSON :: SamlId -> Value
$ctoEncoding :: SamlId -> Encoding
toEncoding :: SamlId -> Encoding
$ctoJSONList :: [SamlId] -> Value
toJSONList :: [SamlId] -> Value
$ctoEncodingList :: [SamlId] -> Encoding
toEncodingList :: [SamlId] -> Encoding
ToJSON)

-- (UUID)
newtype ScimId = ScimId {ScimId -> String
unScimId :: String}
  deriving newtype (ScimId -> ScimId -> Bool
(ScimId -> ScimId -> Bool)
-> (ScimId -> ScimId -> Bool) -> Eq ScimId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimId -> ScimId -> Bool
== :: ScimId -> ScimId -> Bool
$c/= :: ScimId -> ScimId -> Bool
/= :: ScimId -> ScimId -> Bool
Eq, Int -> ScimId -> String -> String
[ScimId] -> String -> String
ScimId -> String
(Int -> ScimId -> String -> String)
-> (ScimId -> String)
-> ([ScimId] -> String -> String)
-> Show ScimId
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ScimId -> String -> String
showsPrec :: Int -> ScimId -> String -> String
$cshow :: ScimId -> String
show :: ScimId -> String
$cshowList :: [ScimId] -> String -> String
showList :: [ScimId] -> String -> String
Show, Eq ScimId
Eq ScimId =>
(ScimId -> ScimId -> Ordering)
-> (ScimId -> ScimId -> Bool)
-> (ScimId -> ScimId -> Bool)
-> (ScimId -> ScimId -> Bool)
-> (ScimId -> ScimId -> Bool)
-> (ScimId -> ScimId -> ScimId)
-> (ScimId -> ScimId -> ScimId)
-> Ord ScimId
ScimId -> ScimId -> Bool
ScimId -> ScimId -> Ordering
ScimId -> ScimId -> ScimId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScimId -> ScimId -> Ordering
compare :: ScimId -> ScimId -> Ordering
$c< :: ScimId -> ScimId -> Bool
< :: ScimId -> ScimId -> Bool
$c<= :: ScimId -> ScimId -> Bool
<= :: ScimId -> ScimId -> Bool
$c> :: ScimId -> ScimId -> Bool
> :: ScimId -> ScimId -> Bool
$c>= :: ScimId -> ScimId -> Bool
>= :: ScimId -> ScimId -> Bool
$cmax :: ScimId -> ScimId -> ScimId
max :: ScimId -> ScimId -> ScimId
$cmin :: ScimId -> ScimId -> ScimId
min :: ScimId -> ScimId -> ScimId
Ord, [ScimId] -> Value
[ScimId] -> Encoding
ScimId -> Value
ScimId -> Encoding
(ScimId -> Value)
-> (ScimId -> Encoding)
-> ([ScimId] -> Value)
-> ([ScimId] -> Encoding)
-> ToJSON ScimId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ScimId -> Value
toJSON :: ScimId -> Value
$ctoEncoding :: ScimId -> Encoding
toEncoding :: ScimId -> Encoding
$ctoJSONList :: [ScimId] -> Value
toJSONList :: [ScimId] -> Value
$ctoEncodingList :: [ScimId] -> Encoding
toEncodingList :: [ScimId] -> Encoding
ToJSON, ToJSONKeyFunction [ScimId]
ToJSONKeyFunction ScimId
ToJSONKeyFunction ScimId
-> ToJSONKeyFunction [ScimId] -> ToJSONKey ScimId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ScimId
toJSONKey :: ToJSONKeyFunction ScimId
$ctoJSONKeyList :: ToJSONKeyFunction [ScimId]
toJSONKeyList :: ToJSONKeyFunction [ScimId]
ToJSONKey)

-- (for auth)
newtype ScimToken = ScimToken {ScimToken -> String
unScimToken :: String}
  deriving newtype (ScimToken -> ScimToken -> Bool
(ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool) -> Eq ScimToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimToken -> ScimToken -> Bool
== :: ScimToken -> ScimToken -> Bool
$c/= :: ScimToken -> ScimToken -> Bool
/= :: ScimToken -> ScimToken -> Bool
Eq, Int -> ScimToken -> String -> String
[ScimToken] -> String -> String
ScimToken -> String
(Int -> ScimToken -> String -> String)
-> (ScimToken -> String)
-> ([ScimToken] -> String -> String)
-> Show ScimToken
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ScimToken -> String -> String
showsPrec :: Int -> ScimToken -> String -> String
$cshow :: ScimToken -> String
show :: ScimToken -> String
$cshowList :: [ScimToken] -> String -> String
showList :: [ScimToken] -> String -> String
Show, Eq ScimToken
Eq ScimToken =>
(ScimToken -> ScimToken -> Ordering)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> ScimToken)
-> (ScimToken -> ScimToken -> ScimToken)
-> Ord ScimToken
ScimToken -> ScimToken -> Bool
ScimToken -> ScimToken -> Ordering
ScimToken -> ScimToken -> ScimToken
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScimToken -> ScimToken -> Ordering
compare :: ScimToken -> ScimToken -> Ordering
$c< :: ScimToken -> ScimToken -> Bool
< :: ScimToken -> ScimToken -> Bool
$c<= :: ScimToken -> ScimToken -> Bool
<= :: ScimToken -> ScimToken -> Bool
$c> :: ScimToken -> ScimToken -> Bool
> :: ScimToken -> ScimToken -> Bool
$c>= :: ScimToken -> ScimToken -> Bool
>= :: ScimToken -> ScimToken -> Bool
$cmax :: ScimToken -> ScimToken -> ScimToken
max :: ScimToken -> ScimToken -> ScimToken
$cmin :: ScimToken -> ScimToken -> ScimToken
min :: ScimToken -> ScimToken -> ScimToken
Ord, [ScimToken] -> Value
[ScimToken] -> Encoding
ScimToken -> Value
ScimToken -> Encoding
(ScimToken -> Value)
-> (ScimToken -> Encoding)
-> ([ScimToken] -> Value)
-> ([ScimToken] -> Encoding)
-> ToJSON ScimToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ScimToken -> Value
toJSON :: ScimToken -> Value
$ctoEncoding :: ScimToken -> Encoding
toEncoding :: ScimToken -> Encoding
$ctoJSONList :: [ScimToken] -> Value
toJSONList :: [ScimToken] -> Value
$ctoEncodingList :: [ScimToken] -> Encoding
toEncodingList :: [ScimToken] -> Encoding
ToJSON)

runSteps :: (HasCallStack) => [Step] -> App ()
runSteps :: HasCallStack => [Step] -> App ()
runSteps [Step]
steps = do
  (Value
owner, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  Value -> String -> State -> [Step] -> App ()
go Value
owner String
tid State
emptyState [Step]
steps
  where
    go :: Value -> String -> State -> [Step] -> App ()
    go :: Value -> String -> State -> [Step] -> App ()
go Value
_ String
_ State
_ [] = () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    -- add scim
    go Value
owner String
tid State
state (next :: Step
next@(MkScim ScimRef
scimRef Maybe SamlRef
mbSamlRef ExpectedResult
expected) : [Step]
steps') = String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (Step -> String
forall a. Show a => a -> String
show Step
next) do
      let mIdPId :: Maybe SamlId
mIdPId = (State
state.allIdps !) (SamlRef -> SamlId) -> Maybe SamlRef -> Maybe SamlId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SamlRef
mbSamlRef
      let p :: CreateScimToken
p = CreateScimToken
forall a. Default a => a
def {name = Just (unScimRef scimRef), idp = unSamlId <$> mIdPId}
      State
state' <- App Response -> (Response -> App State) -> App State
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner CreateScimToken
p) ((Response -> App State) -> App State)
-> (Response -> App State) -> App State
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        case ExpectedResult
expected of
          ExpectedResult
ExpectSuccess -> State -> ScimRef -> Maybe SamlId -> Response -> App State
validateScimRegistration State
state ScimRef
scimRef Maybe SamlId
mIdPId Response
resp
          ExpectFailure Int
errStatus String
errLabel -> Response -> Int -> String -> App ()
validateError Response
resp Int
errStatus String
errLabel App () -> State -> App State
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> State
state
      Value -> String -> State -> App ()
validateState Value
owner String
tid State
state'
      Value -> String -> State -> [Step] -> App ()
go Value
owner String
tid State
state' [Step]
steps'
    -- add saml
    go Value
owner String
tid State
state (next :: Step
next@(MkSaml SamlRef
samlRef ExpectedResult
expected) : [Step]
steps') = String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (Step -> String
forall a. Show a => a -> String
show Step
next) do
      State
state' <- do
        (Response
resp, (IdPMetadata, SignPrivCreds)
creds) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
        case ExpectedResult
expected of
          ExpectedResult
ExpectSuccess -> State
-> SamlRef -> Response -> (IdPMetadata, SignPrivCreds) -> App State
validateSamlRegistration State
state SamlRef
samlRef Response
resp (IdPMetadata, SignPrivCreds)
creds
          ExpectFailure Int
errStatus String
errLabel -> Response -> Int -> String -> App ()
validateError Response
resp Int
errStatus String
errLabel App () -> State -> App State
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> State
state
      Value -> String -> State -> App ()
validateState Value
owner String
tid State
state'
      Value -> String -> State -> [Step] -> App ()
go Value
owner String
tid State
state' [Step]
steps'
    -- remove scim
    go Value
owner String
tid State
state (next :: Step
next@(RmScim ScimRef
scimRef) : [Step]
steps') = String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (Step -> String
forall a. Show a => a -> String
show Step
next) do
      let (ScimId
scimId, ScimToken
_) = State
state.allScims Map ScimRef (ScimId, ScimToken) -> ScimRef -> (ScimId, ScimToken)
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
! ScimRef
scimRef
      State
state' <- App Response -> (Response -> App State) -> App State
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> App Response
deleteScimToken Value
owner (ScimId -> String
unScimId ScimId
scimId)) ((Response -> App State) -> App State)
-> (Response -> App State) -> App State
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
204
        State -> App State
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (State -> App State) -> State -> App State
forall a b. (a -> b) -> a -> b
$ State
state
            { allScims = Map.delete scimRef (allScims state),
              allScimAssocs = Map.delete scimId (allScimAssocs state)
            }
      Value -> String -> State -> App ()
validateState Value
owner String
tid State
state'
      Value -> String -> State -> [Step] -> App ()
go Value
owner String
tid State
state' [Step]
steps'

validateScimRegistration :: State -> ScimRef -> Maybe SamlId -> Response -> App State
validateScimRegistration :: State -> ScimRef -> Maybe SamlId -> Response -> App State
validateScimRegistration State
state ScimRef
scimRef Maybe SamlId
mIdPId Response
resp = do
  Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  String
scimId <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"info.id" 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
  String
tok <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" 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
  State -> App State
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (State -> App State) -> State -> App State
forall a b. (a -> b) -> a -> b
$ State
state
      { allScims = Map.insert scimRef (ScimId scimId, ScimToken tok) (allScims state),
        allScimAssocs = maybe id (Map.insert (ScimId scimId)) mIdPId $ allScimAssocs state
      }

validateSamlRegistration :: State -> SamlRef -> Response -> (SAML.IdPMetadata, SAML.SignPrivCreds) -> App State
validateSamlRegistration :: State
-> SamlRef -> Response -> (IdPMetadata, SignPrivCreds) -> App State
validateSamlRegistration State
state SamlRef
samlRef Response
resp (IdPMetadata, SignPrivCreds)
creds = do
  Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
  String
samlId <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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
  State -> App State
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (State -> App State) -> State -> App State
forall a b. (a -> b) -> a -> b
$ State
state
      { allIdps = Map.insert samlRef (SamlId samlId) state.allIdps,
        allIdpCredsById = Map.insert (SamlId samlId) creds state.allIdpCredsById
      }

validateState :: Value -> String -> State -> App ()
validateState :: Value -> String -> State -> App ()
validateState Value
owner String
tid State
state = do
  [Value]
allIdps <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getIdps Value
owner 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 App Value -> (Value -> 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
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"providers") App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
  [Value]
allScims <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getScimTokens Value
owner 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 App Value -> (Value -> 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
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"tokens") App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList

  State -> [Value] -> App ()
validateStateSyncTestAndProdIdps State
state [Value]
allIdps
  State -> [Value] -> App ()
validateStateSyncTestAndProdScims State
state [Value]
allScims
  State -> [Value] -> App ()
validateStateSyncTestAndProdAssocs State
state [Value]
allScims
  Value -> String -> State -> App ()
validateStateLoginAllUsers Value
owner String
tid State
state

-- | are all idps from spar in the local test state and vice versa?
validateStateSyncTestAndProdIdps :: State -> [Value] -> App ()
validateStateSyncTestAndProdIdps :: State -> [Value] -> App ()
validateStateSyncTestAndProdIdps State
state [Value]
allIdps = do
  let allLocal :: [SamlId]
allLocal = Map SamlRef SamlId -> [SamlId]
forall k a. Map k a -> [a]
Map.elems State
state.allIdps
  [String]
allSpar <- ((Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Value -> App Value)
-> (Value -> App String) -> Value -> App String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString) (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
`traverse` [Value]
allIdps
  [SamlId]
allLocal [SamlId] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String]
allSpar

-- | are all scim peers from spar in the local test state and vice versa?
validateStateSyncTestAndProdScims :: State -> [Value] -> App ()
validateStateSyncTestAndProdScims :: State -> [Value] -> App ()
validateStateSyncTestAndProdScims State
state [Value]
allScims = do
  let allLocal :: [ScimId]
allLocal = (ScimId, ScimToken) -> ScimId
forall a b. (a, b) -> a
fst ((ScimId, ScimToken) -> ScimId)
-> [(ScimId, ScimToken)] -> [ScimId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ScimRef (ScimId, ScimToken) -> [(ScimId, ScimToken)]
forall k a. Map k a -> [a]
Map.elems State
state.allScims
  [Value]
allSpar <- (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
`traverse` [Value]
allScims
  [ScimId]
allLocal [ScimId] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value]
allSpar

-- | are all local associations the same as on spar?
validateStateSyncTestAndProdAssocs :: State -> [Value] -> App ()
validateStateSyncTestAndProdAssocs :: State -> [Value] -> App ()
validateStateSyncTestAndProdAssocs State
state [Value]
allScims = do
  let toScimIdpPair :: a -> App (Maybe (String, String))
toScimIdpPair a
tokInfo = do
        Maybe Value
mIdp <- a -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField a
tokInfo String
"idp"
        case Maybe Value
mIdp of
          Just Value
idp -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> Maybe (String, String))
-> App (String, String) -> App (Maybe (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (String -> String -> (String, String))
-> App String -> App (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
tokInfo a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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) App (String -> (String, String))
-> App String -> App (String, String)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Value
idp)
          Maybe Value
Nothing -> Maybe (String, String) -> App (Maybe (String, String))
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (String, String)
forall a. Maybe a
Nothing

  Map String String
sparState <- [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, String)] -> Map String String)
-> ([Maybe (String, String)] -> [(String, String)])
-> [Maybe (String, String)]
-> Map String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (String, String)] -> [(String, String)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (String, String)] -> Map String String)
-> App [Maybe (String, String)] -> App (Map String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> App (Maybe (String, String))
forall {a}. MakesValue a => a -> App (Maybe (String, String))
toScimIdpPair (Value -> App (Maybe (String, String)))
-> [Value] -> App [Maybe (String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [Value]
allScims)
  Map String String
sparState Map String String -> Map ScimId SamlId -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` State
state.allScimAssocs

-- | login.  (auto-provisioning with saml without scim is intentionally not tested.)
-- (performance: only login users that have just been created, so that throughout a `[Step]`,
-- every user is only logged in once.)
validateStateLoginAllUsers :: Value -> String -> State -> App ()
validateStateLoginAllUsers :: Value -> String -> State -> App ()
validateStateLoginAllUsers Value
owner String
tid State
state = do
  [(ScimId, ScimToken)] -> ((ScimId, ScimToken) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map ScimRef (ScimId, ScimToken) -> [(ScimId, ScimToken)]
forall k a. Map k a -> [a]
Map.elems State
state.allScims) (((ScimId, ScimToken) -> App ()) -> App ())
-> ((ScimId, ScimToken) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(ScimId
scimId, ScimToken
tok) -> do
    let mIdp :: Maybe (String {- id -}, (SAML.IdPMetadata, SAML.SignPrivCreds))
        mIdp :: Maybe (String, (IdPMetadata, SignPrivCreds))
mIdp = do
          SamlId
i <- ScimId -> Map ScimId SamlId -> Maybe SamlId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScimId
scimId State
state.allScimAssocs
          (IdPMetadata, SignPrivCreds)
c <- SamlId
-> Map SamlId (IdPMetadata, SignPrivCreds)
-> Maybe (IdPMetadata, SignPrivCreds)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SamlId
i State
state.allIdpCredsById
          (String, (IdPMetadata, SignPrivCreds))
-> Maybe (String, (IdPMetadata, SignPrivCreds))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SamlId -> String
unSamlId SamlId
i, (IdPMetadata, SignPrivCreds)
c)

    Value
scimUser <- App Value
randomScimUser
    String
email <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" 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
    String
uid <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner (ScimToken -> String
unScimToken ScimToken
tok) Value
scimUser) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
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
201
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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
    Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (String, (IdPMetadata, SignPrivCreds)) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (String, (IdPMetadata, SignPrivCreds))
mIdp) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
      Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerUser Domain
OwnDomain String
tid String
email

    App ()
-> ((String, (IdPMetadata, SignPrivCreds)) -> App ())
-> Maybe (String, (IdPMetadata, SignPrivCreds))
-> App ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HasCallStack => Int -> Value -> App ()
Int -> Value -> App ()
loginWithPassword Int
200 Value
scimUser) (HasCallStack =>
Bool
-> String
-> Value
-> (String, (IdPMetadata, SignPrivCreds))
-> App ()
Bool
-> String
-> Value
-> (String, (IdPMetadata, SignPrivCreds))
-> App ()
loginWithSaml Bool
True String
tid Value
scimUser) Maybe (String, (IdPMetadata, SignPrivCreds))
mIdp

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
deleteScimUser Value
owner (ScimToken -> String
unScimToken ScimToken
tok) String
uid) ((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
204

    App ()
-> ((String, (IdPMetadata, SignPrivCreds)) -> App ())
-> Maybe (String, (IdPMetadata, SignPrivCreds))
-> App ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HasCallStack => Int -> Value -> App ()
Int -> Value -> App ()
loginWithPassword Int
403 Value
scimUser) (HasCallStack =>
Bool
-> String
-> Value
-> (String, (IdPMetadata, SignPrivCreds))
-> App ()
Bool
-> String
-> Value
-> (String, (IdPMetadata, SignPrivCreds))
-> App ()
loginWithSaml Bool
False String
tid Value
scimUser) Maybe (String, (IdPMetadata, SignPrivCreds))
mIdp

validateError :: Response -> Int -> String -> App ()
validateError :: Response -> Int -> String -> App ()
validateError Response
resp Int
errStatus String
errLabel = do
  do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
errStatus
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
errStatus
    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
errLabel

loginWithPassword :: (HasCallStack) => Int -> Value -> App ()
loginWithPassword :: HasCallStack => Int -> Value -> App ()
loginWithPassword Int
expectedStatus Value
scimUser = do
  String
email <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> 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
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> 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
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value") 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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall domain email password.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password) =>
domain -> email -> password -> App Response
login Domain
OwnDomain String
email String
defPassword) ((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
expectedStatus