module API.Spar where
import API.Common (defPassword)
import qualified Data.ByteString.Base64.Lazy as EL
import Data.String.Conversions (cs)
import Data.String.Conversions.Monomorphic (fromLT)
import GHC.Stack
import Network.HTTP.Client.MultipartFormData
import qualified SAML2.WebSSO as SAML
import qualified SAML2.WebSSO.Test.MockResponse as SAML
import Testlib.Prelude
import qualified Text.XML as XML
getScimTokens :: (HasCallStack, MakesValue caller) => caller -> App Response
getScimTokens :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> App Response
getScimTokens caller
caller = do
Request
req <- caller -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest caller
caller Service
Spar Versioned
Versioned String
"/scim/auth-tokens"
String -> Request -> App Response
submit String
"GET" Request
req
data CreateScimToken = CreateScimToken
{ CreateScimToken -> String
password :: String,
CreateScimToken -> Maybe String
description :: Maybe String,
CreateScimToken -> Maybe String
name :: Maybe String,
CreateScimToken -> Maybe String
idp :: Maybe String
}
deriving stock ((forall x. CreateScimToken -> Rep CreateScimToken x)
-> (forall x. Rep CreateScimToken x -> CreateScimToken)
-> Generic CreateScimToken
forall x. Rep CreateScimToken x -> CreateScimToken
forall x. CreateScimToken -> Rep CreateScimToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateScimToken -> Rep CreateScimToken x
from :: forall x. CreateScimToken -> Rep CreateScimToken x
$cto :: forall x. Rep CreateScimToken x -> CreateScimToken
to :: forall x. Rep CreateScimToken x -> CreateScimToken
Generic, Int -> CreateScimToken -> ShowS
[CreateScimToken] -> ShowS
CreateScimToken -> String
(Int -> CreateScimToken -> ShowS)
-> (CreateScimToken -> String)
-> ([CreateScimToken] -> ShowS)
-> Show CreateScimToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateScimToken -> ShowS
showsPrec :: Int -> CreateScimToken -> ShowS
$cshow :: CreateScimToken -> String
show :: CreateScimToken -> String
$cshowList :: [CreateScimToken] -> ShowS
showList :: [CreateScimToken] -> ShowS
Show)
instance Default CreateScimToken where
def :: CreateScimToken
def = String
-> Maybe String -> Maybe String -> Maybe String -> CreateScimToken
CreateScimToken String
defPassword (String -> Maybe String
forall a. a -> Maybe a
Just String
"integration test") Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
instance ToJSON CreateScimToken where
toJSON :: CreateScimToken -> Value
toJSON = Options -> CreateScimToken -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> CreateScimToken -> Value)
-> Options -> CreateScimToken -> Value
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions {fieldLabelModifier = camelTo2 '_'}
createScimTokenV6 :: (HasCallStack, MakesValue caller) => caller -> CreateScimToken -> App Response
createScimTokenV6 :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 caller
caller CreateScimToken
payload = do
Request
req <- caller -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest caller
caller Service
Spar (Int -> Versioned
ExplicitVersion Int
6) String
"/scim/auth-tokens"
Value
j <- CreateScimToken -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make CreateScimToken
payload
String -> Request -> App Response
submit String
"POST" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
addJSON Value
j
createScimToken :: (HasCallStack, MakesValue caller) => caller -> CreateScimToken -> App Response
createScimToken :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken caller
caller CreateScimToken
payload = do
Request
req <- caller -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest caller
caller Service
Spar Versioned
Versioned String
"/scim/auth-tokens"
Value
j <- CreateScimToken -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make CreateScimToken
payload
String -> Request -> App Response
submit String
"POST" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
addJSON Value
j
deleteScimToken :: (HasCallStack, MakesValue caller) => caller -> String -> App Response
deleteScimToken :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> App Response
deleteScimToken caller
caller String
token = do
Request
req <- caller -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest caller
caller Service
Spar Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"scim", String
"auth-tokens"]
String -> Request -> App Response
submit String
"DELETE" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [(String, String)] -> Request -> Request
addQueryParams [(String
"id", String
token)]
putScimTokenName :: (HasCallStack, MakesValue caller) => caller -> String -> String -> App Response
putScimTokenName :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App Response
putScimTokenName caller
caller String
token String
name = do
Request
req <- caller -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest caller
caller Service
Spar Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"scim", String
"auth-tokens", String
token]
String -> Request -> App Response
submit String
"PUT" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"name" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
name]
createScimUser :: (HasCallStack, MakesValue domain, MakesValue scimUser) => domain -> String -> scimUser -> App Response
createScimUser :: forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser domain
domain String
token scimUser
scimUser = do
Request
req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned String
"/scim/v2/Users"
Value
body <- scimUser -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make scimUser
scimUser
String -> Request -> App Response
submit String
"POST" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
addJSON Value
body (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Request -> Request
addHeader String
"Authorization" (String
"Bearer " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
token)
deleteScimUser :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response
deleteScimUser :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App Response
deleteScimUser domain
domain String
token String
uid = do
Request
req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"scim", String
"v2", String
"Users", String
uid]
String -> Request -> App Response
submit String
"DELETE" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& String -> String -> Request -> Request
addHeader String
"Authorization" (String
"Bearer " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
token)
findUsersByExternalId :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response
findUsersByExternalId :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App Response
findUsersByExternalId domain
domain String
scimToken String
externalId = do
Request
req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned String
"/scim/v2/Users"
String -> Request -> App Response
submit String
"GET" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [(String, String)] -> Request -> Request
addQueryParams [(String
"filter", String
"externalId eq \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
externalId String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\"")]
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& String -> String -> Request -> Request
addHeader String
"Authorization" (String
"Bearer " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
scimToken)
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& String -> String -> Request -> Request
addHeader String
"Accept" String
"application/scim+json"
getScimUser :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response
getScimUser :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App Response
getScimUser domain
domain String
scimToken String
uid = do
Request
req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"scim", String
"v2", String
"Users", String
uid]
String -> Request -> App Response
submit String
"GET" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& String -> String -> Request -> Request
addHeader String
"Authorization" (String
"Bearer " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
scimToken)
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& String -> String -> Request -> Request
addHeader String
"Accept" String
"application/scim+json"
updateScimUser :: (HasCallStack, MakesValue domain, MakesValue scimUser) => domain -> String -> String -> scimUser -> App Response
updateScimUser :: forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser domain
domain String
scimToken String
userId scimUser
scimUser = do
Request
req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"scim", String
"v2", String
"Users", String
userId]
Value
body <- scimUser -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make scimUser
scimUser
String -> Request -> App Response
submit String
"PUT" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
addJSON Value
body (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Request -> Request
addHeader String
"Authorization" (String
"Bearer " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
scimToken)
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& String -> String -> Request -> Request
addHeader String
"Accept" String
"application/scim+json"
createIdp :: (HasCallStack, MakesValue user) => user -> SAML.IdPMetadata -> App Response
createIdp :: forall user.
(HasCallStack, MakesValue user) =>
user -> IdPMetadata -> App Response
createIdp user
user IdPMetadata
metadata = do
Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Spar Versioned
Versioned String
"/identity-providers"
String -> Request -> App Response
submit String
"POST" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [(String, String)] -> Request -> Request
addQueryParams [(String
"api_version", String
"v2")]
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ByteString -> Request -> Request
addXML (LT -> ByteString
forall a. ConvertibleStrings LT a => LT -> a
fromLT (LT -> ByteString) -> LT -> ByteString
forall a b. (a -> b) -> a -> b
$ IdPMetadata -> LT
forall a. HasXMLRoot a => a -> LT
SAML.encode IdPMetadata
metadata)
Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& String -> String -> Request -> Request
addHeader String
"Content-Type" String
"application/xml"
getIdps :: (HasCallStack, MakesValue user) => user -> App Response
getIdps :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> App Response
getIdps user
user = do
Request
req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Spar Versioned
Versioned String
"/identity-providers"
String -> Request -> App Response
submit String
"GET" Request
req
getSPMetadata :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
getSPMetadata :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> App Response
getSPMetadata domain
domain String
tid = do
Request
req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"sso", String
"metadata", String
tid]
String -> Request -> App Response
submit String
"GET" Request
req
initiateSamlLogin :: (HasCallStack, MakesValue domain) => domain -> String -> App Response
initiateSamlLogin :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> App Response
initiateSamlLogin domain
domain String
idpId = do
Request
req <- domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"sso", String
"initiate-login", String
idpId]
String -> Request -> App Response
submit String
"GET" Request
req
finalizeSamlLogin :: (HasCallStack, MakesValue domain) => domain -> String -> SAML.SignedAuthnResponse -> App Response
finalizeSamlLogin :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> SignedAuthnResponse -> App Response
finalizeSamlLogin domain
domain String
tid (SAML.SignedAuthnResponse Document
authnresp) = do
domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest domain
domain Service
Spar Versioned
Versioned ([String] -> String
joinHttpPath [String
"sso", String
"finalize-login", String
tid])
App Request -> (Request -> App Request) -> App Request
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Part] -> Request -> App Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
formDataBody [Text -> ByteString -> Part
forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
"SAMLResponse") (ByteString -> Part)
-> (Document -> ByteString) -> Document -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
EL.encode (ByteString -> ByteString)
-> (Document -> ByteString) -> Document -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
forall a. Default a => a
XML.def (Document -> Part) -> Document -> Part
forall a b. (a -> b) -> a -> b
$ Document
authnresp]
App Request -> (Request -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Request -> App Response
submit String
"POST"