{-
   Ory Hydra API

   Documentation for all of Ory Hydra's APIs. 

   OpenAPI Version: 3.0.3
   Ory Hydra API API version: 
   Contact: hi@ory.sh
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : OryHydra.Model
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}

module OryHydra.Model where

import OryHydra.Core
import OryHydra.MimeTypes

import Data.Aeson ((.:),(.:!),(.:?),(.=))

import qualified Control.Arrow as P (left)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)
import qualified Data.Foldable as P
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time as TI
import qualified Lens.Micro as L
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH

import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import Prelude (($),(/=),(.),(<$>),(<*>),(>>=),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)

import qualified Prelude as P



-- * Parameter newtypes


-- ** All
newtype All = All { All -> Bool
unAll :: Bool } deriving (All -> All -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: All -> All -> Bool
$c/= :: All -> All -> Bool
== :: All -> All -> Bool
$c== :: All -> All -> Bool
P.Eq, Int -> All -> ShowS
[All] -> ShowS
All -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [All] -> ShowS
$cshowList :: [All] -> ShowS
show :: All -> String
$cshow :: All -> String
showsPrec :: Int -> All -> ShowS
$cshowsPrec :: Int -> All -> ShowS
P.Show)

-- ** Client
newtype Client = Client { Client -> Text
unClient :: Text } deriving (Client -> Client -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Client -> Client -> Bool
$c/= :: Client -> Client -> Bool
== :: Client -> Client -> Bool
$c== :: Client -> Client -> Bool
P.Eq, Int -> Client -> ShowS
[Client] -> ShowS
Client -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Client] -> ShowS
$cshowList :: [Client] -> ShowS
show :: Client -> String
$cshow :: Client -> String
showsPrec :: Int -> Client -> ShowS
$cshowsPrec :: Int -> Client -> ShowS
P.Show)

-- ** ClientId
newtype ClientId = ClientId { ClientId -> Text
unClientId :: Text } deriving (ClientId -> ClientId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientId -> ClientId -> Bool
$c/= :: ClientId -> ClientId -> Bool
== :: ClientId -> ClientId -> Bool
$c== :: ClientId -> ClientId -> Bool
P.Eq, Int -> ClientId -> ShowS
[ClientId] -> ShowS
ClientId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientId] -> ShowS
$cshowList :: [ClientId] -> ShowS
show :: ClientId -> String
$cshow :: ClientId -> String
showsPrec :: Int -> ClientId -> ShowS
$cshowsPrec :: Int -> ClientId -> ShowS
P.Show)

-- ** ClientName
newtype ClientName = ClientName { ClientName -> Text
unClientName :: Text } deriving (ClientName -> ClientName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientName -> ClientName -> Bool
$c/= :: ClientName -> ClientName -> Bool
== :: ClientName -> ClientName -> Bool
$c== :: ClientName -> ClientName -> Bool
P.Eq, Int -> ClientName -> ShowS
[ClientName] -> ShowS
ClientName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientName] -> ShowS
$cshowList :: [ClientName] -> ShowS
show :: ClientName -> String
$cshow :: ClientName -> String
showsPrec :: Int -> ClientName -> ShowS
$cshowsPrec :: Int -> ClientName -> ShowS
P.Show)

-- ** ClientSecret
newtype ClientSecret = ClientSecret { ClientSecret -> Text
unClientSecret :: Text } deriving (ClientSecret -> ClientSecret -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientSecret -> ClientSecret -> Bool
$c/= :: ClientSecret -> ClientSecret -> Bool
== :: ClientSecret -> ClientSecret -> Bool
$c== :: ClientSecret -> ClientSecret -> Bool
P.Eq, Int -> ClientSecret -> ShowS
[ClientSecret] -> ShowS
ClientSecret -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientSecret] -> ShowS
$cshowList :: [ClientSecret] -> ShowS
show :: ClientSecret -> String
$cshow :: ClientSecret -> String
showsPrec :: Int -> ClientSecret -> ShowS
$cshowsPrec :: Int -> ClientSecret -> ShowS
P.Show)

-- ** Code
newtype Code = Code { Code -> Text
unCode :: Text } deriving (Code -> Code -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Code -> Code -> Bool
$c/= :: Code -> Code -> Bool
== :: Code -> Code -> Bool
$c== :: Code -> Code -> Bool
P.Eq, Int -> Code -> ShowS
[Code] -> ShowS
Code -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Code] -> ShowS
$cshowList :: [Code] -> ShowS
show :: Code -> String
$cshow :: Code -> String
showsPrec :: Int -> Code -> ShowS
$cshowsPrec :: Int -> Code -> ShowS
P.Show)

-- ** ConsentChallenge
newtype ConsentChallenge = ConsentChallenge { ConsentChallenge -> Text
unConsentChallenge :: Text } deriving (ConsentChallenge -> ConsentChallenge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsentChallenge -> ConsentChallenge -> Bool
$c/= :: ConsentChallenge -> ConsentChallenge -> Bool
== :: ConsentChallenge -> ConsentChallenge -> Bool
$c== :: ConsentChallenge -> ConsentChallenge -> Bool
P.Eq, Int -> ConsentChallenge -> ShowS
[ConsentChallenge] -> ShowS
ConsentChallenge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsentChallenge] -> ShowS
$cshowList :: [ConsentChallenge] -> ShowS
show :: ConsentChallenge -> String
$cshow :: ConsentChallenge -> String
showsPrec :: Int -> ConsentChallenge -> ShowS
$cshowsPrec :: Int -> ConsentChallenge -> ShowS
P.Show)

-- ** DefaultItems
newtype DefaultItems = DefaultItems { DefaultItems -> Integer
unDefaultItems :: Integer } deriving (DefaultItems -> DefaultItems -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultItems -> DefaultItems -> Bool
$c/= :: DefaultItems -> DefaultItems -> Bool
== :: DefaultItems -> DefaultItems -> Bool
$c== :: DefaultItems -> DefaultItems -> Bool
P.Eq, Int -> DefaultItems -> ShowS
[DefaultItems] -> ShowS
DefaultItems -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultItems] -> ShowS
$cshowList :: [DefaultItems] -> ShowS
show :: DefaultItems -> String
$cshow :: DefaultItems -> String
showsPrec :: Int -> DefaultItems -> ShowS
$cshowsPrec :: Int -> DefaultItems -> ShowS
P.Show)

-- ** GrantType
newtype GrantType = GrantType { GrantType -> Text
unGrantType :: Text } deriving (GrantType -> GrantType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrantType -> GrantType -> Bool
$c/= :: GrantType -> GrantType -> Bool
== :: GrantType -> GrantType -> Bool
$c== :: GrantType -> GrantType -> Bool
P.Eq, Int -> GrantType -> ShowS
[GrantType] -> ShowS
GrantType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrantType] -> ShowS
$cshowList :: [GrantType] -> ShowS
show :: GrantType -> String
$cshow :: GrantType -> String
showsPrec :: Int -> GrantType -> ShowS
$cshowsPrec :: Int -> GrantType -> ShowS
P.Show)

-- ** Id
newtype Id = Id { Id -> Text
unId :: Text } deriving (Id -> Id -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
P.Eq, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
P.Show)

-- ** Issuer
newtype Issuer = Issuer { Issuer -> Text
unIssuer :: Text } deriving (Issuer -> Issuer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issuer -> Issuer -> Bool
$c/= :: Issuer -> Issuer -> Bool
== :: Issuer -> Issuer -> Bool
$c== :: Issuer -> Issuer -> Bool
P.Eq, Int -> Issuer -> ShowS
[Issuer] -> ShowS
Issuer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issuer] -> ShowS
$cshowList :: [Issuer] -> ShowS
show :: Issuer -> String
$cshow :: Issuer -> String
showsPrec :: Int -> Issuer -> ShowS
$cshowsPrec :: Int -> Issuer -> ShowS
P.Show)

-- ** JsonPatch2
newtype JsonPatch2 = JsonPatch2 { JsonPatch2 -> [JsonPatch]
unJsonPatch2 :: [JsonPatch] } deriving (JsonPatch2 -> JsonPatch2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonPatch2 -> JsonPatch2 -> Bool
$c/= :: JsonPatch2 -> JsonPatch2 -> Bool
== :: JsonPatch2 -> JsonPatch2 -> Bool
$c== :: JsonPatch2 -> JsonPatch2 -> Bool
P.Eq, Int -> JsonPatch2 -> ShowS
[JsonPatch2] -> ShowS
JsonPatch2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonPatch2] -> ShowS
$cshowList :: [JsonPatch2] -> ShowS
show :: JsonPatch2 -> String
$cshow :: JsonPatch2 -> String
showsPrec :: Int -> JsonPatch2 -> ShowS
$cshowsPrec :: Int -> JsonPatch2 -> ShowS
P.Show, [JsonPatch2] -> Encoding
[JsonPatch2] -> Value
JsonPatch2 -> Encoding
JsonPatch2 -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JsonPatch2] -> Encoding
$ctoEncodingList :: [JsonPatch2] -> Encoding
toJSONList :: [JsonPatch2] -> Value
$ctoJSONList :: [JsonPatch2] -> Value
toEncoding :: JsonPatch2 -> Encoding
$ctoEncoding :: JsonPatch2 -> Encoding
toJSON :: JsonPatch2 -> Value
$ctoJSON :: JsonPatch2 -> Value
A.ToJSON)

-- ** Kid
newtype Kid = Kid { Kid -> Text
unKid :: Text } deriving (Kid -> Kid -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kid -> Kid -> Bool
$c/= :: Kid -> Kid -> Bool
== :: Kid -> Kid -> Bool
$c== :: Kid -> Kid -> Bool
P.Eq, Int -> Kid -> ShowS
[Kid] -> ShowS
Kid -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kid] -> ShowS
$cshowList :: [Kid] -> ShowS
show :: Kid -> String
$cshow :: Kid -> String
showsPrec :: Int -> Kid -> ShowS
$cshowsPrec :: Int -> Kid -> ShowS
P.Show)

-- ** LoginChallenge
newtype LoginChallenge = LoginChallenge { LoginChallenge -> Text
unLoginChallenge :: Text } deriving (LoginChallenge -> LoginChallenge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginChallenge -> LoginChallenge -> Bool
$c/= :: LoginChallenge -> LoginChallenge -> Bool
== :: LoginChallenge -> LoginChallenge -> Bool
$c== :: LoginChallenge -> LoginChallenge -> Bool
P.Eq, Int -> LoginChallenge -> ShowS
[LoginChallenge] -> ShowS
LoginChallenge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoginChallenge] -> ShowS
$cshowList :: [LoginChallenge] -> ShowS
show :: LoginChallenge -> String
$cshow :: LoginChallenge -> String
showsPrec :: Int -> LoginChallenge -> ShowS
$cshowsPrec :: Int -> LoginChallenge -> ShowS
P.Show)

-- ** LoginSessionId
newtype LoginSessionId = LoginSessionId { LoginSessionId -> Text
unLoginSessionId :: Text } deriving (LoginSessionId -> LoginSessionId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginSessionId -> LoginSessionId -> Bool
$c/= :: LoginSessionId -> LoginSessionId -> Bool
== :: LoginSessionId -> LoginSessionId -> Bool
$c== :: LoginSessionId -> LoginSessionId -> Bool
P.Eq, Int -> LoginSessionId -> ShowS
[LoginSessionId] -> ShowS
LoginSessionId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoginSessionId] -> ShowS
$cshowList :: [LoginSessionId] -> ShowS
show :: LoginSessionId -> String
$cshow :: LoginSessionId -> String
showsPrec :: Int -> LoginSessionId -> ShowS
$cshowsPrec :: Int -> LoginSessionId -> ShowS
P.Show)

-- ** LogoutChallenge
newtype LogoutChallenge = LogoutChallenge { LogoutChallenge -> Text
unLogoutChallenge :: Text } deriving (LogoutChallenge -> LogoutChallenge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogoutChallenge -> LogoutChallenge -> Bool
$c/= :: LogoutChallenge -> LogoutChallenge -> Bool
== :: LogoutChallenge -> LogoutChallenge -> Bool
$c== :: LogoutChallenge -> LogoutChallenge -> Bool
P.Eq, Int -> LogoutChallenge -> ShowS
[LogoutChallenge] -> ShowS
LogoutChallenge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogoutChallenge] -> ShowS
$cshowList :: [LogoutChallenge] -> ShowS
show :: LogoutChallenge -> String
$cshow :: LogoutChallenge -> String
showsPrec :: Int -> LogoutChallenge -> ShowS
$cshowsPrec :: Int -> LogoutChallenge -> ShowS
P.Show)

-- ** MaxItems
newtype MaxItems = MaxItems { MaxItems -> Integer
unMaxItems :: Integer } deriving (MaxItems -> MaxItems -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxItems -> MaxItems -> Bool
$c/= :: MaxItems -> MaxItems -> Bool
== :: MaxItems -> MaxItems -> Bool
$c== :: MaxItems -> MaxItems -> Bool
P.Eq, Int -> MaxItems -> ShowS
[MaxItems] -> ShowS
MaxItems -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxItems] -> ShowS
$cshowList :: [MaxItems] -> ShowS
show :: MaxItems -> String
$cshow :: MaxItems -> String
showsPrec :: Int -> MaxItems -> ShowS
$cshowsPrec :: Int -> MaxItems -> ShowS
P.Show)

-- ** Owner
newtype Owner = Owner { Owner -> Text
unOwner :: Text } deriving (Owner -> Owner -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Owner -> Owner -> Bool
$c/= :: Owner -> Owner -> Bool
== :: Owner -> Owner -> Bool
$c== :: Owner -> Owner -> Bool
P.Eq, Int -> Owner -> ShowS
[Owner] -> ShowS
Owner -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Owner] -> ShowS
$cshowList :: [Owner] -> ShowS
show :: Owner -> String
$cshow :: Owner -> String
showsPrec :: Int -> Owner -> ShowS
$cshowsPrec :: Int -> Owner -> ShowS
P.Show)

-- ** PageSize
newtype PageSize = PageSize { PageSize -> Integer
unPageSize :: Integer } deriving (PageSize -> PageSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageSize -> PageSize -> Bool
$c/= :: PageSize -> PageSize -> Bool
== :: PageSize -> PageSize -> Bool
$c== :: PageSize -> PageSize -> Bool
P.Eq, Int -> PageSize -> ShowS
[PageSize] -> ShowS
PageSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageSize] -> ShowS
$cshowList :: [PageSize] -> ShowS
show :: PageSize -> String
$cshow :: PageSize -> String
showsPrec :: Int -> PageSize -> ShowS
$cshowsPrec :: Int -> PageSize -> ShowS
P.Show)

-- ** PageToken
newtype PageToken = PageToken { PageToken -> Text
unPageToken :: Text } deriving (PageToken -> PageToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageToken -> PageToken -> Bool
$c/= :: PageToken -> PageToken -> Bool
== :: PageToken -> PageToken -> Bool
$c== :: PageToken -> PageToken -> Bool
P.Eq, Int -> PageToken -> ShowS
[PageToken] -> ShowS
PageToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageToken] -> ShowS
$cshowList :: [PageToken] -> ShowS
show :: PageToken -> String
$cshow :: PageToken -> String
showsPrec :: Int -> PageToken -> ShowS
$cshowsPrec :: Int -> PageToken -> ShowS
P.Show)

-- ** RedirectUri
newtype RedirectUri = RedirectUri { RedirectUri -> Text
unRedirectUri :: Text } deriving (RedirectUri -> RedirectUri -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedirectUri -> RedirectUri -> Bool
$c/= :: RedirectUri -> RedirectUri -> Bool
== :: RedirectUri -> RedirectUri -> Bool
$c== :: RedirectUri -> RedirectUri -> Bool
P.Eq, Int -> RedirectUri -> ShowS
[RedirectUri] -> ShowS
RedirectUri -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedirectUri] -> ShowS
$cshowList :: [RedirectUri] -> ShowS
show :: RedirectUri -> String
$cshow :: RedirectUri -> String
showsPrec :: Int -> RedirectUri -> ShowS
$cshowsPrec :: Int -> RedirectUri -> ShowS
P.Show)

-- ** RefreshToken
newtype RefreshToken = RefreshToken { RefreshToken -> Text
unRefreshToken :: Text } deriving (RefreshToken -> RefreshToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefreshToken -> RefreshToken -> Bool
$c/= :: RefreshToken -> RefreshToken -> Bool
== :: RefreshToken -> RefreshToken -> Bool
$c== :: RefreshToken -> RefreshToken -> Bool
P.Eq, Int -> RefreshToken -> ShowS
[RefreshToken] -> ShowS
RefreshToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RefreshToken] -> ShowS
$cshowList :: [RefreshToken] -> ShowS
show :: RefreshToken -> String
$cshow :: RefreshToken -> String
showsPrec :: Int -> RefreshToken -> ShowS
$cshowsPrec :: Int -> RefreshToken -> ShowS
P.Show)

-- ** Scope
newtype Scope = Scope { Scope -> Text
unScope :: Text } deriving (Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
P.Eq, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
P.Show)

-- ** Set
newtype Set = Set { Set -> Text
unSet :: Text } deriving (Set -> Set -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Set -> Set -> Bool
$c/= :: Set -> Set -> Bool
== :: Set -> Set -> Bool
$c== :: Set -> Set -> Bool
P.Eq, Int -> Set -> ShowS
[Set] -> ShowS
Set -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Set] -> ShowS
$cshowList :: [Set] -> ShowS
show :: Set -> String
$cshow :: Set -> String
showsPrec :: Int -> Set -> ShowS
$cshowsPrec :: Int -> Set -> ShowS
P.Show)

-- ** Subject
newtype Subject = Subject { Subject -> Text
unSubject :: Text } deriving (Subject -> Subject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subject -> Subject -> Bool
$c/= :: Subject -> Subject -> Bool
== :: Subject -> Subject -> Bool
$c== :: Subject -> Subject -> Bool
P.Eq, Int -> Subject -> ShowS
[Subject] -> ShowS
Subject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subject] -> ShowS
$cshowList :: [Subject] -> ShowS
show :: Subject -> String
$cshow :: Subject -> String
showsPrec :: Int -> Subject -> ShowS
$cshowsPrec :: Int -> Subject -> ShowS
P.Show)

-- ** Token
newtype Token = Token { Token -> Text
unToken :: Text } deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
P.Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
P.Show)

-- * Models


-- ** AcceptOAuth2ConsentRequest
-- | AcceptOAuth2ConsentRequest
-- The request payload used to accept a consent request.
-- 
data AcceptOAuth2ConsentRequest = AcceptOAuth2ConsentRequest
  { AcceptOAuth2ConsentRequest -> Maybe [Text]
acceptOAuth2ConsentRequestGrantAccessTokenAudience :: Maybe [Text] -- ^ "grant_access_token_audience"
  , AcceptOAuth2ConsentRequest -> Maybe [Text]
acceptOAuth2ConsentRequestGrantScope :: Maybe [Text] -- ^ "grant_scope"
  , AcceptOAuth2ConsentRequest -> Maybe DateTime
acceptOAuth2ConsentRequestHandledAt :: Maybe DateTime -- ^ "handled_at"
  , AcceptOAuth2ConsentRequest -> Maybe Bool
acceptOAuth2ConsentRequestRemember :: Maybe Bool -- ^ "remember" - Remember, if set to true, tells ORY Hydra to remember this consent authorization and reuse it if the same client asks the same user for the same, or a subset of, scope.
  , AcceptOAuth2ConsentRequest -> Maybe Integer
acceptOAuth2ConsentRequestRememberFor :: Maybe Integer -- ^ "remember_for" - RememberFor sets how long the consent authorization should be remembered for in seconds. If set to &#x60;0&#x60;, the authorization will be remembered indefinitely.
  , AcceptOAuth2ConsentRequest
-> Maybe AcceptOAuth2ConsentRequestSession
acceptOAuth2ConsentRequestSession :: Maybe AcceptOAuth2ConsentRequestSession -- ^ "session"
  } deriving (Int -> AcceptOAuth2ConsentRequest -> ShowS
[AcceptOAuth2ConsentRequest] -> ShowS
AcceptOAuth2ConsentRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptOAuth2ConsentRequest] -> ShowS
$cshowList :: [AcceptOAuth2ConsentRequest] -> ShowS
show :: AcceptOAuth2ConsentRequest -> String
$cshow :: AcceptOAuth2ConsentRequest -> String
showsPrec :: Int -> AcceptOAuth2ConsentRequest -> ShowS
$cshowsPrec :: Int -> AcceptOAuth2ConsentRequest -> ShowS
P.Show, AcceptOAuth2ConsentRequest -> AcceptOAuth2ConsentRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptOAuth2ConsentRequest -> AcceptOAuth2ConsentRequest -> Bool
$c/= :: AcceptOAuth2ConsentRequest -> AcceptOAuth2ConsentRequest -> Bool
== :: AcceptOAuth2ConsentRequest -> AcceptOAuth2ConsentRequest -> Bool
$c== :: AcceptOAuth2ConsentRequest -> AcceptOAuth2ConsentRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON AcceptOAuth2ConsentRequest
instance A.FromJSON AcceptOAuth2ConsentRequest where
  parseJSON :: Value -> Parser AcceptOAuth2ConsentRequest
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AcceptOAuth2ConsentRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Bool
-> Maybe Integer
-> Maybe AcceptOAuth2ConsentRequestSession
-> AcceptOAuth2ConsentRequest
AcceptOAuth2ConsentRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grant_access_token_audience")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grant_scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"handled_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remember")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remember_for")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"session")

-- | ToJSON AcceptOAuth2ConsentRequest
instance A.ToJSON AcceptOAuth2ConsentRequest where
  toJSON :: AcceptOAuth2ConsentRequest -> Value
toJSON AcceptOAuth2ConsentRequest {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe DateTime
Maybe AcceptOAuth2ConsentRequestSession
acceptOAuth2ConsentRequestSession :: Maybe AcceptOAuth2ConsentRequestSession
acceptOAuth2ConsentRequestRememberFor :: Maybe Integer
acceptOAuth2ConsentRequestRemember :: Maybe Bool
acceptOAuth2ConsentRequestHandledAt :: Maybe DateTime
acceptOAuth2ConsentRequestGrantScope :: Maybe [Text]
acceptOAuth2ConsentRequestGrantAccessTokenAudience :: Maybe [Text]
acceptOAuth2ConsentRequestSession :: AcceptOAuth2ConsentRequest
-> Maybe AcceptOAuth2ConsentRequestSession
acceptOAuth2ConsentRequestRememberFor :: AcceptOAuth2ConsentRequest -> Maybe Integer
acceptOAuth2ConsentRequestRemember :: AcceptOAuth2ConsentRequest -> Maybe Bool
acceptOAuth2ConsentRequestHandledAt :: AcceptOAuth2ConsentRequest -> Maybe DateTime
acceptOAuth2ConsentRequestGrantScope :: AcceptOAuth2ConsentRequest -> Maybe [Text]
acceptOAuth2ConsentRequestGrantAccessTokenAudience :: AcceptOAuth2ConsentRequest -> Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"grant_access_token_audience" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
acceptOAuth2ConsentRequestGrantAccessTokenAudience
      , Key
"grant_scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
acceptOAuth2ConsentRequestGrantScope
      , Key
"handled_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
acceptOAuth2ConsentRequestHandledAt
      , Key
"remember" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
acceptOAuth2ConsentRequestRemember
      , Key
"remember_for" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
acceptOAuth2ConsentRequestRememberFor
      , Key
"session" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe AcceptOAuth2ConsentRequestSession
acceptOAuth2ConsentRequestSession
      ]


-- | Construct a value of type 'AcceptOAuth2ConsentRequest' (by applying it's required fields, if any)
mkAcceptOAuth2ConsentRequest
  :: AcceptOAuth2ConsentRequest
mkAcceptOAuth2ConsentRequest :: AcceptOAuth2ConsentRequest
mkAcceptOAuth2ConsentRequest =
  AcceptOAuth2ConsentRequest
  { acceptOAuth2ConsentRequestGrantAccessTokenAudience :: Maybe [Text]
acceptOAuth2ConsentRequestGrantAccessTokenAudience = forall a. Maybe a
Nothing
  , acceptOAuth2ConsentRequestGrantScope :: Maybe [Text]
acceptOAuth2ConsentRequestGrantScope = forall a. Maybe a
Nothing
  , acceptOAuth2ConsentRequestHandledAt :: Maybe DateTime
acceptOAuth2ConsentRequestHandledAt = forall a. Maybe a
Nothing
  , acceptOAuth2ConsentRequestRemember :: Maybe Bool
acceptOAuth2ConsentRequestRemember = forall a. Maybe a
Nothing
  , acceptOAuth2ConsentRequestRememberFor :: Maybe Integer
acceptOAuth2ConsentRequestRememberFor = forall a. Maybe a
Nothing
  , acceptOAuth2ConsentRequestSession :: Maybe AcceptOAuth2ConsentRequestSession
acceptOAuth2ConsentRequestSession = forall a. Maybe a
Nothing
  }

-- ** AcceptOAuth2ConsentRequestSession
-- | AcceptOAuth2ConsentRequestSession
-- Pass session data to a consent request.
-- 
data AcceptOAuth2ConsentRequestSession = AcceptOAuth2ConsentRequestSession
  { AcceptOAuth2ConsentRequestSession -> Maybe Value
acceptOAuth2ConsentRequestSessionAccessToken :: Maybe A.Value -- ^ "access_token" - AccessToken sets session data for the access and refresh token, as well as any future tokens issued by the refresh grant. Keep in mind that this data will be available to anyone performing OAuth 2.0 Challenge Introspection. If only your services can perform OAuth 2.0 Challenge Introspection, this is usually fine. But if third parties can access that endpoint as well, sensitive data from the session might be exposed to them. Use with care!
  , AcceptOAuth2ConsentRequestSession -> Maybe Value
acceptOAuth2ConsentRequestSessionIdToken :: Maybe A.Value -- ^ "id_token" - IDToken sets session data for the OpenID Connect ID token. Keep in mind that the session&#39;id payloads are readable by anyone that has access to the ID Challenge. Use with care!
  } deriving (Int -> AcceptOAuth2ConsentRequestSession -> ShowS
[AcceptOAuth2ConsentRequestSession] -> ShowS
AcceptOAuth2ConsentRequestSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptOAuth2ConsentRequestSession] -> ShowS
$cshowList :: [AcceptOAuth2ConsentRequestSession] -> ShowS
show :: AcceptOAuth2ConsentRequestSession -> String
$cshow :: AcceptOAuth2ConsentRequestSession -> String
showsPrec :: Int -> AcceptOAuth2ConsentRequestSession -> ShowS
$cshowsPrec :: Int -> AcceptOAuth2ConsentRequestSession -> ShowS
P.Show, AcceptOAuth2ConsentRequestSession
-> AcceptOAuth2ConsentRequestSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptOAuth2ConsentRequestSession
-> AcceptOAuth2ConsentRequestSession -> Bool
$c/= :: AcceptOAuth2ConsentRequestSession
-> AcceptOAuth2ConsentRequestSession -> Bool
== :: AcceptOAuth2ConsentRequestSession
-> AcceptOAuth2ConsentRequestSession -> Bool
$c== :: AcceptOAuth2ConsentRequestSession
-> AcceptOAuth2ConsentRequestSession -> Bool
P.Eq, P.Typeable)

-- | FromJSON AcceptOAuth2ConsentRequestSession
instance A.FromJSON AcceptOAuth2ConsentRequestSession where
  parseJSON :: Value -> Parser AcceptOAuth2ConsentRequestSession
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AcceptOAuth2ConsentRequestSession" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Value -> Maybe Value -> AcceptOAuth2ConsentRequestSession
AcceptOAuth2ConsentRequestSession
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"access_token")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id_token")

-- | ToJSON AcceptOAuth2ConsentRequestSession
instance A.ToJSON AcceptOAuth2ConsentRequestSession where
  toJSON :: AcceptOAuth2ConsentRequestSession -> Value
toJSON AcceptOAuth2ConsentRequestSession {Maybe Value
acceptOAuth2ConsentRequestSessionIdToken :: Maybe Value
acceptOAuth2ConsentRequestSessionAccessToken :: Maybe Value
acceptOAuth2ConsentRequestSessionIdToken :: AcceptOAuth2ConsentRequestSession -> Maybe Value
acceptOAuth2ConsentRequestSessionAccessToken :: AcceptOAuth2ConsentRequestSession -> Maybe Value
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"access_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
acceptOAuth2ConsentRequestSessionAccessToken
      , Key
"id_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
acceptOAuth2ConsentRequestSessionIdToken
      ]


-- | Construct a value of type 'AcceptOAuth2ConsentRequestSession' (by applying it's required fields, if any)
mkAcceptOAuth2ConsentRequestSession
  :: AcceptOAuth2ConsentRequestSession
mkAcceptOAuth2ConsentRequestSession :: AcceptOAuth2ConsentRequestSession
mkAcceptOAuth2ConsentRequestSession =
  AcceptOAuth2ConsentRequestSession
  { acceptOAuth2ConsentRequestSessionAccessToken :: Maybe Value
acceptOAuth2ConsentRequestSessionAccessToken = forall a. Maybe a
Nothing
  , acceptOAuth2ConsentRequestSessionIdToken :: Maybe Value
acceptOAuth2ConsentRequestSessionIdToken = forall a. Maybe a
Nothing
  }

-- ** AcceptOAuth2LoginRequest
-- | AcceptOAuth2LoginRequest
-- HandledLoginRequest is the request payload used to accept a login request.
-- 
data AcceptOAuth2LoginRequest = AcceptOAuth2LoginRequest
  { AcceptOAuth2LoginRequest -> Maybe Text
acceptOAuth2LoginRequestAcr :: Maybe Text -- ^ "acr" - ACR sets the Authentication AuthorizationContext Class Reference value for this authentication session. You can use it to express that, for example, a user authenticated using two factor authentication.
  , AcceptOAuth2LoginRequest -> Maybe [Text]
acceptOAuth2LoginRequestAmr :: Maybe [Text] -- ^ "amr"
  , AcceptOAuth2LoginRequest -> Maybe Value
acceptOAuth2LoginRequestContext :: Maybe A.Value -- ^ "context"
  , AcceptOAuth2LoginRequest -> Maybe Text
acceptOAuth2LoginRequestForceSubjectIdentifier :: Maybe Text -- ^ "force_subject_identifier" - ForceSubjectIdentifier forces the \&quot;pairwise\&quot; user ID of the end-user that authenticated. The \&quot;pairwise\&quot; user ID refers to the (Pairwise Identifier Algorithm)[http://openid.net/specs/openid-connect-core-1_0.html#PairwiseAlg] of the OpenID Connect specification. It allows you to set an obfuscated subject (\&quot;user\&quot;) identifier that is unique to the client.  Please note that this changes the user ID on endpoint /userinfo and sub claim of the ID Token. It does not change the sub claim in the OAuth 2.0 Introspection.  Per default, ORY Hydra handles this value with its own algorithm. In case you want to set this yourself you can use this field. Please note that setting this field has no effect if &#x60;pairwise&#x60; is not configured in ORY Hydra or the OAuth 2.0 Client does not expect a pairwise identifier (set via &#x60;subject_type&#x60; key in the client&#39;s configuration).  Please also be aware that ORY Hydra is unable to properly compute this value during authentication. This implies that you have to compute this value on every authentication process (probably depending on the client ID or some other unique value).  If you fail to compute the proper value, then authentication processes which have id_token_hint set might fail.
  , AcceptOAuth2LoginRequest -> Maybe Bool
acceptOAuth2LoginRequestRemember :: Maybe Bool -- ^ "remember" - Remember, if set to true, tells ORY Hydra to remember this user by telling the user agent (browser) to store a cookie with authentication data. If the same user performs another OAuth 2.0 Authorization Request, he/she will not be asked to log in again.
  , AcceptOAuth2LoginRequest -> Maybe Integer
acceptOAuth2LoginRequestRememberFor :: Maybe Integer -- ^ "remember_for" - RememberFor sets how long the authentication should be remembered for in seconds. If set to &#x60;0&#x60;, the authorization will be remembered for the duration of the browser session (using a session cookie).
  , AcceptOAuth2LoginRequest -> Text
acceptOAuth2LoginRequestSubject :: Text -- ^ /Required/ "subject" - Subject is the user ID of the end-user that authenticated.
  } deriving (Int -> AcceptOAuth2LoginRequest -> ShowS
[AcceptOAuth2LoginRequest] -> ShowS
AcceptOAuth2LoginRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptOAuth2LoginRequest] -> ShowS
$cshowList :: [AcceptOAuth2LoginRequest] -> ShowS
show :: AcceptOAuth2LoginRequest -> String
$cshow :: AcceptOAuth2LoginRequest -> String
showsPrec :: Int -> AcceptOAuth2LoginRequest -> ShowS
$cshowsPrec :: Int -> AcceptOAuth2LoginRequest -> ShowS
P.Show, AcceptOAuth2LoginRequest -> AcceptOAuth2LoginRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptOAuth2LoginRequest -> AcceptOAuth2LoginRequest -> Bool
$c/= :: AcceptOAuth2LoginRequest -> AcceptOAuth2LoginRequest -> Bool
== :: AcceptOAuth2LoginRequest -> AcceptOAuth2LoginRequest -> Bool
$c== :: AcceptOAuth2LoginRequest -> AcceptOAuth2LoginRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON AcceptOAuth2LoginRequest
instance A.FromJSON AcceptOAuth2LoginRequest where
  parseJSON :: Value -> Parser AcceptOAuth2LoginRequest
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"AcceptOAuth2LoginRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text]
-> Maybe Value
-> Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Text
-> AcceptOAuth2LoginRequest
AcceptOAuth2LoginRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"acr")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"amr")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"context")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_subject_identifier")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remember")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remember_for")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"subject")

-- | ToJSON AcceptOAuth2LoginRequest
instance A.ToJSON AcceptOAuth2LoginRequest where
  toJSON :: AcceptOAuth2LoginRequest -> Value
toJSON AcceptOAuth2LoginRequest {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe Value
Text
acceptOAuth2LoginRequestSubject :: Text
acceptOAuth2LoginRequestRememberFor :: Maybe Integer
acceptOAuth2LoginRequestRemember :: Maybe Bool
acceptOAuth2LoginRequestForceSubjectIdentifier :: Maybe Text
acceptOAuth2LoginRequestContext :: Maybe Value
acceptOAuth2LoginRequestAmr :: Maybe [Text]
acceptOAuth2LoginRequestAcr :: Maybe Text
acceptOAuth2LoginRequestSubject :: AcceptOAuth2LoginRequest -> Text
acceptOAuth2LoginRequestRememberFor :: AcceptOAuth2LoginRequest -> Maybe Integer
acceptOAuth2LoginRequestRemember :: AcceptOAuth2LoginRequest -> Maybe Bool
acceptOAuth2LoginRequestForceSubjectIdentifier :: AcceptOAuth2LoginRequest -> Maybe Text
acceptOAuth2LoginRequestContext :: AcceptOAuth2LoginRequest -> Maybe Value
acceptOAuth2LoginRequestAmr :: AcceptOAuth2LoginRequest -> Maybe [Text]
acceptOAuth2LoginRequestAcr :: AcceptOAuth2LoginRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"acr" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
acceptOAuth2LoginRequestAcr
      , Key
"amr" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
acceptOAuth2LoginRequestAmr
      , Key
"context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
acceptOAuth2LoginRequestContext
      , Key
"force_subject_identifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
acceptOAuth2LoginRequestForceSubjectIdentifier
      , Key
"remember" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
acceptOAuth2LoginRequestRemember
      , Key
"remember_for" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
acceptOAuth2LoginRequestRememberFor
      , Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
acceptOAuth2LoginRequestSubject
      ]


-- | Construct a value of type 'AcceptOAuth2LoginRequest' (by applying it's required fields, if any)
mkAcceptOAuth2LoginRequest
  :: Text -- ^ 'acceptOAuth2LoginRequestSubject': Subject is the user ID of the end-user that authenticated.
  -> AcceptOAuth2LoginRequest
mkAcceptOAuth2LoginRequest :: Text -> AcceptOAuth2LoginRequest
mkAcceptOAuth2LoginRequest Text
acceptOAuth2LoginRequestSubject =
  AcceptOAuth2LoginRequest
  { acceptOAuth2LoginRequestAcr :: Maybe Text
acceptOAuth2LoginRequestAcr = forall a. Maybe a
Nothing
  , acceptOAuth2LoginRequestAmr :: Maybe [Text]
acceptOAuth2LoginRequestAmr = forall a. Maybe a
Nothing
  , acceptOAuth2LoginRequestContext :: Maybe Value
acceptOAuth2LoginRequestContext = forall a. Maybe a
Nothing
  , acceptOAuth2LoginRequestForceSubjectIdentifier :: Maybe Text
acceptOAuth2LoginRequestForceSubjectIdentifier = forall a. Maybe a
Nothing
  , acceptOAuth2LoginRequestRemember :: Maybe Bool
acceptOAuth2LoginRequestRemember = forall a. Maybe a
Nothing
  , acceptOAuth2LoginRequestRememberFor :: Maybe Integer
acceptOAuth2LoginRequestRememberFor = forall a. Maybe a
Nothing
  , Text
acceptOAuth2LoginRequestSubject :: Text
acceptOAuth2LoginRequestSubject :: Text
acceptOAuth2LoginRequestSubject
  }

-- ** CreateJsonWebKeySet
-- | CreateJsonWebKeySet
-- Create JSON Web Key Set Request Body
data CreateJsonWebKeySet = CreateJsonWebKeySet
  { CreateJsonWebKeySet -> Text
createJsonWebKeySetAlg :: Text -- ^ /Required/ "alg" - JSON Web Key Algorithm  The algorithm to be used for creating the key. Supports &#x60;RS256&#x60;, &#x60;ES256&#x60;, &#x60;ES512&#x60;, &#x60;HS512&#x60;, and &#x60;HS256&#x60;.
  , CreateJsonWebKeySet -> Text
createJsonWebKeySetKid :: Text -- ^ /Required/ "kid" - JSON Web Key ID  The Key ID of the key to be created.
  , CreateJsonWebKeySet -> Text
createJsonWebKeySetUse :: Text -- ^ /Required/ "use" - JSON Web Key Use  The \&quot;use\&quot; (public key use) parameter identifies the intended use of the public key. The \&quot;use\&quot; parameter is employed to indicate whether a public key is used for encrypting data or verifying the signature on data. Valid values are \&quot;enc\&quot; and \&quot;sig\&quot;.
  } deriving (Int -> CreateJsonWebKeySet -> ShowS
[CreateJsonWebKeySet] -> ShowS
CreateJsonWebKeySet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJsonWebKeySet] -> ShowS
$cshowList :: [CreateJsonWebKeySet] -> ShowS
show :: CreateJsonWebKeySet -> String
$cshow :: CreateJsonWebKeySet -> String
showsPrec :: Int -> CreateJsonWebKeySet -> ShowS
$cshowsPrec :: Int -> CreateJsonWebKeySet -> ShowS
P.Show, CreateJsonWebKeySet -> CreateJsonWebKeySet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJsonWebKeySet -> CreateJsonWebKeySet -> Bool
$c/= :: CreateJsonWebKeySet -> CreateJsonWebKeySet -> Bool
== :: CreateJsonWebKeySet -> CreateJsonWebKeySet -> Bool
$c== :: CreateJsonWebKeySet -> CreateJsonWebKeySet -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateJsonWebKeySet
instance A.FromJSON CreateJsonWebKeySet where
  parseJSON :: Value -> Parser CreateJsonWebKeySet
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CreateJsonWebKeySet" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Text -> CreateJsonWebKeySet
CreateJsonWebKeySet
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"alg")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"kid")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"use")

-- | ToJSON CreateJsonWebKeySet
instance A.ToJSON CreateJsonWebKeySet where
  toJSON :: CreateJsonWebKeySet -> Value
toJSON CreateJsonWebKeySet {Text
createJsonWebKeySetUse :: Text
createJsonWebKeySetKid :: Text
createJsonWebKeySetAlg :: Text
createJsonWebKeySetUse :: CreateJsonWebKeySet -> Text
createJsonWebKeySetKid :: CreateJsonWebKeySet -> Text
createJsonWebKeySetAlg :: CreateJsonWebKeySet -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
createJsonWebKeySetAlg
      , Key
"kid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
createJsonWebKeySetKid
      , Key
"use" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
createJsonWebKeySetUse
      ]


-- | Construct a value of type 'CreateJsonWebKeySet' (by applying it's required fields, if any)
mkCreateJsonWebKeySet
  :: Text -- ^ 'createJsonWebKeySetAlg': JSON Web Key Algorithm  The algorithm to be used for creating the key. Supports `RS256`, `ES256`, `ES512`, `HS512`, and `HS256`.
  -> Text -- ^ 'createJsonWebKeySetKid': JSON Web Key ID  The Key ID of the key to be created.
  -> Text -- ^ 'createJsonWebKeySetUse': JSON Web Key Use  The \"use\" (public key use) parameter identifies the intended use of the public key. The \"use\" parameter is employed to indicate whether a public key is used for encrypting data or verifying the signature on data. Valid values are \"enc\" and \"sig\".
  -> CreateJsonWebKeySet
mkCreateJsonWebKeySet :: Text -> Text -> Text -> CreateJsonWebKeySet
mkCreateJsonWebKeySet Text
createJsonWebKeySetAlg Text
createJsonWebKeySetKid Text
createJsonWebKeySetUse =
  CreateJsonWebKeySet
  { Text
createJsonWebKeySetAlg :: Text
createJsonWebKeySetAlg :: Text
createJsonWebKeySetAlg
  , Text
createJsonWebKeySetKid :: Text
createJsonWebKeySetKid :: Text
createJsonWebKeySetKid
  , Text
createJsonWebKeySetUse :: Text
createJsonWebKeySetUse :: Text
createJsonWebKeySetUse
  }

-- ** ErrorOAuth2
-- | ErrorOAuth2
-- Error
data ErrorOAuth2 = ErrorOAuth2
  { ErrorOAuth2 -> Maybe Text
errorOAuth2Error :: Maybe Text -- ^ "error" - Error
  , ErrorOAuth2 -> Maybe Text
errorOAuth2ErrorDebug :: Maybe Text -- ^ "error_debug" - Error Debug Information  Only available in dev mode.
  , ErrorOAuth2 -> Maybe Text
errorOAuth2ErrorDescription :: Maybe Text -- ^ "error_description" - Error Description
  , ErrorOAuth2 -> Maybe Text
errorOAuth2ErrorHint :: Maybe Text -- ^ "error_hint" - Error Hint  Helps the user identify the error cause.
  , ErrorOAuth2 -> Maybe Integer
errorOAuth2StatusCode :: Maybe Integer -- ^ "status_code" - HTTP Status Code
  } deriving (Int -> ErrorOAuth2 -> ShowS
[ErrorOAuth2] -> ShowS
ErrorOAuth2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorOAuth2] -> ShowS
$cshowList :: [ErrorOAuth2] -> ShowS
show :: ErrorOAuth2 -> String
$cshow :: ErrorOAuth2 -> String
showsPrec :: Int -> ErrorOAuth2 -> ShowS
$cshowsPrec :: Int -> ErrorOAuth2 -> ShowS
P.Show, ErrorOAuth2 -> ErrorOAuth2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorOAuth2 -> ErrorOAuth2 -> Bool
$c/= :: ErrorOAuth2 -> ErrorOAuth2 -> Bool
== :: ErrorOAuth2 -> ErrorOAuth2 -> Bool
$c== :: ErrorOAuth2 -> ErrorOAuth2 -> Bool
P.Eq, P.Typeable)

-- | FromJSON ErrorOAuth2
instance A.FromJSON ErrorOAuth2 where
  parseJSON :: Value -> Parser ErrorOAuth2
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ErrorOAuth2" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> ErrorOAuth2
ErrorOAuth2
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_debug")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_description")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_hint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status_code")

-- | ToJSON ErrorOAuth2
instance A.ToJSON ErrorOAuth2 where
  toJSON :: ErrorOAuth2 -> Value
toJSON ErrorOAuth2 {Maybe Integer
Maybe Text
errorOAuth2StatusCode :: Maybe Integer
errorOAuth2ErrorHint :: Maybe Text
errorOAuth2ErrorDescription :: Maybe Text
errorOAuth2ErrorDebug :: Maybe Text
errorOAuth2Error :: Maybe Text
errorOAuth2StatusCode :: ErrorOAuth2 -> Maybe Integer
errorOAuth2ErrorHint :: ErrorOAuth2 -> Maybe Text
errorOAuth2ErrorDescription :: ErrorOAuth2 -> Maybe Text
errorOAuth2ErrorDebug :: ErrorOAuth2 -> Maybe Text
errorOAuth2Error :: ErrorOAuth2 -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
errorOAuth2Error
      , Key
"error_debug" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
errorOAuth2ErrorDebug
      , Key
"error_description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
errorOAuth2ErrorDescription
      , Key
"error_hint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
errorOAuth2ErrorHint
      , Key
"status_code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
errorOAuth2StatusCode
      ]


-- | Construct a value of type 'ErrorOAuth2' (by applying it's required fields, if any)
mkErrorOAuth2
  :: ErrorOAuth2
mkErrorOAuth2 :: ErrorOAuth2
mkErrorOAuth2 =
  ErrorOAuth2
  { errorOAuth2Error :: Maybe Text
errorOAuth2Error = forall a. Maybe a
Nothing
  , errorOAuth2ErrorDebug :: Maybe Text
errorOAuth2ErrorDebug = forall a. Maybe a
Nothing
  , errorOAuth2ErrorDescription :: Maybe Text
errorOAuth2ErrorDescription = forall a. Maybe a
Nothing
  , errorOAuth2ErrorHint :: Maybe Text
errorOAuth2ErrorHint = forall a. Maybe a
Nothing
  , errorOAuth2StatusCode :: Maybe Integer
errorOAuth2StatusCode = forall a. Maybe a
Nothing
  }

-- ** GenericError
-- | GenericError
data GenericError = GenericError
  { GenericError -> Maybe Integer
genericErrorCode :: Maybe Integer -- ^ "code" - The status code
  , GenericError -> Maybe Text
genericErrorDebug :: Maybe Text -- ^ "debug" - Debug information  This field is often not exposed to protect against leaking sensitive information.
  , GenericError -> Maybe Value
genericErrorDetails :: Maybe A.Value -- ^ "details" - Further error details
  , GenericError -> Maybe Text
genericErrorId :: Maybe Text -- ^ "id" - The error ID  Useful when trying to identify various errors in application logic.
  , GenericError -> Text
genericErrorMessage :: Text -- ^ /Required/ "message" - Error message  The error&#39;s message.
  , GenericError -> Maybe Text
genericErrorReason :: Maybe Text -- ^ "reason" - A human-readable reason for the error
  , GenericError -> Maybe Text
genericErrorRequest :: Maybe Text -- ^ "request" - The request ID  The request ID is often exposed internally in order to trace errors across service architectures. This is often a UUID.
  , GenericError -> Maybe Text
genericErrorStatus :: Maybe Text -- ^ "status" - The status description
  } deriving (Int -> GenericError -> ShowS
[GenericError] -> ShowS
GenericError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericError] -> ShowS
$cshowList :: [GenericError] -> ShowS
show :: GenericError -> String
$cshow :: GenericError -> String
showsPrec :: Int -> GenericError -> ShowS
$cshowsPrec :: Int -> GenericError -> ShowS
P.Show, GenericError -> GenericError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericError -> GenericError -> Bool
$c/= :: GenericError -> GenericError -> Bool
== :: GenericError -> GenericError -> Bool
$c== :: GenericError -> GenericError -> Bool
P.Eq, P.Typeable)

-- | FromJSON GenericError
instance A.FromJSON GenericError where
  parseJSON :: Value -> Parser GenericError
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"GenericError" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> GenericError
GenericError
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"debug")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"details")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"message")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reason")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status")

-- | ToJSON GenericError
instance A.ToJSON GenericError where
  toJSON :: GenericError -> Value
toJSON GenericError {Maybe Integer
Maybe Text
Maybe Value
Text
genericErrorStatus :: Maybe Text
genericErrorRequest :: Maybe Text
genericErrorReason :: Maybe Text
genericErrorMessage :: Text
genericErrorId :: Maybe Text
genericErrorDetails :: Maybe Value
genericErrorDebug :: Maybe Text
genericErrorCode :: Maybe Integer
genericErrorStatus :: GenericError -> Maybe Text
genericErrorRequest :: GenericError -> Maybe Text
genericErrorReason :: GenericError -> Maybe Text
genericErrorMessage :: GenericError -> Text
genericErrorId :: GenericError -> Maybe Text
genericErrorDetails :: GenericError -> Maybe Value
genericErrorDebug :: GenericError -> Maybe Text
genericErrorCode :: GenericError -> Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
genericErrorCode
      , Key
"debug" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
genericErrorDebug
      , Key
"details" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
genericErrorDetails
      , Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
genericErrorId
      , Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
genericErrorMessage
      , Key
"reason" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
genericErrorReason
      , Key
"request" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
genericErrorRequest
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
genericErrorStatus
      ]


-- | Construct a value of type 'GenericError' (by applying it's required fields, if any)
mkGenericError
  :: Text -- ^ 'genericErrorMessage': Error message  The error's message.
  -> GenericError
mkGenericError :: Text -> GenericError
mkGenericError Text
genericErrorMessage =
  GenericError
  { genericErrorCode :: Maybe Integer
genericErrorCode = forall a. Maybe a
Nothing
  , genericErrorDebug :: Maybe Text
genericErrorDebug = forall a. Maybe a
Nothing
  , genericErrorDetails :: Maybe Value
genericErrorDetails = forall a. Maybe a
Nothing
  , genericErrorId :: Maybe Text
genericErrorId = forall a. Maybe a
Nothing
  , Text
genericErrorMessage :: Text
genericErrorMessage :: Text
genericErrorMessage
  , genericErrorReason :: Maybe Text
genericErrorReason = forall a. Maybe a
Nothing
  , genericErrorRequest :: Maybe Text
genericErrorRequest = forall a. Maybe a
Nothing
  , genericErrorStatus :: Maybe Text
genericErrorStatus = forall a. Maybe a
Nothing
  }

-- ** GetVersion200Response
-- | GetVersion200Response
data GetVersion200Response = GetVersion200Response
  { GetVersion200Response -> Maybe Text
getVersion200ResponseVersion :: Maybe Text -- ^ "version" - The version of Ory Hydra.
  } deriving (Int -> GetVersion200Response -> ShowS
[GetVersion200Response] -> ShowS
GetVersion200Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVersion200Response] -> ShowS
$cshowList :: [GetVersion200Response] -> ShowS
show :: GetVersion200Response -> String
$cshow :: GetVersion200Response -> String
showsPrec :: Int -> GetVersion200Response -> ShowS
$cshowsPrec :: Int -> GetVersion200Response -> ShowS
P.Show, GetVersion200Response -> GetVersion200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVersion200Response -> GetVersion200Response -> Bool
$c/= :: GetVersion200Response -> GetVersion200Response -> Bool
== :: GetVersion200Response -> GetVersion200Response -> Bool
$c== :: GetVersion200Response -> GetVersion200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON GetVersion200Response
instance A.FromJSON GetVersion200Response where
  parseJSON :: Value -> Parser GetVersion200Response
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"GetVersion200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> GetVersion200Response
GetVersion200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")

-- | ToJSON GetVersion200Response
instance A.ToJSON GetVersion200Response where
  toJSON :: GetVersion200Response -> Value
toJSON GetVersion200Response {Maybe Text
getVersion200ResponseVersion :: Maybe Text
getVersion200ResponseVersion :: GetVersion200Response -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
getVersion200ResponseVersion
      ]


-- | Construct a value of type 'GetVersion200Response' (by applying it's required fields, if any)
mkGetVersion200Response
  :: GetVersion200Response
mkGetVersion200Response :: GetVersion200Response
mkGetVersion200Response =
  GetVersion200Response
  { getVersion200ResponseVersion :: Maybe Text
getVersion200ResponseVersion = forall a. Maybe a
Nothing
  }

-- ** HealthNotReadyStatus
-- | HealthNotReadyStatus
data HealthNotReadyStatus = HealthNotReadyStatus
  { HealthNotReadyStatus -> Maybe (Map String Text)
healthNotReadyStatusErrors :: Maybe (Map.Map String Text) -- ^ "errors" - Errors contains a list of errors that caused the not ready status.
  } deriving (Int -> HealthNotReadyStatus -> ShowS
[HealthNotReadyStatus] -> ShowS
HealthNotReadyStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HealthNotReadyStatus] -> ShowS
$cshowList :: [HealthNotReadyStatus] -> ShowS
show :: HealthNotReadyStatus -> String
$cshow :: HealthNotReadyStatus -> String
showsPrec :: Int -> HealthNotReadyStatus -> ShowS
$cshowsPrec :: Int -> HealthNotReadyStatus -> ShowS
P.Show, HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
$c/= :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
== :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
$c== :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
P.Eq, P.Typeable)

-- | FromJSON HealthNotReadyStatus
instance A.FromJSON HealthNotReadyStatus where
  parseJSON :: Value -> Parser HealthNotReadyStatus
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HealthNotReadyStatus" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe (Map String Text) -> HealthNotReadyStatus
HealthNotReadyStatus
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"errors")

-- | ToJSON HealthNotReadyStatus
instance A.ToJSON HealthNotReadyStatus where
  toJSON :: HealthNotReadyStatus -> Value
toJSON HealthNotReadyStatus {Maybe (Map String Text)
healthNotReadyStatusErrors :: Maybe (Map String Text)
healthNotReadyStatusErrors :: HealthNotReadyStatus -> Maybe (Map String Text)
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"errors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String Text)
healthNotReadyStatusErrors
      ]


-- | Construct a value of type 'HealthNotReadyStatus' (by applying it's required fields, if any)
mkHealthNotReadyStatus
  :: HealthNotReadyStatus
mkHealthNotReadyStatus :: HealthNotReadyStatus
mkHealthNotReadyStatus =
  HealthNotReadyStatus
  { healthNotReadyStatusErrors :: Maybe (Map String Text)
healthNotReadyStatusErrors = forall a. Maybe a
Nothing
  }

-- ** HealthStatus
-- | HealthStatus
data HealthStatus = HealthStatus
  { HealthStatus -> Maybe Text
healthStatusStatus :: Maybe Text -- ^ "status" - Status always contains \&quot;ok\&quot;.
  } deriving (Int -> HealthStatus -> ShowS
[HealthStatus] -> ShowS
HealthStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HealthStatus] -> ShowS
$cshowList :: [HealthStatus] -> ShowS
show :: HealthStatus -> String
$cshow :: HealthStatus -> String
showsPrec :: Int -> HealthStatus -> ShowS
$cshowsPrec :: Int -> HealthStatus -> ShowS
P.Show, HealthStatus -> HealthStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthStatus -> HealthStatus -> Bool
$c/= :: HealthStatus -> HealthStatus -> Bool
== :: HealthStatus -> HealthStatus -> Bool
$c== :: HealthStatus -> HealthStatus -> Bool
P.Eq, P.Typeable)

-- | FromJSON HealthStatus
instance A.FromJSON HealthStatus where
  parseJSON :: Value -> Parser HealthStatus
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HealthStatus" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> HealthStatus
HealthStatus
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status")

-- | ToJSON HealthStatus
instance A.ToJSON HealthStatus where
  toJSON :: HealthStatus -> Value
toJSON HealthStatus {Maybe Text
healthStatusStatus :: Maybe Text
healthStatusStatus :: HealthStatus -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
healthStatusStatus
      ]


-- | Construct a value of type 'HealthStatus' (by applying it's required fields, if any)
mkHealthStatus
  :: HealthStatus
mkHealthStatus :: HealthStatus
mkHealthStatus =
  HealthStatus
  { healthStatusStatus :: Maybe Text
healthStatusStatus = forall a. Maybe a
Nothing
  }

-- ** IntrospectedOAuth2Token
-- | IntrospectedOAuth2Token
-- Introspection contains an access token's session data as specified by [IETF RFC 7662](https://tools.ietf.org/html/rfc7662)
data IntrospectedOAuth2Token = IntrospectedOAuth2Token
  { IntrospectedOAuth2Token -> Bool
introspectedOAuth2TokenActive :: Bool -- ^ /Required/ "active" - Active is a boolean indicator of whether or not the presented token is currently active.  The specifics of a token&#39;s \&quot;active\&quot; state will vary depending on the implementation of the authorization server and the information it keeps about its tokens, but a \&quot;true\&quot; value return for the \&quot;active\&quot; property will generally indicate that a given token has been issued by this authorization server, has not been revoked by the resource owner, and is within its given time window of validity (e.g., after its issuance time and before its expiration time).
  , IntrospectedOAuth2Token -> Maybe [Text]
introspectedOAuth2TokenAud :: Maybe [Text] -- ^ "aud" - Audience contains a list of the token&#39;s intended audiences.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenClientId :: Maybe Text -- ^ "client_id" - ID is aclient identifier for the OAuth 2.0 client that requested this token.
  , IntrospectedOAuth2Token -> Maybe Integer
introspectedOAuth2TokenExp :: Maybe Integer -- ^ "exp" - Expires at is an integer timestamp, measured in the number of seconds since January 1 1970 UTC, indicating when this token will expire.
  , IntrospectedOAuth2Token -> Maybe (Map String Value)
introspectedOAuth2TokenExt :: Maybe (Map.Map String A.Value) -- ^ "ext" - Extra is arbitrary data set by the session.
  , IntrospectedOAuth2Token -> Maybe Integer
introspectedOAuth2TokenIat :: Maybe Integer -- ^ "iat" - Issued at is an integer timestamp, measured in the number of seconds since January 1 1970 UTC, indicating when this token was originally issued.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenIss :: Maybe Text -- ^ "iss" - IssuerURL is a string representing the issuer of this token
  , IntrospectedOAuth2Token -> Maybe Integer
introspectedOAuth2TokenNbf :: Maybe Integer -- ^ "nbf" - NotBefore is an integer timestamp, measured in the number of seconds since January 1 1970 UTC, indicating when this token is not to be used before.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenObfuscatedSubject :: Maybe Text -- ^ "obfuscated_subject" - ObfuscatedSubject is set when the subject identifier algorithm was set to \&quot;pairwise\&quot; during authorization. It is the &#x60;sub&#x60; value of the ID Token that was issued.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenScope :: Maybe Text -- ^ "scope" - Scope is a JSON string containing a space-separated list of scopes associated with this token.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenSub :: Maybe Text -- ^ "sub" - Subject of the token, as defined in JWT [RFC7519]. Usually a machine-readable identifier of the resource owner who authorized this token.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenTokenType :: Maybe Text -- ^ "token_type" - TokenType is the introspected token&#39;s type, typically &#x60;Bearer&#x60;.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenTokenUse :: Maybe Text -- ^ "token_use" - TokenUse is the introspected token&#39;s use, for example &#x60;access_token&#x60; or &#x60;refresh_token&#x60;.
  , IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenUsername :: Maybe Text -- ^ "username" - Username is a human-readable identifier for the resource owner who authorized this token.
  } deriving (Int -> IntrospectedOAuth2Token -> ShowS
[IntrospectedOAuth2Token] -> ShowS
IntrospectedOAuth2Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntrospectedOAuth2Token] -> ShowS
$cshowList :: [IntrospectedOAuth2Token] -> ShowS
show :: IntrospectedOAuth2Token -> String
$cshow :: IntrospectedOAuth2Token -> String
showsPrec :: Int -> IntrospectedOAuth2Token -> ShowS
$cshowsPrec :: Int -> IntrospectedOAuth2Token -> ShowS
P.Show, IntrospectedOAuth2Token -> IntrospectedOAuth2Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntrospectedOAuth2Token -> IntrospectedOAuth2Token -> Bool
$c/= :: IntrospectedOAuth2Token -> IntrospectedOAuth2Token -> Bool
== :: IntrospectedOAuth2Token -> IntrospectedOAuth2Token -> Bool
$c== :: IntrospectedOAuth2Token -> IntrospectedOAuth2Token -> Bool
P.Eq, P.Typeable)

-- | FromJSON IntrospectedOAuth2Token
instance A.FromJSON IntrospectedOAuth2Token where
  parseJSON :: Value -> Parser IntrospectedOAuth2Token
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IntrospectedOAuth2Token" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe Integer
-> Maybe (Map String Value)
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> IntrospectedOAuth2Token
IntrospectedOAuth2Token
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"active")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aud")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exp")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ext")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"iat")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"iss")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nbf")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"obfuscated_subject")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sub")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_type")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_use")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")

-- | ToJSON IntrospectedOAuth2Token
instance A.ToJSON IntrospectedOAuth2Token where
  toJSON :: IntrospectedOAuth2Token -> Value
toJSON IntrospectedOAuth2Token {Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe (Map String Value)
introspectedOAuth2TokenUsername :: Maybe Text
introspectedOAuth2TokenTokenUse :: Maybe Text
introspectedOAuth2TokenTokenType :: Maybe Text
introspectedOAuth2TokenSub :: Maybe Text
introspectedOAuth2TokenScope :: Maybe Text
introspectedOAuth2TokenObfuscatedSubject :: Maybe Text
introspectedOAuth2TokenNbf :: Maybe Integer
introspectedOAuth2TokenIss :: Maybe Text
introspectedOAuth2TokenIat :: Maybe Integer
introspectedOAuth2TokenExt :: Maybe (Map String Value)
introspectedOAuth2TokenExp :: Maybe Integer
introspectedOAuth2TokenClientId :: Maybe Text
introspectedOAuth2TokenAud :: Maybe [Text]
introspectedOAuth2TokenActive :: Bool
introspectedOAuth2TokenUsername :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenTokenUse :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenTokenType :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenSub :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenScope :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenObfuscatedSubject :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenNbf :: IntrospectedOAuth2Token -> Maybe Integer
introspectedOAuth2TokenIss :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenIat :: IntrospectedOAuth2Token -> Maybe Integer
introspectedOAuth2TokenExt :: IntrospectedOAuth2Token -> Maybe (Map String Value)
introspectedOAuth2TokenExp :: IntrospectedOAuth2Token -> Maybe Integer
introspectedOAuth2TokenClientId :: IntrospectedOAuth2Token -> Maybe Text
introspectedOAuth2TokenAud :: IntrospectedOAuth2Token -> Maybe [Text]
introspectedOAuth2TokenActive :: IntrospectedOAuth2Token -> Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"active" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
introspectedOAuth2TokenActive
      , Key
"aud" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
introspectedOAuth2TokenAud
      , Key
"client_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenClientId
      , Key
"exp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
introspectedOAuth2TokenExp
      , Key
"ext" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String Value)
introspectedOAuth2TokenExt
      , Key
"iat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
introspectedOAuth2TokenIat
      , Key
"iss" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenIss
      , Key
"nbf" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
introspectedOAuth2TokenNbf
      , Key
"obfuscated_subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenObfuscatedSubject
      , Key
"scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenScope
      , Key
"sub" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenSub
      , Key
"token_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenTokenType
      , Key
"token_use" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenTokenUse
      , Key
"username" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
introspectedOAuth2TokenUsername
      ]


-- | Construct a value of type 'IntrospectedOAuth2Token' (by applying it's required fields, if any)
mkIntrospectedOAuth2Token
  :: Bool -- ^ 'introspectedOAuth2TokenActive': Active is a boolean indicator of whether or not the presented token is currently active.  The specifics of a token's \"active\" state will vary depending on the implementation of the authorization server and the information it keeps about its tokens, but a \"true\" value return for the \"active\" property will generally indicate that a given token has been issued by this authorization server, has not been revoked by the resource owner, and is within its given time window of validity (e.g., after its issuance time and before its expiration time).
  -> IntrospectedOAuth2Token
mkIntrospectedOAuth2Token :: Bool -> IntrospectedOAuth2Token
mkIntrospectedOAuth2Token Bool
introspectedOAuth2TokenActive =
  IntrospectedOAuth2Token
  { Bool
introspectedOAuth2TokenActive :: Bool
introspectedOAuth2TokenActive :: Bool
introspectedOAuth2TokenActive
  , introspectedOAuth2TokenAud :: Maybe [Text]
introspectedOAuth2TokenAud = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenClientId :: Maybe Text
introspectedOAuth2TokenClientId = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenExp :: Maybe Integer
introspectedOAuth2TokenExp = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenExt :: Maybe (Map String Value)
introspectedOAuth2TokenExt = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenIat :: Maybe Integer
introspectedOAuth2TokenIat = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenIss :: Maybe Text
introspectedOAuth2TokenIss = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenNbf :: Maybe Integer
introspectedOAuth2TokenNbf = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenObfuscatedSubject :: Maybe Text
introspectedOAuth2TokenObfuscatedSubject = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenScope :: Maybe Text
introspectedOAuth2TokenScope = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenSub :: Maybe Text
introspectedOAuth2TokenSub = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenTokenType :: Maybe Text
introspectedOAuth2TokenTokenType = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenTokenUse :: Maybe Text
introspectedOAuth2TokenTokenUse = forall a. Maybe a
Nothing
  , introspectedOAuth2TokenUsername :: Maybe Text
introspectedOAuth2TokenUsername = forall a. Maybe a
Nothing
  }

-- ** IsReady200Response
-- | IsReady200Response
data IsReady200Response = IsReady200Response
  { IsReady200Response -> Maybe Text
isReady200ResponseStatus :: Maybe Text -- ^ "status" - Always \&quot;ok\&quot;.
  } deriving (Int -> IsReady200Response -> ShowS
[IsReady200Response] -> ShowS
IsReady200Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsReady200Response] -> ShowS
$cshowList :: [IsReady200Response] -> ShowS
show :: IsReady200Response -> String
$cshow :: IsReady200Response -> String
showsPrec :: Int -> IsReady200Response -> ShowS
$cshowsPrec :: Int -> IsReady200Response -> ShowS
P.Show, IsReady200Response -> IsReady200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsReady200Response -> IsReady200Response -> Bool
$c/= :: IsReady200Response -> IsReady200Response -> Bool
== :: IsReady200Response -> IsReady200Response -> Bool
$c== :: IsReady200Response -> IsReady200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON IsReady200Response
instance A.FromJSON IsReady200Response where
  parseJSON :: Value -> Parser IsReady200Response
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IsReady200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> IsReady200Response
IsReady200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status")

-- | ToJSON IsReady200Response
instance A.ToJSON IsReady200Response where
  toJSON :: IsReady200Response -> Value
toJSON IsReady200Response {Maybe Text
isReady200ResponseStatus :: Maybe Text
isReady200ResponseStatus :: IsReady200Response -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
isReady200ResponseStatus
      ]


-- | Construct a value of type 'IsReady200Response' (by applying it's required fields, if any)
mkIsReady200Response
  :: IsReady200Response
mkIsReady200Response :: IsReady200Response
mkIsReady200Response =
  IsReady200Response
  { isReady200ResponseStatus :: Maybe Text
isReady200ResponseStatus = forall a. Maybe a
Nothing
  }

-- ** IsReady503Response
-- | IsReady503Response
data IsReady503Response = IsReady503Response
  { IsReady503Response -> Maybe (Map String Text)
isReady503ResponseErrors :: Maybe (Map.Map String Text) -- ^ "errors" - Errors contains a list of errors that caused the not ready status.
  } deriving (Int -> IsReady503Response -> ShowS
[IsReady503Response] -> ShowS
IsReady503Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsReady503Response] -> ShowS
$cshowList :: [IsReady503Response] -> ShowS
show :: IsReady503Response -> String
$cshow :: IsReady503Response -> String
showsPrec :: Int -> IsReady503Response -> ShowS
$cshowsPrec :: Int -> IsReady503Response -> ShowS
P.Show, IsReady503Response -> IsReady503Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsReady503Response -> IsReady503Response -> Bool
$c/= :: IsReady503Response -> IsReady503Response -> Bool
== :: IsReady503Response -> IsReady503Response -> Bool
$c== :: IsReady503Response -> IsReady503Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON IsReady503Response
instance A.FromJSON IsReady503Response where
  parseJSON :: Value -> Parser IsReady503Response
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IsReady503Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe (Map String Text) -> IsReady503Response
IsReady503Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"errors")

-- | ToJSON IsReady503Response
instance A.ToJSON IsReady503Response where
  toJSON :: IsReady503Response -> Value
toJSON IsReady503Response {Maybe (Map String Text)
isReady503ResponseErrors :: Maybe (Map String Text)
isReady503ResponseErrors :: IsReady503Response -> Maybe (Map String Text)
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"errors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String Text)
isReady503ResponseErrors
      ]


-- | Construct a value of type 'IsReady503Response' (by applying it's required fields, if any)
mkIsReady503Response
  :: IsReady503Response
mkIsReady503Response :: IsReady503Response
mkIsReady503Response =
  IsReady503Response
  { isReady503ResponseErrors :: Maybe (Map String Text)
isReady503ResponseErrors = forall a. Maybe a
Nothing
  }

-- ** JsonPatch
-- | JsonPatch
-- A JSONPatch document as defined by RFC 6902
data JsonPatch = JsonPatch
  { JsonPatch -> Maybe Text
jsonPatchFrom :: Maybe Text -- ^ "from" - This field is used together with operation \&quot;move\&quot; and uses JSON Pointer notation.  Learn more [about JSON Pointers](https://datatracker.ietf.org/doc/html/rfc6901#section-5).
  , JsonPatch -> Text
jsonPatchOp :: Text -- ^ /Required/ "op" - The operation to be performed. One of \&quot;add\&quot;, \&quot;remove\&quot;, \&quot;replace\&quot;, \&quot;move\&quot;, \&quot;copy\&quot;, or \&quot;test\&quot;.
  , JsonPatch -> Text
jsonPatchPath :: Text -- ^ /Required/ "path" - The path to the target path. Uses JSON pointer notation.  Learn more [about JSON Pointers](https://datatracker.ietf.org/doc/html/rfc6901#section-5).
  , JsonPatch -> Maybe Value
jsonPatchValue :: Maybe A.Value -- ^ "value" - The value to be used within the operations.  Learn more [about JSON Pointers](https://datatracker.ietf.org/doc/html/rfc6901#section-5).
  } deriving (Int -> JsonPatch -> ShowS
[JsonPatch] -> ShowS
JsonPatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonPatch] -> ShowS
$cshowList :: [JsonPatch] -> ShowS
show :: JsonPatch -> String
$cshow :: JsonPatch -> String
showsPrec :: Int -> JsonPatch -> ShowS
$cshowsPrec :: Int -> JsonPatch -> ShowS
P.Show, JsonPatch -> JsonPatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonPatch -> JsonPatch -> Bool
$c/= :: JsonPatch -> JsonPatch -> Bool
== :: JsonPatch -> JsonPatch -> Bool
$c== :: JsonPatch -> JsonPatch -> Bool
P.Eq, P.Typeable)

-- | FromJSON JsonPatch
instance A.FromJSON JsonPatch where
  parseJSON :: Value -> Parser JsonPatch
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"JsonPatch" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Text -> Text -> Maybe Value -> JsonPatch
JsonPatch
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"from")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"op")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"path")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value")

-- | ToJSON JsonPatch
instance A.ToJSON JsonPatch where
  toJSON :: JsonPatch -> Value
toJSON JsonPatch {Maybe Text
Maybe Value
Text
jsonPatchValue :: Maybe Value
jsonPatchPath :: Text
jsonPatchOp :: Text
jsonPatchFrom :: Maybe Text
jsonPatchValue :: JsonPatch -> Maybe Value
jsonPatchPath :: JsonPatch -> Text
jsonPatchOp :: JsonPatch -> Text
jsonPatchFrom :: JsonPatch -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"from" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonPatchFrom
      , Key
"op" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonPatchOp
      , Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonPatchPath
      , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
jsonPatchValue
      ]


-- | Construct a value of type 'JsonPatch' (by applying it's required fields, if any)
mkJsonPatch
  :: Text -- ^ 'jsonPatchOp': The operation to be performed. One of \"add\", \"remove\", \"replace\", \"move\", \"copy\", or \"test\".
  -> Text -- ^ 'jsonPatchPath': The path to the target path. Uses JSON pointer notation.  Learn more [about JSON Pointers](https://datatracker.ietf.org/doc/html/rfc6901#section-5).
  -> JsonPatch
mkJsonPatch :: Text -> Text -> JsonPatch
mkJsonPatch Text
jsonPatchOp Text
jsonPatchPath =
  JsonPatch
  { jsonPatchFrom :: Maybe Text
jsonPatchFrom = forall a. Maybe a
Nothing
  , Text
jsonPatchOp :: Text
jsonPatchOp :: Text
jsonPatchOp
  , Text
jsonPatchPath :: Text
jsonPatchPath :: Text
jsonPatchPath
  , jsonPatchValue :: Maybe Value
jsonPatchValue = forall a. Maybe a
Nothing
  }

-- ** JsonWebKey
-- | JsonWebKey
data JsonWebKey = JsonWebKey
  { JsonWebKey -> Text
jsonWebKeyAlg :: Text -- ^ /Required/ "alg" - The \&quot;alg\&quot; (algorithm) parameter identifies the algorithm intended for use with the key.  The values used should either be registered in the IANA \&quot;JSON Web Signature and Encryption Algorithms\&quot; registry established by [JWA] or be a value that contains a Collision- Resistant Name.
  , JsonWebKey -> Maybe Text
jsonWebKeyCrv :: Maybe Text -- ^ "crv"
  , JsonWebKey -> Maybe Text
jsonWebKeyD :: Maybe Text -- ^ "d"
  , JsonWebKey -> Maybe Text
jsonWebKeyDp :: Maybe Text -- ^ "dp"
  , JsonWebKey -> Maybe Text
jsonWebKeyDq :: Maybe Text -- ^ "dq"
  , JsonWebKey -> Maybe Text
jsonWebKeyE :: Maybe Text -- ^ "e"
  , JsonWebKey -> Maybe Text
jsonWebKeyK :: Maybe Text -- ^ "k"
  , JsonWebKey -> Text
jsonWebKeyKid :: Text -- ^ /Required/ "kid" - The \&quot;kid\&quot; (key ID) parameter is used to match a specific key.  This is used, for instance, to choose among a set of keys within a JWK Set during key rollover.  The structure of the \&quot;kid\&quot; value is unspecified.  When \&quot;kid\&quot; values are used within a JWK Set, different keys within the JWK Set SHOULD use distinct \&quot;kid\&quot; values.  (One example in which different keys might use the same \&quot;kid\&quot; value is if they have different \&quot;kty\&quot; (key type) values but are considered to be equivalent alternatives by the application using them.)  The \&quot;kid\&quot; value is a case-sensitive string.
  , JsonWebKey -> Text
jsonWebKeyKty :: Text -- ^ /Required/ "kty" - The \&quot;kty\&quot; (key type) parameter identifies the cryptographic algorithm family used with the key, such as \&quot;RSA\&quot; or \&quot;EC\&quot;. \&quot;kty\&quot; values should either be registered in the IANA \&quot;JSON Web Key Types\&quot; registry established by [JWA] or be a value that contains a Collision- Resistant Name.  The \&quot;kty\&quot; value is a case-sensitive string.
  , JsonWebKey -> Maybe Text
jsonWebKeyN :: Maybe Text -- ^ "n"
  , JsonWebKey -> Maybe Text
jsonWebKeyP :: Maybe Text -- ^ "p"
  , JsonWebKey -> Maybe Text
jsonWebKeyQ :: Maybe Text -- ^ "q"
  , JsonWebKey -> Maybe Text
jsonWebKeyQi :: Maybe Text -- ^ "qi"
  , JsonWebKey -> Text
jsonWebKeyUse :: Text -- ^ /Required/ "use" - Use (\&quot;public key use\&quot;) identifies the intended use of the public key. The \&quot;use\&quot; parameter is employed to indicate whether a public key is used for encrypting data or verifying the signature on data. Values are commonly \&quot;sig\&quot; (signature) or \&quot;enc\&quot; (encryption).
  , JsonWebKey -> Maybe Text
jsonWebKeyX :: Maybe Text -- ^ "x"
  , JsonWebKey -> Maybe [Text]
jsonWebKeyX5c :: Maybe [Text] -- ^ "x5c" - The \&quot;x5c\&quot; (X.509 certificate chain) parameter contains a chain of one or more PKIX certificates [RFC5280].  The certificate chain is represented as a JSON array of certificate value strings.  Each string in the array is a base64-encoded (Section 4 of [RFC4648] -- not base64url-encoded) DER [ITU.X690.1994] PKIX certificate value. The PKIX certificate containing the key value MUST be the first certificate.
  , JsonWebKey -> Maybe Text
jsonWebKeyY :: Maybe Text -- ^ "y"
  } deriving (Int -> JsonWebKey -> ShowS
[JsonWebKey] -> ShowS
JsonWebKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonWebKey] -> ShowS
$cshowList :: [JsonWebKey] -> ShowS
show :: JsonWebKey -> String
$cshow :: JsonWebKey -> String
showsPrec :: Int -> JsonWebKey -> ShowS
$cshowsPrec :: Int -> JsonWebKey -> ShowS
P.Show, JsonWebKey -> JsonWebKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonWebKey -> JsonWebKey -> Bool
$c/= :: JsonWebKey -> JsonWebKey -> Bool
== :: JsonWebKey -> JsonWebKey -> Bool
$c== :: JsonWebKey -> JsonWebKey -> Bool
P.Eq, P.Typeable)

-- | FromJSON JsonWebKey
instance A.FromJSON JsonWebKey where
  parseJSON :: Value -> Parser JsonWebKey
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"JsonWebKey" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> JsonWebKey
JsonWebKey
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"alg")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"crv")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"d")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dp")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dq")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"e")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"k")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"kid")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"kty")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"n")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"p")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"q")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"qi")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"use")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x5c")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"y")

-- | ToJSON JsonWebKey
instance A.ToJSON JsonWebKey where
  toJSON :: JsonWebKey -> Value
toJSON JsonWebKey {Maybe [Text]
Maybe Text
Text
jsonWebKeyY :: Maybe Text
jsonWebKeyX5c :: Maybe [Text]
jsonWebKeyX :: Maybe Text
jsonWebKeyUse :: Text
jsonWebKeyQi :: Maybe Text
jsonWebKeyQ :: Maybe Text
jsonWebKeyP :: Maybe Text
jsonWebKeyN :: Maybe Text
jsonWebKeyKty :: Text
jsonWebKeyKid :: Text
jsonWebKeyK :: Maybe Text
jsonWebKeyE :: Maybe Text
jsonWebKeyDq :: Maybe Text
jsonWebKeyDp :: Maybe Text
jsonWebKeyD :: Maybe Text
jsonWebKeyCrv :: Maybe Text
jsonWebKeyAlg :: Text
jsonWebKeyY :: JsonWebKey -> Maybe Text
jsonWebKeyX5c :: JsonWebKey -> Maybe [Text]
jsonWebKeyX :: JsonWebKey -> Maybe Text
jsonWebKeyUse :: JsonWebKey -> Text
jsonWebKeyQi :: JsonWebKey -> Maybe Text
jsonWebKeyQ :: JsonWebKey -> Maybe Text
jsonWebKeyP :: JsonWebKey -> Maybe Text
jsonWebKeyN :: JsonWebKey -> Maybe Text
jsonWebKeyKty :: JsonWebKey -> Text
jsonWebKeyKid :: JsonWebKey -> Text
jsonWebKeyK :: JsonWebKey -> Maybe Text
jsonWebKeyE :: JsonWebKey -> Maybe Text
jsonWebKeyDq :: JsonWebKey -> Maybe Text
jsonWebKeyDp :: JsonWebKey -> Maybe Text
jsonWebKeyD :: JsonWebKey -> Maybe Text
jsonWebKeyCrv :: JsonWebKey -> Maybe Text
jsonWebKeyAlg :: JsonWebKey -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonWebKeyAlg
      , Key
"crv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyCrv
      , Key
"d" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyD
      , Key
"dp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyDp
      , Key
"dq" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyDq
      , Key
"e" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyE
      , Key
"k" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyK
      , Key
"kid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonWebKeyKid
      , Key
"kty" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonWebKeyKty
      , Key
"n" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyN
      , Key
"p" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyP
      , Key
"q" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyQ
      , Key
"qi" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyQi
      , Key
"use" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonWebKeyUse
      , Key
"x" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyX
      , Key
"x5c" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
jsonWebKeyX5c
      , Key
"y" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jsonWebKeyY
      ]


-- | Construct a value of type 'JsonWebKey' (by applying it's required fields, if any)
mkJsonWebKey
  :: Text -- ^ 'jsonWebKeyAlg': The \"alg\" (algorithm) parameter identifies the algorithm intended for use with the key.  The values used should either be registered in the IANA \"JSON Web Signature and Encryption Algorithms\" registry established by [JWA] or be a value that contains a Collision- Resistant Name.
  -> Text -- ^ 'jsonWebKeyKid': The \"kid\" (key ID) parameter is used to match a specific key.  This is used, for instance, to choose among a set of keys within a JWK Set during key rollover.  The structure of the \"kid\" value is unspecified.  When \"kid\" values are used within a JWK Set, different keys within the JWK Set SHOULD use distinct \"kid\" values.  (One example in which different keys might use the same \"kid\" value is if they have different \"kty\" (key type) values but are considered to be equivalent alternatives by the application using them.)  The \"kid\" value is a case-sensitive string.
  -> Text -- ^ 'jsonWebKeyKty': The \"kty\" (key type) parameter identifies the cryptographic algorithm family used with the key, such as \"RSA\" or \"EC\". \"kty\" values should either be registered in the IANA \"JSON Web Key Types\" registry established by [JWA] or be a value that contains a Collision- Resistant Name.  The \"kty\" value is a case-sensitive string.
  -> Text -- ^ 'jsonWebKeyUse': Use (\"public key use\") identifies the intended use of the public key. The \"use\" parameter is employed to indicate whether a public key is used for encrypting data or verifying the signature on data. Values are commonly \"sig\" (signature) or \"enc\" (encryption).
  -> JsonWebKey
mkJsonWebKey :: Text -> Text -> Text -> Text -> JsonWebKey
mkJsonWebKey Text
jsonWebKeyAlg Text
jsonWebKeyKid Text
jsonWebKeyKty Text
jsonWebKeyUse =
  JsonWebKey
  { Text
jsonWebKeyAlg :: Text
jsonWebKeyAlg :: Text
jsonWebKeyAlg
  , jsonWebKeyCrv :: Maybe Text
jsonWebKeyCrv = forall a. Maybe a
Nothing
  , jsonWebKeyD :: Maybe Text
jsonWebKeyD = forall a. Maybe a
Nothing
  , jsonWebKeyDp :: Maybe Text
jsonWebKeyDp = forall a. Maybe a
Nothing
  , jsonWebKeyDq :: Maybe Text
jsonWebKeyDq = forall a. Maybe a
Nothing
  , jsonWebKeyE :: Maybe Text
jsonWebKeyE = forall a. Maybe a
Nothing
  , jsonWebKeyK :: Maybe Text
jsonWebKeyK = forall a. Maybe a
Nothing
  , Text
jsonWebKeyKid :: Text
jsonWebKeyKid :: Text
jsonWebKeyKid
  , Text
jsonWebKeyKty :: Text
jsonWebKeyKty :: Text
jsonWebKeyKty
  , jsonWebKeyN :: Maybe Text
jsonWebKeyN = forall a. Maybe a
Nothing
  , jsonWebKeyP :: Maybe Text
jsonWebKeyP = forall a. Maybe a
Nothing
  , jsonWebKeyQ :: Maybe Text
jsonWebKeyQ = forall a. Maybe a
Nothing
  , jsonWebKeyQi :: Maybe Text
jsonWebKeyQi = forall a. Maybe a
Nothing
  , Text
jsonWebKeyUse :: Text
jsonWebKeyUse :: Text
jsonWebKeyUse
  , jsonWebKeyX :: Maybe Text
jsonWebKeyX = forall a. Maybe a
Nothing
  , jsonWebKeyX5c :: Maybe [Text]
jsonWebKeyX5c = forall a. Maybe a
Nothing
  , jsonWebKeyY :: Maybe Text
jsonWebKeyY = forall a. Maybe a
Nothing
  }

-- ** JsonWebKeySet
-- | JsonWebKeySet
-- JSON Web Key Set
data JsonWebKeySet = JsonWebKeySet
  { JsonWebKeySet -> Maybe [JsonWebKey]
jsonWebKeySetKeys :: Maybe [JsonWebKey] -- ^ "keys" - List of JSON Web Keys  The value of the \&quot;keys\&quot; parameter is an array of JSON Web Key (JWK) values. By default, the order of the JWK values within the array does not imply an order of preference among them, although applications of JWK Sets can choose to assign a meaning to the order for their purposes, if desired.
  } deriving (Int -> JsonWebKeySet -> ShowS
[JsonWebKeySet] -> ShowS
JsonWebKeySet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonWebKeySet] -> ShowS
$cshowList :: [JsonWebKeySet] -> ShowS
show :: JsonWebKeySet -> String
$cshow :: JsonWebKeySet -> String
showsPrec :: Int -> JsonWebKeySet -> ShowS
$cshowsPrec :: Int -> JsonWebKeySet -> ShowS
P.Show, JsonWebKeySet -> JsonWebKeySet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonWebKeySet -> JsonWebKeySet -> Bool
$c/= :: JsonWebKeySet -> JsonWebKeySet -> Bool
== :: JsonWebKeySet -> JsonWebKeySet -> Bool
$c== :: JsonWebKeySet -> JsonWebKeySet -> Bool
P.Eq, P.Typeable)

-- | FromJSON JsonWebKeySet
instance A.FromJSON JsonWebKeySet where
  parseJSON :: Value -> Parser JsonWebKeySet
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"JsonWebKeySet" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [JsonWebKey] -> JsonWebKeySet
JsonWebKeySet
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"keys")

-- | ToJSON JsonWebKeySet
instance A.ToJSON JsonWebKeySet where
  toJSON :: JsonWebKeySet -> Value
toJSON JsonWebKeySet {Maybe [JsonWebKey]
jsonWebKeySetKeys :: Maybe [JsonWebKey]
jsonWebKeySetKeys :: JsonWebKeySet -> Maybe [JsonWebKey]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"keys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [JsonWebKey]
jsonWebKeySetKeys
      ]


-- | Construct a value of type 'JsonWebKeySet' (by applying it's required fields, if any)
mkJsonWebKeySet
  :: JsonWebKeySet
mkJsonWebKeySet :: JsonWebKeySet
mkJsonWebKeySet =
  JsonWebKeySet
  { jsonWebKeySetKeys :: Maybe [JsonWebKey]
jsonWebKeySetKeys = forall a. Maybe a
Nothing
  }

-- ** OAuth2Client
-- | OAuth2Client
-- OAuth 2.0 Client
-- 
-- OAuth 2.0 Clients are used to perform OAuth 2.0 and OpenID Connect flows. Usually, OAuth 2.0 clients are generated for applications which want to consume your OAuth 2.0 or OpenID Connect capabilities.
data OAuth2Client = OAuth2Client
  { OAuth2Client -> Maybe [Text]
oAuth2ClientAllowedCorsOrigins :: Maybe [Text] -- ^ "allowed_cors_origins"
  , OAuth2Client -> Maybe [Text]
oAuth2ClientAudience :: Maybe [Text] -- ^ "audience"
  , OAuth2Client -> Maybe Text
oAuth2ClientAuthorizationCodeGrantAccessTokenLifespan :: Maybe Text -- ^ "authorization_code_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientAuthorizationCodeGrantIdTokenLifespan :: Maybe Text -- ^ "authorization_code_grant_id_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientAuthorizationCodeGrantRefreshTokenLifespan :: Maybe Text -- ^ "authorization_code_grant_refresh_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Bool
oAuth2ClientBackchannelLogoutSessionRequired :: Maybe Bool -- ^ "backchannel_logout_session_required" - OpenID Connect Back-Channel Logout Session Required  Boolean value specifying whether the RP requires that a sid (session ID) Claim be included in the Logout Token to identify the RP session with the OP when the backchannel_logout_uri is used. If omitted, the default value is false.
  , OAuth2Client -> Maybe Text
oAuth2ClientBackchannelLogoutUri :: Maybe Text -- ^ "backchannel_logout_uri" - OpenID Connect Back-Channel Logout URI  RP URL that will cause the RP to log itself out when sent a Logout Token by the OP.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientCredentialsGrantAccessTokenLifespan :: Maybe Text -- ^ "client_credentials_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientId :: Maybe Text -- ^ "client_id" - OAuth 2.0 Client ID  The ID is autogenerated and immutable.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientName :: Maybe Text -- ^ "client_name" - OAuth 2.0 Client Name  The human-readable name of the client to be presented to the end-user during authorization.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientSecret :: Maybe Text -- ^ "client_secret" - OAuth 2.0 Client Secret  The secret will be included in the create request as cleartext, and then never again. The secret is kept in hashed format and is not recoverable once lost.
  , OAuth2Client -> Maybe Integer
oAuth2ClientClientSecretExpiresAt :: Maybe Integer -- ^ "client_secret_expires_at" - OAuth 2.0 Client Secret Expires At  The field is currently not supported and its value is always 0.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientUri :: Maybe Text -- ^ "client_uri" - OAuth 2.0 Client URI  ClientURI is a URL string of a web page providing information about the client. If present, the server SHOULD display this URL to the end-user in a clickable fashion.
  , OAuth2Client -> Maybe [Text]
oAuth2ClientContacts :: Maybe [Text] -- ^ "contacts"
  , OAuth2Client -> Maybe DateTime
oAuth2ClientCreatedAt :: Maybe DateTime -- ^ "created_at" - OAuth 2.0 Client Creation Date  CreatedAt returns the timestamp of the client&#39;s creation.
  , OAuth2Client -> Maybe Bool
oAuth2ClientFrontchannelLogoutSessionRequired :: Maybe Bool -- ^ "frontchannel_logout_session_required" - OpenID Connect Front-Channel Logout Session Required  Boolean value specifying whether the RP requires that iss (issuer) and sid (session ID) query parameters be included to identify the RP session with the OP when the frontchannel_logout_uri is used. If omitted, the default value is false.
  , OAuth2Client -> Maybe Text
oAuth2ClientFrontchannelLogoutUri :: Maybe Text -- ^ "frontchannel_logout_uri" - OpenID Connect Front-Channel Logout URI  RP URL that will cause the RP to log itself out when rendered in an iframe by the OP. An iss (issuer) query parameter and a sid (session ID) query parameter MAY be included by the OP to enable the RP to validate the request and to determine which of the potentially multiple sessions is to be logged out; if either is included, both MUST be.
  , OAuth2Client -> Maybe [Text]
oAuth2ClientGrantTypes :: Maybe [Text] -- ^ "grant_types"
  , OAuth2Client -> Maybe Text
oAuth2ClientImplicitGrantAccessTokenLifespan :: Maybe Text -- ^ "implicit_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientImplicitGrantIdTokenLifespan :: Maybe Text -- ^ "implicit_grant_id_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Value
oAuth2ClientJwks :: Maybe A.Value -- ^ "jwks" - OAuth 2.0 Client JSON Web Key Set  Client&#39;s JSON Web Key Set [JWK] document, passed by value. The semantics of the jwks parameter are the same as the jwks_uri parameter, other than that the JWK Set is passed by value, rather than by reference. This parameter is intended only to be used by Clients that, for some reason, are unable to use the jwks_uri parameter, for instance, by native applications that might not have a location to host the contents of the JWK Set. If a Client can use jwks_uri, it MUST NOT use jwks. One significant downside of jwks is that it does not enable key rotation (which jwks_uri does, as described in Section 10 of OpenID Connect Core 1.0 [OpenID.Core]). The jwks_uri and jwks parameters MUST NOT be used together.
  , OAuth2Client -> Maybe Text
oAuth2ClientJwksUri :: Maybe Text -- ^ "jwks_uri" - OAuth 2.0 Client JSON Web Key Set URL  URL for the Client&#39;s JSON Web Key Set [JWK] document. If the Client signs requests to the Server, it contains the signing key(s) the Server uses to validate signatures from the Client. The JWK Set MAY also contain the Client&#39;s encryption keys(s), which are used by the Server to encrypt responses to the Client. When both signing and encryption keys are made available, a use (Key Use) parameter value is REQUIRED for all keys in the referenced JWK Set to indicate each key&#39;s intended usage. Although some algorithms allow the same key to be used for both signatures and encryption, doing so is NOT RECOMMENDED, as it is less secure. The JWK x5c parameter MAY be used to provide X.509 representations of keys provided. When used, the bare key values MUST still be present and MUST match those in the certificate.
  , OAuth2Client -> Maybe Text
oAuth2ClientJwtBearerGrantAccessTokenLifespan :: Maybe Text -- ^ "jwt_bearer_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientLogoUri :: Maybe Text -- ^ "logo_uri" - OAuth 2.0 Client Logo URI  A URL string referencing the client&#39;s logo.
  , OAuth2Client -> Maybe Value
oAuth2ClientMetadata :: Maybe A.Value -- ^ "metadata"
  , OAuth2Client -> Maybe Text
oAuth2ClientOwner :: Maybe Text -- ^ "owner" - OAuth 2.0 Client Owner  Owner is a string identifying the owner of the OAuth 2.0 Client.
  , OAuth2Client -> Maybe Text
oAuth2ClientPolicyUri :: Maybe Text -- ^ "policy_uri" - OAuth 2.0 Client Policy URI  PolicyURI is a URL string that points to a human-readable privacy policy document that describes how the deployment organization collects, uses, retains, and discloses personal data.
  , OAuth2Client -> Maybe [Text]
oAuth2ClientPostLogoutRedirectUris :: Maybe [Text] -- ^ "post_logout_redirect_uris"
  , OAuth2Client -> Maybe [Text]
oAuth2ClientRedirectUris :: Maybe [Text] -- ^ "redirect_uris"
  , OAuth2Client -> Maybe Text
oAuth2ClientRefreshTokenGrantAccessTokenLifespan :: Maybe Text -- ^ "refresh_token_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientRefreshTokenGrantIdTokenLifespan :: Maybe Text -- ^ "refresh_token_grant_id_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientRefreshTokenGrantRefreshTokenLifespan :: Maybe Text -- ^ "refresh_token_grant_refresh_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2Client -> Maybe Text
oAuth2ClientRegistrationAccessToken :: Maybe Text -- ^ "registration_access_token" - OpenID Connect Dynamic Client Registration Access Token  RegistrationAccessToken can be used to update, get, or delete the OAuth2 Client. It is sent when creating a client using Dynamic Client Registration.
  , OAuth2Client -> Maybe Text
oAuth2ClientRegistrationClientUri :: Maybe Text -- ^ "registration_client_uri" - OpenID Connect Dynamic Client Registration URL  RegistrationClientURI is the URL used to update, get, or delete the OAuth2 Client.
  , OAuth2Client -> Maybe Text
oAuth2ClientRequestObjectSigningAlg :: Maybe Text -- ^ "request_object_signing_alg" - OpenID Connect Request Object Signing Algorithm  JWS [JWS] alg algorithm [JWA] that MUST be used for signing Request Objects sent to the OP. All Request Objects from this Client MUST be rejected, if not signed with this algorithm.
  , OAuth2Client -> Maybe [Text]
oAuth2ClientRequestUris :: Maybe [Text] -- ^ "request_uris"
  , OAuth2Client -> Maybe [Text]
oAuth2ClientResponseTypes :: Maybe [Text] -- ^ "response_types"
  , OAuth2Client -> Maybe Text
oAuth2ClientScope :: Maybe Text -- ^ "scope" - OAuth 2.0 Client Scope  Scope is a string containing a space-separated list of scope values (as described in Section 3.3 of OAuth 2.0 [RFC6749]) that the client can use when requesting access tokens.
  , OAuth2Client -> Maybe Text
oAuth2ClientSectorIdentifierUri :: Maybe Text -- ^ "sector_identifier_uri" - OpenID Connect Sector Identifier URI  URL using the https scheme to be used in calculating Pseudonymous Identifiers by the OP. The URL references a file with a single JSON array of redirect_uri values.
  , OAuth2Client -> Maybe Text
oAuth2ClientSubjectType :: Maybe Text -- ^ "subject_type" - OpenID Connect Subject Type  The &#x60;subject_types_supported&#x60; Discovery parameter contains a list of the supported subject_type values for this server. Valid types include &#x60;pairwise&#x60; and &#x60;public&#x60;.
  , OAuth2Client -> Maybe Text
oAuth2ClientTokenEndpointAuthMethod :: Maybe Text -- ^ "token_endpoint_auth_method" - OAuth 2.0 Token Endpoint Authentication Method  Requested Client Authentication method for the Token Endpoint. The options are:  &#x60;client_secret_post&#x60;: (default) Send &#x60;client_id&#x60; and &#x60;client_secret&#x60; as &#x60;application/x-www-form-urlencoded&#x60; in the HTTP body. &#x60;client_secret_basic&#x60;: Send &#x60;client_id&#x60; and &#x60;client_secret&#x60; as &#x60;application/x-www-form-urlencoded&#x60; encoded in the HTTP Authorization header. &#x60;private_key_jwt&#x60;: Use JSON Web Tokens to authenticate the client. &#x60;none&#x60;: Used for public clients (native apps, mobile apps) which can not have secrets.
  , OAuth2Client -> Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg :: Maybe Text -- ^ "token_endpoint_auth_signing_alg" - OAuth 2.0 Token Endpoint Signing Algorithm  Requested Client Authentication signing algorithm for the Token Endpoint.
  , OAuth2Client -> Maybe Text
oAuth2ClientTosUri :: Maybe Text -- ^ "tos_uri" - OAuth 2.0 Client Terms of Service URI  A URL string pointing to a human-readable terms of service document for the client that describes a contractual relationship between the end-user and the client that the end-user accepts when authorizing the client.
  , OAuth2Client -> Maybe DateTime
oAuth2ClientUpdatedAt :: Maybe DateTime -- ^ "updated_at" - OAuth 2.0 Client Last Update Date  UpdatedAt returns the timestamp of the last update.
  , OAuth2Client -> Maybe Text
oAuth2ClientUserinfoSignedResponseAlg :: Maybe Text -- ^ "userinfo_signed_response_alg" - OpenID Connect Request Userinfo Signed Response Algorithm  JWS alg algorithm [JWA] REQUIRED for signing UserInfo Responses. If this is specified, the response will be JWT [JWT] serialized, and signed using JWS. The default, if omitted, is for the UserInfo Response to return the Claims as a UTF-8 encoded JSON object using the application/json content-type.
  } deriving (Int -> OAuth2Client -> ShowS
[OAuth2Client] -> ShowS
OAuth2Client -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2Client] -> ShowS
$cshowList :: [OAuth2Client] -> ShowS
show :: OAuth2Client -> String
$cshow :: OAuth2Client -> String
showsPrec :: Int -> OAuth2Client -> ShowS
$cshowsPrec :: Int -> OAuth2Client -> ShowS
P.Show, OAuth2Client -> OAuth2Client -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2Client -> OAuth2Client -> Bool
$c/= :: OAuth2Client -> OAuth2Client -> Bool
== :: OAuth2Client -> OAuth2Client -> Bool
$c== :: OAuth2Client -> OAuth2Client -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2Client
instance A.FromJSON OAuth2Client where
  parseJSON :: Value -> Parser OAuth2Client
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2Client" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> OAuth2Client
OAuth2Client
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowed_cors_origins")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"audience")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_code_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_code_grant_id_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_code_grant_refresh_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backchannel_logout_session_required")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backchannel_logout_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_credentials_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_secret")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_secret_expires_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contacts")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontchannel_logout_session_required")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontchannel_logout_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grant_types")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"implicit_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"implicit_grant_id_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jwks")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jwks_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jwt_bearer_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logo_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"policy_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"post_logout_redirect_uris")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"redirect_uris")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token_grant_id_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token_grant_refresh_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"registration_access_token")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"registration_client_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_object_signing_alg")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_uris")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_types")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sector_identifier_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subject_type")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_endpoint_auth_method")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_endpoint_auth_signing_alg")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tos_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"userinfo_signed_response_alg")

-- | ToJSON OAuth2Client
instance A.ToJSON OAuth2Client where
  toJSON :: OAuth2Client -> Value
toJSON OAuth2Client {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe Value
Maybe DateTime
oAuth2ClientUserinfoSignedResponseAlg :: Maybe Text
oAuth2ClientUpdatedAt :: Maybe DateTime
oAuth2ClientTosUri :: Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg :: Maybe Text
oAuth2ClientTokenEndpointAuthMethod :: Maybe Text
oAuth2ClientSubjectType :: Maybe Text
oAuth2ClientSectorIdentifierUri :: Maybe Text
oAuth2ClientScope :: Maybe Text
oAuth2ClientResponseTypes :: Maybe [Text]
oAuth2ClientRequestUris :: Maybe [Text]
oAuth2ClientRequestObjectSigningAlg :: Maybe Text
oAuth2ClientRegistrationClientUri :: Maybe Text
oAuth2ClientRegistrationAccessToken :: Maybe Text
oAuth2ClientRefreshTokenGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientRefreshTokenGrantIdTokenLifespan :: Maybe Text
oAuth2ClientRefreshTokenGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientRedirectUris :: Maybe [Text]
oAuth2ClientPostLogoutRedirectUris :: Maybe [Text]
oAuth2ClientPolicyUri :: Maybe Text
oAuth2ClientOwner :: Maybe Text
oAuth2ClientMetadata :: Maybe Value
oAuth2ClientLogoUri :: Maybe Text
oAuth2ClientJwtBearerGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientJwksUri :: Maybe Text
oAuth2ClientJwks :: Maybe Value
oAuth2ClientImplicitGrantIdTokenLifespan :: Maybe Text
oAuth2ClientImplicitGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientGrantTypes :: Maybe [Text]
oAuth2ClientFrontchannelLogoutUri :: Maybe Text
oAuth2ClientFrontchannelLogoutSessionRequired :: Maybe Bool
oAuth2ClientCreatedAt :: Maybe DateTime
oAuth2ClientContacts :: Maybe [Text]
oAuth2ClientClientUri :: Maybe Text
oAuth2ClientClientSecretExpiresAt :: Maybe Integer
oAuth2ClientClientSecret :: Maybe Text
oAuth2ClientClientName :: Maybe Text
oAuth2ClientClientId :: Maybe Text
oAuth2ClientClientCredentialsGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientBackchannelLogoutUri :: Maybe Text
oAuth2ClientBackchannelLogoutSessionRequired :: Maybe Bool
oAuth2ClientAuthorizationCodeGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientAuthorizationCodeGrantIdTokenLifespan :: Maybe Text
oAuth2ClientAuthorizationCodeGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientAudience :: Maybe [Text]
oAuth2ClientAllowedCorsOrigins :: Maybe [Text]
oAuth2ClientUserinfoSignedResponseAlg :: OAuth2Client -> Maybe Text
oAuth2ClientUpdatedAt :: OAuth2Client -> Maybe DateTime
oAuth2ClientTosUri :: OAuth2Client -> Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg :: OAuth2Client -> Maybe Text
oAuth2ClientTokenEndpointAuthMethod :: OAuth2Client -> Maybe Text
oAuth2ClientSubjectType :: OAuth2Client -> Maybe Text
oAuth2ClientSectorIdentifierUri :: OAuth2Client -> Maybe Text
oAuth2ClientScope :: OAuth2Client -> Maybe Text
oAuth2ClientResponseTypes :: OAuth2Client -> Maybe [Text]
oAuth2ClientRequestUris :: OAuth2Client -> Maybe [Text]
oAuth2ClientRequestObjectSigningAlg :: OAuth2Client -> Maybe Text
oAuth2ClientRegistrationClientUri :: OAuth2Client -> Maybe Text
oAuth2ClientRegistrationAccessToken :: OAuth2Client -> Maybe Text
oAuth2ClientRefreshTokenGrantRefreshTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientRefreshTokenGrantIdTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientRefreshTokenGrantAccessTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientRedirectUris :: OAuth2Client -> Maybe [Text]
oAuth2ClientPostLogoutRedirectUris :: OAuth2Client -> Maybe [Text]
oAuth2ClientPolicyUri :: OAuth2Client -> Maybe Text
oAuth2ClientOwner :: OAuth2Client -> Maybe Text
oAuth2ClientMetadata :: OAuth2Client -> Maybe Value
oAuth2ClientLogoUri :: OAuth2Client -> Maybe Text
oAuth2ClientJwtBearerGrantAccessTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientJwksUri :: OAuth2Client -> Maybe Text
oAuth2ClientJwks :: OAuth2Client -> Maybe Value
oAuth2ClientImplicitGrantIdTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientImplicitGrantAccessTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientGrantTypes :: OAuth2Client -> Maybe [Text]
oAuth2ClientFrontchannelLogoutUri :: OAuth2Client -> Maybe Text
oAuth2ClientFrontchannelLogoutSessionRequired :: OAuth2Client -> Maybe Bool
oAuth2ClientCreatedAt :: OAuth2Client -> Maybe DateTime
oAuth2ClientContacts :: OAuth2Client -> Maybe [Text]
oAuth2ClientClientUri :: OAuth2Client -> Maybe Text
oAuth2ClientClientSecretExpiresAt :: OAuth2Client -> Maybe Integer
oAuth2ClientClientSecret :: OAuth2Client -> Maybe Text
oAuth2ClientClientName :: OAuth2Client -> Maybe Text
oAuth2ClientClientId :: OAuth2Client -> Maybe Text
oAuth2ClientClientCredentialsGrantAccessTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientBackchannelLogoutUri :: OAuth2Client -> Maybe Text
oAuth2ClientBackchannelLogoutSessionRequired :: OAuth2Client -> Maybe Bool
oAuth2ClientAuthorizationCodeGrantRefreshTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientAuthorizationCodeGrantIdTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientAuthorizationCodeGrantAccessTokenLifespan :: OAuth2Client -> Maybe Text
oAuth2ClientAudience :: OAuth2Client -> Maybe [Text]
oAuth2ClientAllowedCorsOrigins :: OAuth2Client -> Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allowed_cors_origins" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientAllowedCorsOrigins
      , Key
"audience" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientAudience
      , Key
"authorization_code_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientAuthorizationCodeGrantAccessTokenLifespan
      , Key
"authorization_code_grant_id_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientAuthorizationCodeGrantIdTokenLifespan
      , Key
"authorization_code_grant_refresh_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientAuthorizationCodeGrantRefreshTokenLifespan
      , Key
"backchannel_logout_session_required" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oAuth2ClientBackchannelLogoutSessionRequired
      , Key
"backchannel_logout_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientBackchannelLogoutUri
      , Key
"client_credentials_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientCredentialsGrantAccessTokenLifespan
      , Key
"client_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientId
      , Key
"client_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientName
      , Key
"client_secret" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientSecret
      , Key
"client_secret_expires_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2ClientClientSecretExpiresAt
      , Key
"client_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientUri
      , Key
"contacts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientContacts
      , Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ClientCreatedAt
      , Key
"frontchannel_logout_session_required" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oAuth2ClientFrontchannelLogoutSessionRequired
      , Key
"frontchannel_logout_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientFrontchannelLogoutUri
      , Key
"grant_types" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientGrantTypes
      , Key
"implicit_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientImplicitGrantAccessTokenLifespan
      , Key
"implicit_grant_id_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientImplicitGrantIdTokenLifespan
      , Key
"jwks" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
oAuth2ClientJwks
      , Key
"jwks_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientJwksUri
      , Key
"jwt_bearer_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientJwtBearerGrantAccessTokenLifespan
      , Key
"logo_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientLogoUri
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
oAuth2ClientMetadata
      , Key
"owner" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientOwner
      , Key
"policy_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientPolicyUri
      , Key
"post_logout_redirect_uris" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientPostLogoutRedirectUris
      , Key
"redirect_uris" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientRedirectUris
      , Key
"refresh_token_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientRefreshTokenGrantAccessTokenLifespan
      , Key
"refresh_token_grant_id_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientRefreshTokenGrantIdTokenLifespan
      , Key
"refresh_token_grant_refresh_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientRefreshTokenGrantRefreshTokenLifespan
      , Key
"registration_access_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientRegistrationAccessToken
      , Key
"registration_client_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientRegistrationClientUri
      , Key
"request_object_signing_alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientRequestObjectSigningAlg
      , Key
"request_uris" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientRequestUris
      , Key
"response_types" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientResponseTypes
      , Key
"scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientScope
      , Key
"sector_identifier_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientSectorIdentifierUri
      , Key
"subject_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientSubjectType
      , Key
"token_endpoint_auth_method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenEndpointAuthMethod
      , Key
"token_endpoint_auth_signing_alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg
      , Key
"tos_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTosUri
      , Key
"updated_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ClientUpdatedAt
      , Key
"userinfo_signed_response_alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientUserinfoSignedResponseAlg
      ]


-- | Construct a value of type 'OAuth2Client' (by applying it's required fields, if any)
mkOAuth2Client
  :: OAuth2Client
mkOAuth2Client :: OAuth2Client
mkOAuth2Client =
  OAuth2Client
  { oAuth2ClientAllowedCorsOrigins :: Maybe [Text]
oAuth2ClientAllowedCorsOrigins = forall a. Maybe a
Nothing
  , oAuth2ClientAudience :: Maybe [Text]
oAuth2ClientAudience = forall a. Maybe a
Nothing
  , oAuth2ClientAuthorizationCodeGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientAuthorizationCodeGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientAuthorizationCodeGrantIdTokenLifespan :: Maybe Text
oAuth2ClientAuthorizationCodeGrantIdTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientAuthorizationCodeGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientAuthorizationCodeGrantRefreshTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientBackchannelLogoutSessionRequired :: Maybe Bool
oAuth2ClientBackchannelLogoutSessionRequired = forall a. Maybe a
Nothing
  , oAuth2ClientBackchannelLogoutUri :: Maybe Text
oAuth2ClientBackchannelLogoutUri = forall a. Maybe a
Nothing
  , oAuth2ClientClientCredentialsGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientClientCredentialsGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientClientId :: Maybe Text
oAuth2ClientClientId = forall a. Maybe a
Nothing
  , oAuth2ClientClientName :: Maybe Text
oAuth2ClientClientName = forall a. Maybe a
Nothing
  , oAuth2ClientClientSecret :: Maybe Text
oAuth2ClientClientSecret = forall a. Maybe a
Nothing
  , oAuth2ClientClientSecretExpiresAt :: Maybe Integer
oAuth2ClientClientSecretExpiresAt = forall a. Maybe a
Nothing
  , oAuth2ClientClientUri :: Maybe Text
oAuth2ClientClientUri = forall a. Maybe a
Nothing
  , oAuth2ClientContacts :: Maybe [Text]
oAuth2ClientContacts = forall a. Maybe a
Nothing
  , oAuth2ClientCreatedAt :: Maybe DateTime
oAuth2ClientCreatedAt = forall a. Maybe a
Nothing
  , oAuth2ClientFrontchannelLogoutSessionRequired :: Maybe Bool
oAuth2ClientFrontchannelLogoutSessionRequired = forall a. Maybe a
Nothing
  , oAuth2ClientFrontchannelLogoutUri :: Maybe Text
oAuth2ClientFrontchannelLogoutUri = forall a. Maybe a
Nothing
  , oAuth2ClientGrantTypes :: Maybe [Text]
oAuth2ClientGrantTypes = forall a. Maybe a
Nothing
  , oAuth2ClientImplicitGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientImplicitGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientImplicitGrantIdTokenLifespan :: Maybe Text
oAuth2ClientImplicitGrantIdTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientJwks :: Maybe Value
oAuth2ClientJwks = forall a. Maybe a
Nothing
  , oAuth2ClientJwksUri :: Maybe Text
oAuth2ClientJwksUri = forall a. Maybe a
Nothing
  , oAuth2ClientJwtBearerGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientJwtBearerGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientLogoUri :: Maybe Text
oAuth2ClientLogoUri = forall a. Maybe a
Nothing
  , oAuth2ClientMetadata :: Maybe Value
oAuth2ClientMetadata = forall a. Maybe a
Nothing
  , oAuth2ClientOwner :: Maybe Text
oAuth2ClientOwner = forall a. Maybe a
Nothing
  , oAuth2ClientPolicyUri :: Maybe Text
oAuth2ClientPolicyUri = forall a. Maybe a
Nothing
  , oAuth2ClientPostLogoutRedirectUris :: Maybe [Text]
oAuth2ClientPostLogoutRedirectUris = forall a. Maybe a
Nothing
  , oAuth2ClientRedirectUris :: Maybe [Text]
oAuth2ClientRedirectUris = forall a. Maybe a
Nothing
  , oAuth2ClientRefreshTokenGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientRefreshTokenGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientRefreshTokenGrantIdTokenLifespan :: Maybe Text
oAuth2ClientRefreshTokenGrantIdTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientRefreshTokenGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientRefreshTokenGrantRefreshTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientRegistrationAccessToken :: Maybe Text
oAuth2ClientRegistrationAccessToken = forall a. Maybe a
Nothing
  , oAuth2ClientRegistrationClientUri :: Maybe Text
oAuth2ClientRegistrationClientUri = forall a. Maybe a
Nothing
  , oAuth2ClientRequestObjectSigningAlg :: Maybe Text
oAuth2ClientRequestObjectSigningAlg = forall a. Maybe a
Nothing
  , oAuth2ClientRequestUris :: Maybe [Text]
oAuth2ClientRequestUris = forall a. Maybe a
Nothing
  , oAuth2ClientResponseTypes :: Maybe [Text]
oAuth2ClientResponseTypes = forall a. Maybe a
Nothing
  , oAuth2ClientScope :: Maybe Text
oAuth2ClientScope = forall a. Maybe a
Nothing
  , oAuth2ClientSectorIdentifierUri :: Maybe Text
oAuth2ClientSectorIdentifierUri = forall a. Maybe a
Nothing
  , oAuth2ClientSubjectType :: Maybe Text
oAuth2ClientSubjectType = forall a. Maybe a
Nothing
  , oAuth2ClientTokenEndpointAuthMethod :: Maybe Text
oAuth2ClientTokenEndpointAuthMethod = forall a. Maybe a
Nothing
  , oAuth2ClientTokenEndpointAuthSigningAlg :: Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg = forall a. Maybe a
Nothing
  , oAuth2ClientTosUri :: Maybe Text
oAuth2ClientTosUri = forall a. Maybe a
Nothing
  , oAuth2ClientUpdatedAt :: Maybe DateTime
oAuth2ClientUpdatedAt = forall a. Maybe a
Nothing
  , oAuth2ClientUserinfoSignedResponseAlg :: Maybe Text
oAuth2ClientUserinfoSignedResponseAlg = forall a. Maybe a
Nothing
  }

-- ** OAuth2ClientTokenLifespans
-- | OAuth2ClientTokenLifespans
-- OAuth 2.0 Client Token Lifespans
-- 
-- Lifespans of different token types issued for this OAuth 2.0 Client.
data OAuth2ClientTokenLifespans = OAuth2ClientTokenLifespans
  { OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantAccessTokenLifespan :: Maybe Text -- ^ "authorization_code_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantIdTokenLifespan :: Maybe Text -- ^ "authorization_code_grant_id_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantRefreshTokenLifespan :: Maybe Text -- ^ "authorization_code_grant_refresh_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansClientCredentialsGrantAccessTokenLifespan :: Maybe Text -- ^ "client_credentials_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansImplicitGrantAccessTokenLifespan :: Maybe Text -- ^ "implicit_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansImplicitGrantIdTokenLifespan :: Maybe Text -- ^ "implicit_grant_id_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansJwtBearerGrantAccessTokenLifespan :: Maybe Text -- ^ "jwt_bearer_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantAccessTokenLifespan :: Maybe Text -- ^ "refresh_token_grant_access_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantIdTokenLifespan :: Maybe Text -- ^ "refresh_token_grant_id_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  , OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantRefreshTokenLifespan :: Maybe Text -- ^ "refresh_token_grant_refresh_token_lifespan" - Specify a time duration in milliseconds, seconds, minutes, hours.
  } deriving (Int -> OAuth2ClientTokenLifespans -> ShowS
[OAuth2ClientTokenLifespans] -> ShowS
OAuth2ClientTokenLifespans -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2ClientTokenLifespans] -> ShowS
$cshowList :: [OAuth2ClientTokenLifespans] -> ShowS
show :: OAuth2ClientTokenLifespans -> String
$cshow :: OAuth2ClientTokenLifespans -> String
showsPrec :: Int -> OAuth2ClientTokenLifespans -> ShowS
$cshowsPrec :: Int -> OAuth2ClientTokenLifespans -> ShowS
P.Show, OAuth2ClientTokenLifespans -> OAuth2ClientTokenLifespans -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2ClientTokenLifespans -> OAuth2ClientTokenLifespans -> Bool
$c/= :: OAuth2ClientTokenLifespans -> OAuth2ClientTokenLifespans -> Bool
== :: OAuth2ClientTokenLifespans -> OAuth2ClientTokenLifespans -> Bool
$c== :: OAuth2ClientTokenLifespans -> OAuth2ClientTokenLifespans -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2ClientTokenLifespans
instance A.FromJSON OAuth2ClientTokenLifespans where
  parseJSON :: Value -> Parser OAuth2ClientTokenLifespans
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2ClientTokenLifespans" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> OAuth2ClientTokenLifespans
OAuth2ClientTokenLifespans
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_code_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_code_grant_id_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_code_grant_refresh_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_credentials_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"implicit_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"implicit_grant_id_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jwt_bearer_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token_grant_access_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token_grant_id_token_lifespan")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token_grant_refresh_token_lifespan")

-- | ToJSON OAuth2ClientTokenLifespans
instance A.ToJSON OAuth2ClientTokenLifespans where
  toJSON :: OAuth2ClientTokenLifespans -> Value
toJSON OAuth2ClientTokenLifespans {Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantIdTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansJwtBearerGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansImplicitGrantIdTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansImplicitGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansClientCredentialsGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantIdTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantRefreshTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantIdTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantAccessTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansJwtBearerGrantAccessTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansImplicitGrantIdTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansImplicitGrantAccessTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansClientCredentialsGrantAccessTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantRefreshTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantIdTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantAccessTokenLifespan :: OAuth2ClientTokenLifespans -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"authorization_code_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantAccessTokenLifespan
      , Key
"authorization_code_grant_id_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantIdTokenLifespan
      , Key
"authorization_code_grant_refresh_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantRefreshTokenLifespan
      , Key
"client_credentials_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansClientCredentialsGrantAccessTokenLifespan
      , Key
"implicit_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansImplicitGrantAccessTokenLifespan
      , Key
"implicit_grant_id_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansImplicitGrantIdTokenLifespan
      , Key
"jwt_bearer_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansJwtBearerGrantAccessTokenLifespan
      , Key
"refresh_token_grant_access_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantAccessTokenLifespan
      , Key
"refresh_token_grant_id_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantIdTokenLifespan
      , Key
"refresh_token_grant_refresh_token_lifespan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantRefreshTokenLifespan
      ]


-- | Construct a value of type 'OAuth2ClientTokenLifespans' (by applying it's required fields, if any)
mkOAuth2ClientTokenLifespans
  :: OAuth2ClientTokenLifespans
mkOAuth2ClientTokenLifespans :: OAuth2ClientTokenLifespans
mkOAuth2ClientTokenLifespans =
  OAuth2ClientTokenLifespans
  { oAuth2ClientTokenLifespansAuthorizationCodeGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansAuthorizationCodeGrantIdTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantIdTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansAuthorizationCodeGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansAuthorizationCodeGrantRefreshTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansClientCredentialsGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansClientCredentialsGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansImplicitGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansImplicitGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansImplicitGrantIdTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansImplicitGrantIdTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansJwtBearerGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansJwtBearerGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansRefreshTokenGrantAccessTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantAccessTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansRefreshTokenGrantIdTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantIdTokenLifespan = forall a. Maybe a
Nothing
  , oAuth2ClientTokenLifespansRefreshTokenGrantRefreshTokenLifespan :: Maybe Text
oAuth2ClientTokenLifespansRefreshTokenGrantRefreshTokenLifespan = forall a. Maybe a
Nothing
  }

-- ** OAuth2ConsentRequest
-- | OAuth2ConsentRequest
-- Contains information on an ongoing consent request.
-- 
data OAuth2ConsentRequest = OAuth2ConsentRequest
  { OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestAcr :: Maybe Text -- ^ "acr" - ACR represents the Authentication AuthorizationContext Class Reference value for this authentication session. You can use it to express that, for example, a user authenticated using two factor authentication.
  , OAuth2ConsentRequest -> Maybe [Text]
oAuth2ConsentRequestAmr :: Maybe [Text] -- ^ "amr"
  , OAuth2ConsentRequest -> Text
oAuth2ConsentRequestChallenge :: Text -- ^ /Required/ "challenge" - ID is the identifier (\&quot;authorization challenge\&quot;) of the consent authorization request. It is used to identify the session.
  , OAuth2ConsentRequest -> Maybe OAuth2Client
oAuth2ConsentRequestClient :: Maybe OAuth2Client -- ^ "client"
  , OAuth2ConsentRequest -> Maybe Value
oAuth2ConsentRequestContext :: Maybe A.Value -- ^ "context"
  , OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestLoginChallenge :: Maybe Text -- ^ "login_challenge" - LoginChallenge is the login challenge this consent challenge belongs to. It can be used to associate a login and consent request in the login &amp; consent app.
  , OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestLoginSessionId :: Maybe Text -- ^ "login_session_id" - LoginSessionID is the login session ID. If the user-agent reuses a login session (via cookie / remember flag) this ID will remain the same. If the user-agent did not have an existing authentication session (e.g. remember is false) this will be a new random value. This value is used as the \&quot;sid\&quot; parameter in the ID Token and in OIDC Front-/Back- channel logout. It&#39;s value can generally be used to associate consecutive login requests by a certain user.
  , OAuth2ConsentRequest
-> Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2ConsentRequestOidcContext :: Maybe OAuth2ConsentRequestOpenIDConnectContext -- ^ "oidc_context"
  , OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestRequestUrl :: Maybe Text -- ^ "request_url" - RequestURL is the original OAuth 2.0 Authorization URL requested by the OAuth 2.0 client. It is the URL which initiates the OAuth 2.0 Authorization Code or OAuth 2.0 Implicit flow. This URL is typically not needed, but might come in handy if you want to deal with additional request parameters.
  , OAuth2ConsentRequest -> Maybe [Text]
oAuth2ConsentRequestRequestedAccessTokenAudience :: Maybe [Text] -- ^ "requested_access_token_audience"
  , OAuth2ConsentRequest -> Maybe [Text]
oAuth2ConsentRequestRequestedScope :: Maybe [Text] -- ^ "requested_scope"
  , OAuth2ConsentRequest -> Maybe Bool
oAuth2ConsentRequestSkip :: Maybe Bool -- ^ "skip" - Skip, if true, implies that the client has requested the same scopes from the same user previously. If true, you must not ask the user to grant the requested scopes. You must however either allow or deny the consent request using the usual API call.
  , OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestSubject :: Maybe Text -- ^ "subject" - Subject is the user ID of the end-user that authenticated. Now, that end user needs to grant or deny the scope requested by the OAuth 2.0 client.
  } deriving (Int -> OAuth2ConsentRequest -> ShowS
[OAuth2ConsentRequest] -> ShowS
OAuth2ConsentRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2ConsentRequest] -> ShowS
$cshowList :: [OAuth2ConsentRequest] -> ShowS
show :: OAuth2ConsentRequest -> String
$cshow :: OAuth2ConsentRequest -> String
showsPrec :: Int -> OAuth2ConsentRequest -> ShowS
$cshowsPrec :: Int -> OAuth2ConsentRequest -> ShowS
P.Show, OAuth2ConsentRequest -> OAuth2ConsentRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2ConsentRequest -> OAuth2ConsentRequest -> Bool
$c/= :: OAuth2ConsentRequest -> OAuth2ConsentRequest -> Bool
== :: OAuth2ConsentRequest -> OAuth2ConsentRequest -> Bool
$c== :: OAuth2ConsentRequest -> OAuth2ConsentRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2ConsentRequest
instance A.FromJSON OAuth2ConsentRequest where
  parseJSON :: Value -> Parser OAuth2ConsentRequest
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2ConsentRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text]
-> Text
-> Maybe OAuth2Client
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe OAuth2ConsentRequestOpenIDConnectContext
-> Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Text
-> OAuth2ConsentRequest
OAuth2ConsentRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"acr")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"amr")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"challenge")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"context")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"login_challenge")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"login_session_id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"oidc_context")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_url")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"requested_access_token_audience")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"requested_scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"skip")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subject")

-- | ToJSON OAuth2ConsentRequest
instance A.ToJSON OAuth2ConsentRequest where
  toJSON :: OAuth2ConsentRequest -> Value
toJSON OAuth2ConsentRequest {Maybe Bool
Maybe [Text]
Maybe Text
Maybe Value
Maybe OAuth2ConsentRequestOpenIDConnectContext
Maybe OAuth2Client
Text
oAuth2ConsentRequestSubject :: Maybe Text
oAuth2ConsentRequestSkip :: Maybe Bool
oAuth2ConsentRequestRequestedScope :: Maybe [Text]
oAuth2ConsentRequestRequestedAccessTokenAudience :: Maybe [Text]
oAuth2ConsentRequestRequestUrl :: Maybe Text
oAuth2ConsentRequestOidcContext :: Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2ConsentRequestLoginSessionId :: Maybe Text
oAuth2ConsentRequestLoginChallenge :: Maybe Text
oAuth2ConsentRequestContext :: Maybe Value
oAuth2ConsentRequestClient :: Maybe OAuth2Client
oAuth2ConsentRequestChallenge :: Text
oAuth2ConsentRequestAmr :: Maybe [Text]
oAuth2ConsentRequestAcr :: Maybe Text
oAuth2ConsentRequestSubject :: OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestSkip :: OAuth2ConsentRequest -> Maybe Bool
oAuth2ConsentRequestRequestedScope :: OAuth2ConsentRequest -> Maybe [Text]
oAuth2ConsentRequestRequestedAccessTokenAudience :: OAuth2ConsentRequest -> Maybe [Text]
oAuth2ConsentRequestRequestUrl :: OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestOidcContext :: OAuth2ConsentRequest
-> Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2ConsentRequestLoginSessionId :: OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestLoginChallenge :: OAuth2ConsentRequest -> Maybe Text
oAuth2ConsentRequestContext :: OAuth2ConsentRequest -> Maybe Value
oAuth2ConsentRequestClient :: OAuth2ConsentRequest -> Maybe OAuth2Client
oAuth2ConsentRequestChallenge :: OAuth2ConsentRequest -> Text
oAuth2ConsentRequestAmr :: OAuth2ConsentRequest -> Maybe [Text]
oAuth2ConsentRequestAcr :: OAuth2ConsentRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"acr" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ConsentRequestAcr
      , Key
"amr" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ConsentRequestAmr
      , Key
"challenge" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oAuth2ConsentRequestChallenge
      , Key
"client" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OAuth2Client
oAuth2ConsentRequestClient
      , Key
"context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
oAuth2ConsentRequestContext
      , Key
"login_challenge" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ConsentRequestLoginChallenge
      , Key
"login_session_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ConsentRequestLoginSessionId
      , Key
"oidc_context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2ConsentRequestOidcContext
      , Key
"request_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ConsentRequestRequestUrl
      , Key
"requested_access_token_audience" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ConsentRequestRequestedAccessTokenAudience
      , Key
"requested_scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ConsentRequestRequestedScope
      , Key
"skip" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oAuth2ConsentRequestSkip
      , Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ConsentRequestSubject
      ]


-- | Construct a value of type 'OAuth2ConsentRequest' (by applying it's required fields, if any)
mkOAuth2ConsentRequest
  :: Text -- ^ 'oAuth2ConsentRequestChallenge': ID is the identifier (\"authorization challenge\") of the consent authorization request. It is used to identify the session.
  -> OAuth2ConsentRequest
mkOAuth2ConsentRequest :: Text -> OAuth2ConsentRequest
mkOAuth2ConsentRequest Text
oAuth2ConsentRequestChallenge =
  OAuth2ConsentRequest
  { oAuth2ConsentRequestAcr :: Maybe Text
oAuth2ConsentRequestAcr = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestAmr :: Maybe [Text]
oAuth2ConsentRequestAmr = forall a. Maybe a
Nothing
  , Text
oAuth2ConsentRequestChallenge :: Text
oAuth2ConsentRequestChallenge :: Text
oAuth2ConsentRequestChallenge
  , oAuth2ConsentRequestClient :: Maybe OAuth2Client
oAuth2ConsentRequestClient = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestContext :: Maybe Value
oAuth2ConsentRequestContext = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestLoginChallenge :: Maybe Text
oAuth2ConsentRequestLoginChallenge = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestLoginSessionId :: Maybe Text
oAuth2ConsentRequestLoginSessionId = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestOidcContext :: Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2ConsentRequestOidcContext = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestRequestUrl :: Maybe Text
oAuth2ConsentRequestRequestUrl = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestRequestedAccessTokenAudience :: Maybe [Text]
oAuth2ConsentRequestRequestedAccessTokenAudience = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestRequestedScope :: Maybe [Text]
oAuth2ConsentRequestRequestedScope = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestSkip :: Maybe Bool
oAuth2ConsentRequestSkip = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestSubject :: Maybe Text
oAuth2ConsentRequestSubject = forall a. Maybe a
Nothing
  }

-- ** OAuth2ConsentRequestOpenIDConnectContext
-- | OAuth2ConsentRequestOpenIDConnectContext
-- Contains optional information about the OpenID Connect request.
-- 
data OAuth2ConsentRequestOpenIDConnectContext = OAuth2ConsentRequestOpenIDConnectContext
  { OAuth2ConsentRequestOpenIDConnectContext -> Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextAcrValues :: Maybe [Text] -- ^ "acr_values" - ACRValues is the Authentication AuthorizationContext Class Reference requested in the OAuth 2.0 Authorization request. It is a parameter defined by OpenID Connect and expresses which level of authentication (e.g. 2FA) is required.  OpenID Connect defines it as follows: &gt; Requested Authentication AuthorizationContext Class Reference values. Space-separated string that specifies the acr values that the Authorization Server is being requested to use for processing this Authentication Request, with the values appearing in order of preference. The Authentication AuthorizationContext Class satisfied by the authentication performed is returned as the acr Claim Value, as specified in Section 2. The acr Claim is requested as a Voluntary Claim by this parameter.
  , OAuth2ConsentRequestOpenIDConnectContext -> Maybe Text
oAuth2ConsentRequestOpenIDConnectContextDisplay :: Maybe Text -- ^ "display" - Display is a string value that specifies how the Authorization Server displays the authentication and consent user interface pages to the End-User. The defined values are: page: The Authorization Server SHOULD display the authentication and consent UI consistent with a full User Agent page view. If the display parameter is not specified, this is the default display mode. popup: The Authorization Server SHOULD display the authentication and consent UI consistent with a popup User Agent window. The popup User Agent window should be of an appropriate size for a login-focused dialog and should not obscure the entire window that it is popping up over. touch: The Authorization Server SHOULD display the authentication and consent UI consistent with a device that leverages a touch interface. wap: The Authorization Server SHOULD display the authentication and consent UI consistent with a \&quot;feature phone\&quot; type display.  The Authorization Server MAY also attempt to detect the capabilities of the User Agent and present an appropriate display.
  , OAuth2ConsentRequestOpenIDConnectContext
-> Maybe (Map String Value)
oAuth2ConsentRequestOpenIDConnectContextIdTokenHintClaims :: Maybe (Map.Map String A.Value) -- ^ "id_token_hint_claims" - IDTokenHintClaims are the claims of the ID Token previously issued by the Authorization Server being passed as a hint about the End-User&#39;s current or past authenticated session with the Client.
  , OAuth2ConsentRequestOpenIDConnectContext -> Maybe Text
oAuth2ConsentRequestOpenIDConnectContextLoginHint :: Maybe Text -- ^ "login_hint" - LoginHint hints about the login identifier the End-User might use to log in (if necessary). This hint can be used by an RP if it first asks the End-User for their e-mail address (or other identifier) and then wants to pass that value as a hint to the discovered authorization service. This value MAY also be a phone number in the format specified for the phone_number Claim. The use of this parameter is optional.
  , OAuth2ConsentRequestOpenIDConnectContext -> Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextUiLocales :: Maybe [Text] -- ^ "ui_locales" - UILocales is the End-User&#39;id preferred languages and scripts for the user interface, represented as a space-separated list of BCP47 [RFC5646] language tag values, ordered by preference. For instance, the value \&quot;fr-CA fr en\&quot; represents a preference for French as spoken in Canada, then French (without a region designation), followed by English (without a region designation). An error SHOULD NOT result if some or all of the requested locales are not supported by the OpenID Provider.
  } deriving (Int -> OAuth2ConsentRequestOpenIDConnectContext -> ShowS
[OAuth2ConsentRequestOpenIDConnectContext] -> ShowS
OAuth2ConsentRequestOpenIDConnectContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2ConsentRequestOpenIDConnectContext] -> ShowS
$cshowList :: [OAuth2ConsentRequestOpenIDConnectContext] -> ShowS
show :: OAuth2ConsentRequestOpenIDConnectContext -> String
$cshow :: OAuth2ConsentRequestOpenIDConnectContext -> String
showsPrec :: Int -> OAuth2ConsentRequestOpenIDConnectContext -> ShowS
$cshowsPrec :: Int -> OAuth2ConsentRequestOpenIDConnectContext -> ShowS
P.Show, OAuth2ConsentRequestOpenIDConnectContext
-> OAuth2ConsentRequestOpenIDConnectContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2ConsentRequestOpenIDConnectContext
-> OAuth2ConsentRequestOpenIDConnectContext -> Bool
$c/= :: OAuth2ConsentRequestOpenIDConnectContext
-> OAuth2ConsentRequestOpenIDConnectContext -> Bool
== :: OAuth2ConsentRequestOpenIDConnectContext
-> OAuth2ConsentRequestOpenIDConnectContext -> Bool
$c== :: OAuth2ConsentRequestOpenIDConnectContext
-> OAuth2ConsentRequestOpenIDConnectContext -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2ConsentRequestOpenIDConnectContext
instance A.FromJSON OAuth2ConsentRequestOpenIDConnectContext where
  parseJSON :: Value -> Parser OAuth2ConsentRequestOpenIDConnectContext
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2ConsentRequestOpenIDConnectContext" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe Text
-> Maybe (Map String Value)
-> Maybe Text
-> Maybe [Text]
-> OAuth2ConsentRequestOpenIDConnectContext
OAuth2ConsentRequestOpenIDConnectContext
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"acr_values")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"display")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id_token_hint_claims")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"login_hint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ui_locales")

-- | ToJSON OAuth2ConsentRequestOpenIDConnectContext
instance A.ToJSON OAuth2ConsentRequestOpenIDConnectContext where
  toJSON :: OAuth2ConsentRequestOpenIDConnectContext -> Value
toJSON OAuth2ConsentRequestOpenIDConnectContext {Maybe [Text]
Maybe Text
Maybe (Map String Value)
oAuth2ConsentRequestOpenIDConnectContextUiLocales :: Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextLoginHint :: Maybe Text
oAuth2ConsentRequestOpenIDConnectContextIdTokenHintClaims :: Maybe (Map String Value)
oAuth2ConsentRequestOpenIDConnectContextDisplay :: Maybe Text
oAuth2ConsentRequestOpenIDConnectContextAcrValues :: Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextUiLocales :: OAuth2ConsentRequestOpenIDConnectContext -> Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextLoginHint :: OAuth2ConsentRequestOpenIDConnectContext -> Maybe Text
oAuth2ConsentRequestOpenIDConnectContextIdTokenHintClaims :: OAuth2ConsentRequestOpenIDConnectContext
-> Maybe (Map String Value)
oAuth2ConsentRequestOpenIDConnectContextDisplay :: OAuth2ConsentRequestOpenIDConnectContext -> Maybe Text
oAuth2ConsentRequestOpenIDConnectContextAcrValues :: OAuth2ConsentRequestOpenIDConnectContext -> Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"acr_values" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextAcrValues
      , Key
"display" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ConsentRequestOpenIDConnectContextDisplay
      , Key
"id_token_hint_claims" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Map String Value)
oAuth2ConsentRequestOpenIDConnectContextIdTokenHintClaims
      , Key
"login_hint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ConsentRequestOpenIDConnectContextLoginHint
      , Key
"ui_locales" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextUiLocales
      ]


-- | Construct a value of type 'OAuth2ConsentRequestOpenIDConnectContext' (by applying it's required fields, if any)
mkOAuth2ConsentRequestOpenIDConnectContext
  :: OAuth2ConsentRequestOpenIDConnectContext
mkOAuth2ConsentRequestOpenIDConnectContext :: OAuth2ConsentRequestOpenIDConnectContext
mkOAuth2ConsentRequestOpenIDConnectContext =
  OAuth2ConsentRequestOpenIDConnectContext
  { oAuth2ConsentRequestOpenIDConnectContextAcrValues :: Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextAcrValues = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestOpenIDConnectContextDisplay :: Maybe Text
oAuth2ConsentRequestOpenIDConnectContextDisplay = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestOpenIDConnectContextIdTokenHintClaims :: Maybe (Map String Value)
oAuth2ConsentRequestOpenIDConnectContextIdTokenHintClaims = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestOpenIDConnectContextLoginHint :: Maybe Text
oAuth2ConsentRequestOpenIDConnectContextLoginHint = forall a. Maybe a
Nothing
  , oAuth2ConsentRequestOpenIDConnectContextUiLocales :: Maybe [Text]
oAuth2ConsentRequestOpenIDConnectContextUiLocales = forall a. Maybe a
Nothing
  }

-- ** OAuth2ConsentSession
-- | OAuth2ConsentSession
-- OAuth 2.0 Consent Session
-- 
-- A completed OAuth 2.0 Consent Session.
data OAuth2ConsentSession = OAuth2ConsentSession
  { OAuth2ConsentSession -> Maybe OAuth2ConsentRequest
oAuth2ConsentSessionConsentRequest :: Maybe OAuth2ConsentRequest -- ^ "consent_request"
  , OAuth2ConsentSession -> Maybe OAuth2ConsentSessionExpiresAt
oAuth2ConsentSessionExpiresAt :: Maybe OAuth2ConsentSessionExpiresAt -- ^ "expires_at"
  , OAuth2ConsentSession -> Maybe [Text]
oAuth2ConsentSessionGrantAccessTokenAudience :: Maybe [Text] -- ^ "grant_access_token_audience"
  , OAuth2ConsentSession -> Maybe [Text]
oAuth2ConsentSessionGrantScope :: Maybe [Text] -- ^ "grant_scope"
  , OAuth2ConsentSession -> Maybe DateTime
oAuth2ConsentSessionHandledAt :: Maybe DateTime -- ^ "handled_at"
  , OAuth2ConsentSession -> Maybe Bool
oAuth2ConsentSessionRemember :: Maybe Bool -- ^ "remember" - Remember Consent  Remember, if set to true, tells ORY Hydra to remember this consent authorization and reuse it if the same client asks the same user for the same, or a subset of, scope.
  , OAuth2ConsentSession -> Maybe Integer
oAuth2ConsentSessionRememberFor :: Maybe Integer -- ^ "remember_for" - Remember Consent For  RememberFor sets how long the consent authorization should be remembered for in seconds. If set to &#x60;0&#x60;, the authorization will be remembered indefinitely.
  , OAuth2ConsentSession -> Maybe AcceptOAuth2ConsentRequestSession
oAuth2ConsentSessionSession :: Maybe AcceptOAuth2ConsentRequestSession -- ^ "session"
  } deriving (Int -> OAuth2ConsentSession -> ShowS
[OAuth2ConsentSession] -> ShowS
OAuth2ConsentSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2ConsentSession] -> ShowS
$cshowList :: [OAuth2ConsentSession] -> ShowS
show :: OAuth2ConsentSession -> String
$cshow :: OAuth2ConsentSession -> String
showsPrec :: Int -> OAuth2ConsentSession -> ShowS
$cshowsPrec :: Int -> OAuth2ConsentSession -> ShowS
P.Show, OAuth2ConsentSession -> OAuth2ConsentSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2ConsentSession -> OAuth2ConsentSession -> Bool
$c/= :: OAuth2ConsentSession -> OAuth2ConsentSession -> Bool
== :: OAuth2ConsentSession -> OAuth2ConsentSession -> Bool
$c== :: OAuth2ConsentSession -> OAuth2ConsentSession -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2ConsentSession
instance A.FromJSON OAuth2ConsentSession where
  parseJSON :: Value -> Parser OAuth2ConsentSession
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2ConsentSession" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe OAuth2ConsentRequest
-> Maybe OAuth2ConsentSessionExpiresAt
-> Maybe [Text]
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Bool
-> Maybe Integer
-> Maybe AcceptOAuth2ConsentRequestSession
-> OAuth2ConsentSession
OAuth2ConsentSession
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"consent_request")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grant_access_token_audience")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grant_scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"handled_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remember")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remember_for")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"session")

-- | ToJSON OAuth2ConsentSession
instance A.ToJSON OAuth2ConsentSession where
  toJSON :: OAuth2ConsentSession -> Value
toJSON OAuth2ConsentSession {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe DateTime
Maybe OAuth2ConsentSessionExpiresAt
Maybe OAuth2ConsentRequest
Maybe AcceptOAuth2ConsentRequestSession
oAuth2ConsentSessionSession :: Maybe AcceptOAuth2ConsentRequestSession
oAuth2ConsentSessionRememberFor :: Maybe Integer
oAuth2ConsentSessionRemember :: Maybe Bool
oAuth2ConsentSessionHandledAt :: Maybe DateTime
oAuth2ConsentSessionGrantScope :: Maybe [Text]
oAuth2ConsentSessionGrantAccessTokenAudience :: Maybe [Text]
oAuth2ConsentSessionExpiresAt :: Maybe OAuth2ConsentSessionExpiresAt
oAuth2ConsentSessionConsentRequest :: Maybe OAuth2ConsentRequest
oAuth2ConsentSessionSession :: OAuth2ConsentSession -> Maybe AcceptOAuth2ConsentRequestSession
oAuth2ConsentSessionRememberFor :: OAuth2ConsentSession -> Maybe Integer
oAuth2ConsentSessionRemember :: OAuth2ConsentSession -> Maybe Bool
oAuth2ConsentSessionHandledAt :: OAuth2ConsentSession -> Maybe DateTime
oAuth2ConsentSessionGrantScope :: OAuth2ConsentSession -> Maybe [Text]
oAuth2ConsentSessionGrantAccessTokenAudience :: OAuth2ConsentSession -> Maybe [Text]
oAuth2ConsentSessionExpiresAt :: OAuth2ConsentSession -> Maybe OAuth2ConsentSessionExpiresAt
oAuth2ConsentSessionConsentRequest :: OAuth2ConsentSession -> Maybe OAuth2ConsentRequest
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"consent_request" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OAuth2ConsentRequest
oAuth2ConsentSessionConsentRequest
      , Key
"expires_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OAuth2ConsentSessionExpiresAt
oAuth2ConsentSessionExpiresAt
      , Key
"grant_access_token_audience" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ConsentSessionGrantAccessTokenAudience
      , Key
"grant_scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ConsentSessionGrantScope
      , Key
"handled_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ConsentSessionHandledAt
      , Key
"remember" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oAuth2ConsentSessionRemember
      , Key
"remember_for" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2ConsentSessionRememberFor
      , Key
"session" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe AcceptOAuth2ConsentRequestSession
oAuth2ConsentSessionSession
      ]


-- | Construct a value of type 'OAuth2ConsentSession' (by applying it's required fields, if any)
mkOAuth2ConsentSession
  :: OAuth2ConsentSession
mkOAuth2ConsentSession :: OAuth2ConsentSession
mkOAuth2ConsentSession =
  OAuth2ConsentSession
  { oAuth2ConsentSessionConsentRequest :: Maybe OAuth2ConsentRequest
oAuth2ConsentSessionConsentRequest = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionExpiresAt :: Maybe OAuth2ConsentSessionExpiresAt
oAuth2ConsentSessionExpiresAt = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionGrantAccessTokenAudience :: Maybe [Text]
oAuth2ConsentSessionGrantAccessTokenAudience = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionGrantScope :: Maybe [Text]
oAuth2ConsentSessionGrantScope = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionHandledAt :: Maybe DateTime
oAuth2ConsentSessionHandledAt = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionRemember :: Maybe Bool
oAuth2ConsentSessionRemember = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionRememberFor :: Maybe Integer
oAuth2ConsentSessionRememberFor = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionSession :: Maybe AcceptOAuth2ConsentRequestSession
oAuth2ConsentSessionSession = forall a. Maybe a
Nothing
  }

-- ** OAuth2ConsentSessionExpiresAt
-- | OAuth2ConsentSessionExpiresAt
data OAuth2ConsentSessionExpiresAt = OAuth2ConsentSessionExpiresAt
  { OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtAccessToken :: Maybe DateTime -- ^ "access_token"
  , OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtAuthorizeCode :: Maybe DateTime -- ^ "authorize_code"
  , OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtIdToken :: Maybe DateTime -- ^ "id_token"
  , OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtParContext :: Maybe DateTime -- ^ "par_context"
  , OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtRefreshToken :: Maybe DateTime -- ^ "refresh_token"
  } deriving (Int -> OAuth2ConsentSessionExpiresAt -> ShowS
[OAuth2ConsentSessionExpiresAt] -> ShowS
OAuth2ConsentSessionExpiresAt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2ConsentSessionExpiresAt] -> ShowS
$cshowList :: [OAuth2ConsentSessionExpiresAt] -> ShowS
show :: OAuth2ConsentSessionExpiresAt -> String
$cshow :: OAuth2ConsentSessionExpiresAt -> String
showsPrec :: Int -> OAuth2ConsentSessionExpiresAt -> ShowS
$cshowsPrec :: Int -> OAuth2ConsentSessionExpiresAt -> ShowS
P.Show, OAuth2ConsentSessionExpiresAt
-> OAuth2ConsentSessionExpiresAt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2ConsentSessionExpiresAt
-> OAuth2ConsentSessionExpiresAt -> Bool
$c/= :: OAuth2ConsentSessionExpiresAt
-> OAuth2ConsentSessionExpiresAt -> Bool
== :: OAuth2ConsentSessionExpiresAt
-> OAuth2ConsentSessionExpiresAt -> Bool
$c== :: OAuth2ConsentSessionExpiresAt
-> OAuth2ConsentSessionExpiresAt -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2ConsentSessionExpiresAt
instance A.FromJSON OAuth2ConsentSessionExpiresAt where
  parseJSON :: Value -> Parser OAuth2ConsentSessionExpiresAt
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2ConsentSessionExpiresAt" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe DateTime
-> Maybe DateTime
-> Maybe DateTime
-> Maybe DateTime
-> OAuth2ConsentSessionExpiresAt
OAuth2ConsentSessionExpiresAt
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"access_token")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorize_code")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id_token")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"par_context")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token")

-- | ToJSON OAuth2ConsentSessionExpiresAt
instance A.ToJSON OAuth2ConsentSessionExpiresAt where
  toJSON :: OAuth2ConsentSessionExpiresAt -> Value
toJSON OAuth2ConsentSessionExpiresAt {Maybe DateTime
oAuth2ConsentSessionExpiresAtRefreshToken :: Maybe DateTime
oAuth2ConsentSessionExpiresAtParContext :: Maybe DateTime
oAuth2ConsentSessionExpiresAtIdToken :: Maybe DateTime
oAuth2ConsentSessionExpiresAtAuthorizeCode :: Maybe DateTime
oAuth2ConsentSessionExpiresAtAccessToken :: Maybe DateTime
oAuth2ConsentSessionExpiresAtRefreshToken :: OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtParContext :: OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtIdToken :: OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtAuthorizeCode :: OAuth2ConsentSessionExpiresAt -> Maybe DateTime
oAuth2ConsentSessionExpiresAtAccessToken :: OAuth2ConsentSessionExpiresAt -> Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"access_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ConsentSessionExpiresAtAccessToken
      , Key
"authorize_code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ConsentSessionExpiresAtAuthorizeCode
      , Key
"id_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ConsentSessionExpiresAtIdToken
      , Key
"par_context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ConsentSessionExpiresAtParContext
      , Key
"refresh_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ConsentSessionExpiresAtRefreshToken
      ]


-- | Construct a value of type 'OAuth2ConsentSessionExpiresAt' (by applying it's required fields, if any)
mkOAuth2ConsentSessionExpiresAt
  :: OAuth2ConsentSessionExpiresAt
mkOAuth2ConsentSessionExpiresAt :: OAuth2ConsentSessionExpiresAt
mkOAuth2ConsentSessionExpiresAt =
  OAuth2ConsentSessionExpiresAt
  { oAuth2ConsentSessionExpiresAtAccessToken :: Maybe DateTime
oAuth2ConsentSessionExpiresAtAccessToken = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionExpiresAtAuthorizeCode :: Maybe DateTime
oAuth2ConsentSessionExpiresAtAuthorizeCode = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionExpiresAtIdToken :: Maybe DateTime
oAuth2ConsentSessionExpiresAtIdToken = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionExpiresAtParContext :: Maybe DateTime
oAuth2ConsentSessionExpiresAtParContext = forall a. Maybe a
Nothing
  , oAuth2ConsentSessionExpiresAtRefreshToken :: Maybe DateTime
oAuth2ConsentSessionExpiresAtRefreshToken = forall a. Maybe a
Nothing
  }

-- ** OAuth2LoginRequest
-- | OAuth2LoginRequest
-- Contains information on an ongoing login request.
-- 
data OAuth2LoginRequest = OAuth2LoginRequest
  { OAuth2LoginRequest -> Text
oAuth2LoginRequestChallenge :: Text -- ^ /Required/ "challenge" - ID is the identifier (\&quot;login challenge\&quot;) of the login request. It is used to identify the session.
  , OAuth2LoginRequest -> OAuth2Client
oAuth2LoginRequestClient :: OAuth2Client -- ^ /Required/ "client"
  , OAuth2LoginRequest
-> Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2LoginRequestOidcContext :: Maybe OAuth2ConsentRequestOpenIDConnectContext -- ^ "oidc_context"
  , OAuth2LoginRequest -> Text
oAuth2LoginRequestRequestUrl :: Text -- ^ /Required/ "request_url" - RequestURL is the original OAuth 2.0 Authorization URL requested by the OAuth 2.0 client. It is the URL which initiates the OAuth 2.0 Authorization Code or OAuth 2.0 Implicit flow. This URL is typically not needed, but might come in handy if you want to deal with additional request parameters.
  , OAuth2LoginRequest -> [Text]
oAuth2LoginRequestRequestedAccessTokenAudience :: [Text] -- ^ /Required/ "requested_access_token_audience"
  , OAuth2LoginRequest -> [Text]
oAuth2LoginRequestRequestedScope :: [Text] -- ^ /Required/ "requested_scope"
  , OAuth2LoginRequest -> Maybe Text
oAuth2LoginRequestSessionId :: Maybe Text -- ^ "session_id" - SessionID is the login session ID. If the user-agent reuses a login session (via cookie / remember flag) this ID will remain the same. If the user-agent did not have an existing authentication session (e.g. remember is false) this will be a new random value. This value is used as the \&quot;sid\&quot; parameter in the ID Token and in OIDC Front-/Back- channel logout. It&#39;s value can generally be used to associate consecutive login requests by a certain user.
  , OAuth2LoginRequest -> Bool
oAuth2LoginRequestSkip :: Bool -- ^ /Required/ "skip" - Skip, if true, implies that the client has requested the same scopes from the same user previously. If true, you can skip asking the user to grant the requested scopes, and simply forward the user to the redirect URL.  This feature allows you to update / set session information.
  , OAuth2LoginRequest -> Text
oAuth2LoginRequestSubject :: Text -- ^ /Required/ "subject" - Subject is the user ID of the end-user that authenticated. Now, that end user needs to grant or deny the scope requested by the OAuth 2.0 client. If this value is set and &#x60;skip&#x60; is true, you MUST include this subject type when accepting the login request, or the request will fail.
  } deriving (Int -> OAuth2LoginRequest -> ShowS
[OAuth2LoginRequest] -> ShowS
OAuth2LoginRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2LoginRequest] -> ShowS
$cshowList :: [OAuth2LoginRequest] -> ShowS
show :: OAuth2LoginRequest -> String
$cshow :: OAuth2LoginRequest -> String
showsPrec :: Int -> OAuth2LoginRequest -> ShowS
$cshowsPrec :: Int -> OAuth2LoginRequest -> ShowS
P.Show, OAuth2LoginRequest -> OAuth2LoginRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2LoginRequest -> OAuth2LoginRequest -> Bool
$c/= :: OAuth2LoginRequest -> OAuth2LoginRequest -> Bool
== :: OAuth2LoginRequest -> OAuth2LoginRequest -> Bool
$c== :: OAuth2LoginRequest -> OAuth2LoginRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2LoginRequest
instance A.FromJSON OAuth2LoginRequest where
  parseJSON :: Value -> Parser OAuth2LoginRequest
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2LoginRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> OAuth2Client
-> Maybe OAuth2ConsentRequestOpenIDConnectContext
-> Text
-> [Text]
-> [Text]
-> Maybe Text
-> Bool
-> Text
-> OAuth2LoginRequest
OAuth2LoginRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"challenge")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"client")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"oidc_context")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"request_url")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"requested_access_token_audience")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"requested_scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"session_id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"skip")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"subject")

-- | ToJSON OAuth2LoginRequest
instance A.ToJSON OAuth2LoginRequest where
  toJSON :: OAuth2LoginRequest -> Value
toJSON OAuth2LoginRequest {Bool
[Text]
Maybe Text
Maybe OAuth2ConsentRequestOpenIDConnectContext
Text
OAuth2Client
oAuth2LoginRequestSubject :: Text
oAuth2LoginRequestSkip :: Bool
oAuth2LoginRequestSessionId :: Maybe Text
oAuth2LoginRequestRequestedScope :: [Text]
oAuth2LoginRequestRequestedAccessTokenAudience :: [Text]
oAuth2LoginRequestRequestUrl :: Text
oAuth2LoginRequestOidcContext :: Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2LoginRequestClient :: OAuth2Client
oAuth2LoginRequestChallenge :: Text
oAuth2LoginRequestSubject :: OAuth2LoginRequest -> Text
oAuth2LoginRequestSkip :: OAuth2LoginRequest -> Bool
oAuth2LoginRequestSessionId :: OAuth2LoginRequest -> Maybe Text
oAuth2LoginRequestRequestedScope :: OAuth2LoginRequest -> [Text]
oAuth2LoginRequestRequestedAccessTokenAudience :: OAuth2LoginRequest -> [Text]
oAuth2LoginRequestRequestUrl :: OAuth2LoginRequest -> Text
oAuth2LoginRequestOidcContext :: OAuth2LoginRequest
-> Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2LoginRequestClient :: OAuth2LoginRequest -> OAuth2Client
oAuth2LoginRequestChallenge :: OAuth2LoginRequest -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"challenge" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oAuth2LoginRequestChallenge
      , Key
"client" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OAuth2Client
oAuth2LoginRequestClient
      , Key
"oidc_context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2LoginRequestOidcContext
      , Key
"request_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oAuth2LoginRequestRequestUrl
      , Key
"requested_access_token_audience" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
oAuth2LoginRequestRequestedAccessTokenAudience
      , Key
"requested_scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
oAuth2LoginRequestRequestedScope
      , Key
"session_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2LoginRequestSessionId
      , Key
"skip" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
oAuth2LoginRequestSkip
      , Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oAuth2LoginRequestSubject
      ]


-- | Construct a value of type 'OAuth2LoginRequest' (by applying it's required fields, if any)
mkOAuth2LoginRequest
  :: Text -- ^ 'oAuth2LoginRequestChallenge': ID is the identifier (\"login challenge\") of the login request. It is used to identify the session.
  -> OAuth2Client -- ^ 'oAuth2LoginRequestClient' 
  -> Text -- ^ 'oAuth2LoginRequestRequestUrl': RequestURL is the original OAuth 2.0 Authorization URL requested by the OAuth 2.0 client. It is the URL which initiates the OAuth 2.0 Authorization Code or OAuth 2.0 Implicit flow. This URL is typically not needed, but might come in handy if you want to deal with additional request parameters.
  -> [Text] -- ^ 'oAuth2LoginRequestRequestedAccessTokenAudience' 
  -> [Text] -- ^ 'oAuth2LoginRequestRequestedScope' 
  -> Bool -- ^ 'oAuth2LoginRequestSkip': Skip, if true, implies that the client has requested the same scopes from the same user previously. If true, you can skip asking the user to grant the requested scopes, and simply forward the user to the redirect URL.  This feature allows you to update / set session information.
  -> Text -- ^ 'oAuth2LoginRequestSubject': Subject is the user ID of the end-user that authenticated. Now, that end user needs to grant or deny the scope requested by the OAuth 2.0 client. If this value is set and `skip` is true, you MUST include this subject type when accepting the login request, or the request will fail.
  -> OAuth2LoginRequest
mkOAuth2LoginRequest :: Text
-> OAuth2Client
-> Text
-> [Text]
-> [Text]
-> Bool
-> Text
-> OAuth2LoginRequest
mkOAuth2LoginRequest Text
oAuth2LoginRequestChallenge OAuth2Client
oAuth2LoginRequestClient Text
oAuth2LoginRequestRequestUrl [Text]
oAuth2LoginRequestRequestedAccessTokenAudience [Text]
oAuth2LoginRequestRequestedScope Bool
oAuth2LoginRequestSkip Text
oAuth2LoginRequestSubject =
  OAuth2LoginRequest
  { Text
oAuth2LoginRequestChallenge :: Text
oAuth2LoginRequestChallenge :: Text
oAuth2LoginRequestChallenge
  , OAuth2Client
oAuth2LoginRequestClient :: OAuth2Client
oAuth2LoginRequestClient :: OAuth2Client
oAuth2LoginRequestClient
  , oAuth2LoginRequestOidcContext :: Maybe OAuth2ConsentRequestOpenIDConnectContext
oAuth2LoginRequestOidcContext = forall a. Maybe a
Nothing
  , Text
oAuth2LoginRequestRequestUrl :: Text
oAuth2LoginRequestRequestUrl :: Text
oAuth2LoginRequestRequestUrl
  , [Text]
oAuth2LoginRequestRequestedAccessTokenAudience :: [Text]
oAuth2LoginRequestRequestedAccessTokenAudience :: [Text]
oAuth2LoginRequestRequestedAccessTokenAudience
  , [Text]
oAuth2LoginRequestRequestedScope :: [Text]
oAuth2LoginRequestRequestedScope :: [Text]
oAuth2LoginRequestRequestedScope
  , oAuth2LoginRequestSessionId :: Maybe Text
oAuth2LoginRequestSessionId = forall a. Maybe a
Nothing
  , Bool
oAuth2LoginRequestSkip :: Bool
oAuth2LoginRequestSkip :: Bool
oAuth2LoginRequestSkip
  , Text
oAuth2LoginRequestSubject :: Text
oAuth2LoginRequestSubject :: Text
oAuth2LoginRequestSubject
  }

-- ** OAuth2LogoutRequest
-- | OAuth2LogoutRequest
-- Contains information about an ongoing logout request.
-- 
data OAuth2LogoutRequest = OAuth2LogoutRequest
  { OAuth2LogoutRequest -> Maybe Text
oAuth2LogoutRequestChallenge :: Maybe Text -- ^ "challenge" - Challenge is the identifier (\&quot;logout challenge\&quot;) of the logout authentication request. It is used to identify the session.
  , OAuth2LogoutRequest -> Maybe OAuth2Client
oAuth2LogoutRequestClient :: Maybe OAuth2Client -- ^ "client"
  , OAuth2LogoutRequest -> Maybe Text
oAuth2LogoutRequestRequestUrl :: Maybe Text -- ^ "request_url" - RequestURL is the original Logout URL requested.
  , OAuth2LogoutRequest -> Maybe Bool
oAuth2LogoutRequestRpInitiated :: Maybe Bool -- ^ "rp_initiated" - RPInitiated is set to true if the request was initiated by a Relying Party (RP), also known as an OAuth 2.0 Client.
  , OAuth2LogoutRequest -> Maybe Text
oAuth2LogoutRequestSid :: Maybe Text -- ^ "sid" - SessionID is the login session ID that was requested to log out.
  , OAuth2LogoutRequest -> Maybe Text
oAuth2LogoutRequestSubject :: Maybe Text -- ^ "subject" - Subject is the user for whom the logout was request.
  } deriving (Int -> OAuth2LogoutRequest -> ShowS
[OAuth2LogoutRequest] -> ShowS
OAuth2LogoutRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2LogoutRequest] -> ShowS
$cshowList :: [OAuth2LogoutRequest] -> ShowS
show :: OAuth2LogoutRequest -> String
$cshow :: OAuth2LogoutRequest -> String
showsPrec :: Int -> OAuth2LogoutRequest -> ShowS
$cshowsPrec :: Int -> OAuth2LogoutRequest -> ShowS
P.Show, OAuth2LogoutRequest -> OAuth2LogoutRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2LogoutRequest -> OAuth2LogoutRequest -> Bool
$c/= :: OAuth2LogoutRequest -> OAuth2LogoutRequest -> Bool
== :: OAuth2LogoutRequest -> OAuth2LogoutRequest -> Bool
$c== :: OAuth2LogoutRequest -> OAuth2LogoutRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2LogoutRequest
instance A.FromJSON OAuth2LogoutRequest where
  parseJSON :: Value -> Parser OAuth2LogoutRequest
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2LogoutRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe OAuth2Client
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> OAuth2LogoutRequest
OAuth2LogoutRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"challenge")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_url")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rp_initiated")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sid")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subject")

-- | ToJSON OAuth2LogoutRequest
instance A.ToJSON OAuth2LogoutRequest where
  toJSON :: OAuth2LogoutRequest -> Value
toJSON OAuth2LogoutRequest {Maybe Bool
Maybe Text
Maybe OAuth2Client
oAuth2LogoutRequestSubject :: Maybe Text
oAuth2LogoutRequestSid :: Maybe Text
oAuth2LogoutRequestRpInitiated :: Maybe Bool
oAuth2LogoutRequestRequestUrl :: Maybe Text
oAuth2LogoutRequestClient :: Maybe OAuth2Client
oAuth2LogoutRequestChallenge :: Maybe Text
oAuth2LogoutRequestSubject :: OAuth2LogoutRequest -> Maybe Text
oAuth2LogoutRequestSid :: OAuth2LogoutRequest -> Maybe Text
oAuth2LogoutRequestRpInitiated :: OAuth2LogoutRequest -> Maybe Bool
oAuth2LogoutRequestRequestUrl :: OAuth2LogoutRequest -> Maybe Text
oAuth2LogoutRequestClient :: OAuth2LogoutRequest -> Maybe OAuth2Client
oAuth2LogoutRequestChallenge :: OAuth2LogoutRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"challenge" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2LogoutRequestChallenge
      , Key
"client" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OAuth2Client
oAuth2LogoutRequestClient
      , Key
"request_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2LogoutRequestRequestUrl
      , Key
"rp_initiated" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oAuth2LogoutRequestRpInitiated
      , Key
"sid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2LogoutRequestSid
      , Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2LogoutRequestSubject
      ]


-- | Construct a value of type 'OAuth2LogoutRequest' (by applying it's required fields, if any)
mkOAuth2LogoutRequest
  :: OAuth2LogoutRequest
mkOAuth2LogoutRequest :: OAuth2LogoutRequest
mkOAuth2LogoutRequest =
  OAuth2LogoutRequest
  { oAuth2LogoutRequestChallenge :: Maybe Text
oAuth2LogoutRequestChallenge = forall a. Maybe a
Nothing
  , oAuth2LogoutRequestClient :: Maybe OAuth2Client
oAuth2LogoutRequestClient = forall a. Maybe a
Nothing
  , oAuth2LogoutRequestRequestUrl :: Maybe Text
oAuth2LogoutRequestRequestUrl = forall a. Maybe a
Nothing
  , oAuth2LogoutRequestRpInitiated :: Maybe Bool
oAuth2LogoutRequestRpInitiated = forall a. Maybe a
Nothing
  , oAuth2LogoutRequestSid :: Maybe Text
oAuth2LogoutRequestSid = forall a. Maybe a
Nothing
  , oAuth2LogoutRequestSubject :: Maybe Text
oAuth2LogoutRequestSubject = forall a. Maybe a
Nothing
  }

-- ** OAuth2RedirectTo
-- | OAuth2RedirectTo
-- OAuth 2.0 Redirect Browser To
-- 
-- Contains a redirect URL used to complete a login, consent, or logout request.
data OAuth2RedirectTo = OAuth2RedirectTo
  { OAuth2RedirectTo -> Text
oAuth2RedirectToRedirectTo :: Text -- ^ /Required/ "redirect_to" - RedirectURL is the URL which you should redirect the user&#39;s browser to once the authentication process is completed.
  } deriving (Int -> OAuth2RedirectTo -> ShowS
[OAuth2RedirectTo] -> ShowS
OAuth2RedirectTo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2RedirectTo] -> ShowS
$cshowList :: [OAuth2RedirectTo] -> ShowS
show :: OAuth2RedirectTo -> String
$cshow :: OAuth2RedirectTo -> String
showsPrec :: Int -> OAuth2RedirectTo -> ShowS
$cshowsPrec :: Int -> OAuth2RedirectTo -> ShowS
P.Show, OAuth2RedirectTo -> OAuth2RedirectTo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2RedirectTo -> OAuth2RedirectTo -> Bool
$c/= :: OAuth2RedirectTo -> OAuth2RedirectTo -> Bool
== :: OAuth2RedirectTo -> OAuth2RedirectTo -> Bool
$c== :: OAuth2RedirectTo -> OAuth2RedirectTo -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2RedirectTo
instance A.FromJSON OAuth2RedirectTo where
  parseJSON :: Value -> Parser OAuth2RedirectTo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2RedirectTo" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> OAuth2RedirectTo
OAuth2RedirectTo
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"redirect_to")

-- | ToJSON OAuth2RedirectTo
instance A.ToJSON OAuth2RedirectTo where
  toJSON :: OAuth2RedirectTo -> Value
toJSON OAuth2RedirectTo {Text
oAuth2RedirectToRedirectTo :: Text
oAuth2RedirectToRedirectTo :: OAuth2RedirectTo -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"redirect_to" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oAuth2RedirectToRedirectTo
      ]


-- | Construct a value of type 'OAuth2RedirectTo' (by applying it's required fields, if any)
mkOAuth2RedirectTo
  :: Text -- ^ 'oAuth2RedirectToRedirectTo': RedirectURL is the URL which you should redirect the user's browser to once the authentication process is completed.
  -> OAuth2RedirectTo
mkOAuth2RedirectTo :: Text -> OAuth2RedirectTo
mkOAuth2RedirectTo Text
oAuth2RedirectToRedirectTo =
  OAuth2RedirectTo
  { Text
oAuth2RedirectToRedirectTo :: Text
oAuth2RedirectToRedirectTo :: Text
oAuth2RedirectToRedirectTo
  }

-- ** OAuth2TokenExchange
-- | OAuth2TokenExchange
-- OAuth2 Token Exchange Result
data OAuth2TokenExchange = OAuth2TokenExchange
  { OAuth2TokenExchange -> Maybe Text
oAuth2TokenExchangeAccessToken :: Maybe Text -- ^ "access_token" - The access token issued by the authorization server.
  , OAuth2TokenExchange -> Maybe Integer
oAuth2TokenExchangeExpiresIn :: Maybe Integer -- ^ "expires_in" - The lifetime in seconds of the access token. For example, the value \&quot;3600\&quot; denotes that the access token will expire in one hour from the time the response was generated.
  , OAuth2TokenExchange -> Maybe Integer
oAuth2TokenExchangeIdToken :: Maybe Integer -- ^ "id_token" - To retrieve a refresh token request the id_token scope.
  , OAuth2TokenExchange -> Maybe Text
oAuth2TokenExchangeRefreshToken :: Maybe Text -- ^ "refresh_token" - The refresh token, which can be used to obtain new access tokens. To retrieve it add the scope \&quot;offline\&quot; to your access token request.
  , OAuth2TokenExchange -> Maybe Text
oAuth2TokenExchangeScope :: Maybe Text -- ^ "scope" - The scope of the access token
  , OAuth2TokenExchange -> Maybe Text
oAuth2TokenExchangeTokenType :: Maybe Text -- ^ "token_type" - The type of the token issued
  } deriving (Int -> OAuth2TokenExchange -> ShowS
[OAuth2TokenExchange] -> ShowS
OAuth2TokenExchange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2TokenExchange] -> ShowS
$cshowList :: [OAuth2TokenExchange] -> ShowS
show :: OAuth2TokenExchange -> String
$cshow :: OAuth2TokenExchange -> String
showsPrec :: Int -> OAuth2TokenExchange -> ShowS
$cshowsPrec :: Int -> OAuth2TokenExchange -> ShowS
P.Show, OAuth2TokenExchange -> OAuth2TokenExchange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2TokenExchange -> OAuth2TokenExchange -> Bool
$c/= :: OAuth2TokenExchange -> OAuth2TokenExchange -> Bool
== :: OAuth2TokenExchange -> OAuth2TokenExchange -> Bool
$c== :: OAuth2TokenExchange -> OAuth2TokenExchange -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2TokenExchange
instance A.FromJSON OAuth2TokenExchange where
  parseJSON :: Value -> Parser OAuth2TokenExchange
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2TokenExchange" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> OAuth2TokenExchange
OAuth2TokenExchange
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"access_token")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_in")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id_token")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_type")

-- | ToJSON OAuth2TokenExchange
instance A.ToJSON OAuth2TokenExchange where
  toJSON :: OAuth2TokenExchange -> Value
toJSON OAuth2TokenExchange {Maybe Integer
Maybe Text
oAuth2TokenExchangeTokenType :: Maybe Text
oAuth2TokenExchangeScope :: Maybe Text
oAuth2TokenExchangeRefreshToken :: Maybe Text
oAuth2TokenExchangeIdToken :: Maybe Integer
oAuth2TokenExchangeExpiresIn :: Maybe Integer
oAuth2TokenExchangeAccessToken :: Maybe Text
oAuth2TokenExchangeTokenType :: OAuth2TokenExchange -> Maybe Text
oAuth2TokenExchangeScope :: OAuth2TokenExchange -> Maybe Text
oAuth2TokenExchangeRefreshToken :: OAuth2TokenExchange -> Maybe Text
oAuth2TokenExchangeIdToken :: OAuth2TokenExchange -> Maybe Integer
oAuth2TokenExchangeExpiresIn :: OAuth2TokenExchange -> Maybe Integer
oAuth2TokenExchangeAccessToken :: OAuth2TokenExchange -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"access_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenExchangeAccessToken
      , Key
"expires_in" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2TokenExchangeExpiresIn
      , Key
"id_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2TokenExchangeIdToken
      , Key
"refresh_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenExchangeRefreshToken
      , Key
"scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenExchangeScope
      , Key
"token_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenExchangeTokenType
      ]


-- | Construct a value of type 'OAuth2TokenExchange' (by applying it's required fields, if any)
mkOAuth2TokenExchange
  :: OAuth2TokenExchange
mkOAuth2TokenExchange :: OAuth2TokenExchange
mkOAuth2TokenExchange =
  OAuth2TokenExchange
  { oAuth2TokenExchangeAccessToken :: Maybe Text
oAuth2TokenExchangeAccessToken = forall a. Maybe a
Nothing
  , oAuth2TokenExchangeExpiresIn :: Maybe Integer
oAuth2TokenExchangeExpiresIn = forall a. Maybe a
Nothing
  , oAuth2TokenExchangeIdToken :: Maybe Integer
oAuth2TokenExchangeIdToken = forall a. Maybe a
Nothing
  , oAuth2TokenExchangeRefreshToken :: Maybe Text
oAuth2TokenExchangeRefreshToken = forall a. Maybe a
Nothing
  , oAuth2TokenExchangeScope :: Maybe Text
oAuth2TokenExchangeScope = forall a. Maybe a
Nothing
  , oAuth2TokenExchangeTokenType :: Maybe Text
oAuth2TokenExchangeTokenType = forall a. Maybe a
Nothing
  }

-- ** OidcConfiguration
-- | OidcConfiguration
-- OpenID Connect Discovery Metadata
-- 
-- Includes links to several endpoints (for example `/oauth2/token`) and exposes information on supported signature algorithms among others.
data OidcConfiguration = OidcConfiguration
  { OidcConfiguration -> Text
oidcConfigurationAuthorizationEndpoint :: Text -- ^ /Required/ "authorization_endpoint" - OAuth 2.0 Authorization Endpoint URL
  , OidcConfiguration -> Maybe Bool
oidcConfigurationBackchannelLogoutSessionSupported :: Maybe Bool -- ^ "backchannel_logout_session_supported" - OpenID Connect Back-Channel Logout Session Required  Boolean value specifying whether the OP can pass a sid (session ID) Claim in the Logout Token to identify the RP session with the OP. If supported, the sid Claim is also included in ID Tokens issued by the OP
  , OidcConfiguration -> Maybe Bool
oidcConfigurationBackchannelLogoutSupported :: Maybe Bool -- ^ "backchannel_logout_supported" - OpenID Connect Back-Channel Logout Supported  Boolean value specifying whether the OP supports back-channel logout, with true indicating support.
  , OidcConfiguration -> Maybe Bool
oidcConfigurationClaimsParameterSupported :: Maybe Bool -- ^ "claims_parameter_supported" - OpenID Connect Claims Parameter Parameter Supported  Boolean value specifying whether the OP supports use of the claims parameter, with true indicating support.
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationClaimsSupported :: Maybe [Text] -- ^ "claims_supported" - OpenID Connect Supported Claims  JSON array containing a list of the Claim Names of the Claims that the OpenID Provider MAY be able to supply values for. Note that for privacy or other reasons, this might not be an exhaustive list.
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationCodeChallengeMethodsSupported :: Maybe [Text] -- ^ "code_challenge_methods_supported" - OAuth 2.0 PKCE Supported Code Challenge Methods  JSON array containing a list of Proof Key for Code Exchange (PKCE) [RFC7636] code challenge methods supported by this authorization server.
  , OidcConfiguration -> Maybe Text
oidcConfigurationEndSessionEndpoint :: Maybe Text -- ^ "end_session_endpoint" - OpenID Connect End-Session Endpoint  URL at the OP to which an RP can perform a redirect to request that the End-User be logged out at the OP.
  , OidcConfiguration -> Maybe Bool
oidcConfigurationFrontchannelLogoutSessionSupported :: Maybe Bool -- ^ "frontchannel_logout_session_supported" - OpenID Connect Front-Channel Logout Session Required  Boolean value specifying whether the OP can pass iss (issuer) and sid (session ID) query parameters to identify the RP session with the OP when the frontchannel_logout_uri is used. If supported, the sid Claim is also included in ID Tokens issued by the OP.
  , OidcConfiguration -> Maybe Bool
oidcConfigurationFrontchannelLogoutSupported :: Maybe Bool -- ^ "frontchannel_logout_supported" - OpenID Connect Front-Channel Logout Supported  Boolean value specifying whether the OP supports HTTP-based logout, with true indicating support.
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationGrantTypesSupported :: Maybe [Text] -- ^ "grant_types_supported" - OAuth 2.0 Supported Grant Types  JSON array containing a list of the OAuth 2.0 Grant Type values that this OP supports.
  , OidcConfiguration -> [Text]
oidcConfigurationIdTokenSignedResponseAlg :: [Text] -- ^ /Required/ "id_token_signed_response_alg" - OpenID Connect Default ID Token Signing Algorithms  Algorithm used to sign OpenID Connect ID Tokens.
  , OidcConfiguration -> [Text]
oidcConfigurationIdTokenSigningAlgValuesSupported :: [Text] -- ^ /Required/ "id_token_signing_alg_values_supported" - OpenID Connect Supported ID Token Signing Algorithms  JSON array containing a list of the JWS signing algorithms (alg values) supported by the OP for the ID Token to encode the Claims in a JWT.
  , OidcConfiguration -> Text
oidcConfigurationIssuer :: Text -- ^ /Required/ "issuer" - OpenID Connect Issuer URL  An URL using the https scheme with no query or fragment component that the OP asserts as its IssuerURL Identifier. If IssuerURL discovery is supported , this value MUST be identical to the issuer value returned by WebFinger. This also MUST be identical to the iss Claim value in ID Tokens issued from this IssuerURL.
  , OidcConfiguration -> Text
oidcConfigurationJwksUri :: Text -- ^ /Required/ "jwks_uri" - OpenID Connect Well-Known JSON Web Keys URL  URL of the OP&#39;s JSON Web Key Set [JWK] document. This contains the signing key(s) the RP uses to validate signatures from the OP. The JWK Set MAY also contain the Server&#39;s encryption key(s), which are used by RPs to encrypt requests to the Server. When both signing and encryption keys are made available, a use (Key Use) parameter value is REQUIRED for all keys in the referenced JWK Set to indicate each key&#39;s intended usage. Although some algorithms allow the same key to be used for both signatures and encryption, doing so is NOT RECOMMENDED, as it is less secure. The JWK x5c parameter MAY be used to provide X.509 representations of keys provided. When used, the bare key values MUST still be present and MUST match those in the certificate.
  , OidcConfiguration -> Maybe Text
oidcConfigurationRegistrationEndpoint :: Maybe Text -- ^ "registration_endpoint" - OpenID Connect Dynamic Client Registration Endpoint URL
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationRequestObjectSigningAlgValuesSupported :: Maybe [Text] -- ^ "request_object_signing_alg_values_supported" - OpenID Connect Supported Request Object Signing Algorithms  JSON array containing a list of the JWS signing algorithms (alg values) supported by the OP for Request Objects, which are described in Section 6.1 of OpenID Connect Core 1.0 [OpenID.Core]. These algorithms are used both when the Request Object is passed by value (using the request parameter) and when it is passed by reference (using the request_uri parameter).
  , OidcConfiguration -> Maybe Bool
oidcConfigurationRequestParameterSupported :: Maybe Bool -- ^ "request_parameter_supported" - OpenID Connect Request Parameter Supported  Boolean value specifying whether the OP supports use of the request parameter, with true indicating support.
  , OidcConfiguration -> Maybe Bool
oidcConfigurationRequestUriParameterSupported :: Maybe Bool -- ^ "request_uri_parameter_supported" - OpenID Connect Request URI Parameter Supported  Boolean value specifying whether the OP supports use of the request_uri parameter, with true indicating support.
  , OidcConfiguration -> Maybe Bool
oidcConfigurationRequireRequestUriRegistration :: Maybe Bool -- ^ "require_request_uri_registration" - OpenID Connect Requires Request URI Registration  Boolean value specifying whether the OP requires any request_uri values used to be pre-registered using the request_uris registration parameter.
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationResponseModesSupported :: Maybe [Text] -- ^ "response_modes_supported" - OAuth 2.0 Supported Response Modes  JSON array containing a list of the OAuth 2.0 response_mode values that this OP supports.
  , OidcConfiguration -> [Text]
oidcConfigurationResponseTypesSupported :: [Text] -- ^ /Required/ "response_types_supported" - OAuth 2.0 Supported Response Types  JSON array containing a list of the OAuth 2.0 response_type values that this OP supports. Dynamic OpenID Providers MUST support the code, id_token, and the token id_token Response Type values.
  , OidcConfiguration -> Maybe Text
oidcConfigurationRevocationEndpoint :: Maybe Text -- ^ "revocation_endpoint" - OAuth 2.0 Token Revocation URL  URL of the authorization server&#39;s OAuth 2.0 revocation endpoint.
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationScopesSupported :: Maybe [Text] -- ^ "scopes_supported" - OAuth 2.0 Supported Scope Values  JSON array containing a list of the OAuth 2.0 [RFC6749] scope values that this server supports. The server MUST support the openid scope value. Servers MAY choose not to advertise some supported scope values even when this parameter is used
  , OidcConfiguration -> [Text]
oidcConfigurationSubjectTypesSupported :: [Text] -- ^ /Required/ "subject_types_supported" - OpenID Connect Supported Subject Types  JSON array containing a list of the Subject Identifier types that this OP supports. Valid types include pairwise and public.
  , OidcConfiguration -> Text
oidcConfigurationTokenEndpoint :: Text -- ^ /Required/ "token_endpoint" - OAuth 2.0 Token Endpoint URL
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationTokenEndpointAuthMethodsSupported :: Maybe [Text] -- ^ "token_endpoint_auth_methods_supported" - OAuth 2.0 Supported Client Authentication Methods  JSON array containing a list of Client Authentication methods supported by this Token Endpoint. The options are client_secret_post, client_secret_basic, client_secret_jwt, and private_key_jwt, as described in Section 9 of OpenID Connect Core 1.0
  , OidcConfiguration -> Maybe Text
oidcConfigurationUserinfoEndpoint :: Maybe Text -- ^ "userinfo_endpoint" - OpenID Connect Userinfo URL  URL of the OP&#39;s UserInfo Endpoint.
  , OidcConfiguration -> [Text]
oidcConfigurationUserinfoSignedResponseAlg :: [Text] -- ^ /Required/ "userinfo_signed_response_alg" - OpenID Connect User Userinfo Signing Algorithm  Algorithm used to sign OpenID Connect Userinfo Responses.
  , OidcConfiguration -> Maybe [Text]
oidcConfigurationUserinfoSigningAlgValuesSupported :: Maybe [Text] -- ^ "userinfo_signing_alg_values_supported" - OpenID Connect Supported Userinfo Signing Algorithm  JSON array containing a list of the JWS [JWS] signing algorithms (alg values) [JWA] supported by the UserInfo Endpoint to encode the Claims in a JWT [JWT].
  } deriving (Int -> OidcConfiguration -> ShowS
[OidcConfiguration] -> ShowS
OidcConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OidcConfiguration] -> ShowS
$cshowList :: [OidcConfiguration] -> ShowS
show :: OidcConfiguration -> String
$cshow :: OidcConfiguration -> String
showsPrec :: Int -> OidcConfiguration -> ShowS
$cshowsPrec :: Int -> OidcConfiguration -> ShowS
P.Show, OidcConfiguration -> OidcConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OidcConfiguration -> OidcConfiguration -> Bool
$c/= :: OidcConfiguration -> OidcConfiguration -> Bool
== :: OidcConfiguration -> OidcConfiguration -> Bool
$c== :: OidcConfiguration -> OidcConfiguration -> Bool
P.Eq, P.Typeable)

-- | FromJSON OidcConfiguration
instance A.FromJSON OidcConfiguration where
  parseJSON :: Value -> Parser OidcConfiguration
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OidcConfiguration" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> [Text]
-> [Text]
-> Text
-> Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> [Text]
-> Maybe Text
-> Maybe [Text]
-> [Text]
-> Text
-> Maybe [Text]
-> Maybe Text
-> [Text]
-> Maybe [Text]
-> OidcConfiguration
OidcConfiguration
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"authorization_endpoint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backchannel_logout_session_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backchannel_logout_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"claims_parameter_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"claims_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code_challenge_methods_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"end_session_endpoint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontchannel_logout_session_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontchannel_logout_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grant_types_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id_token_signed_response_alg")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id_token_signing_alg_values_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"issuer")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"jwks_uri")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"registration_endpoint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_object_signing_alg_values_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_parameter_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_uri_parameter_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"require_request_uri_registration")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_modes_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"response_types_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"revocation_endpoint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scopes_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"subject_types_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"token_endpoint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_endpoint_auth_methods_supported")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"userinfo_endpoint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"userinfo_signed_response_alg")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"userinfo_signing_alg_values_supported")

-- | ToJSON OidcConfiguration
instance A.ToJSON OidcConfiguration where
  toJSON :: OidcConfiguration -> Value
toJSON OidcConfiguration {[Text]
Maybe Bool
Maybe [Text]
Maybe Text
Text
oidcConfigurationUserinfoSigningAlgValuesSupported :: Maybe [Text]
oidcConfigurationUserinfoSignedResponseAlg :: [Text]
oidcConfigurationUserinfoEndpoint :: Maybe Text
oidcConfigurationTokenEndpointAuthMethodsSupported :: Maybe [Text]
oidcConfigurationTokenEndpoint :: Text
oidcConfigurationSubjectTypesSupported :: [Text]
oidcConfigurationScopesSupported :: Maybe [Text]
oidcConfigurationRevocationEndpoint :: Maybe Text
oidcConfigurationResponseTypesSupported :: [Text]
oidcConfigurationResponseModesSupported :: Maybe [Text]
oidcConfigurationRequireRequestUriRegistration :: Maybe Bool
oidcConfigurationRequestUriParameterSupported :: Maybe Bool
oidcConfigurationRequestParameterSupported :: Maybe Bool
oidcConfigurationRequestObjectSigningAlgValuesSupported :: Maybe [Text]
oidcConfigurationRegistrationEndpoint :: Maybe Text
oidcConfigurationJwksUri :: Text
oidcConfigurationIssuer :: Text
oidcConfigurationIdTokenSigningAlgValuesSupported :: [Text]
oidcConfigurationIdTokenSignedResponseAlg :: [Text]
oidcConfigurationGrantTypesSupported :: Maybe [Text]
oidcConfigurationFrontchannelLogoutSupported :: Maybe Bool
oidcConfigurationFrontchannelLogoutSessionSupported :: Maybe Bool
oidcConfigurationEndSessionEndpoint :: Maybe Text
oidcConfigurationCodeChallengeMethodsSupported :: Maybe [Text]
oidcConfigurationClaimsSupported :: Maybe [Text]
oidcConfigurationClaimsParameterSupported :: Maybe Bool
oidcConfigurationBackchannelLogoutSupported :: Maybe Bool
oidcConfigurationBackchannelLogoutSessionSupported :: Maybe Bool
oidcConfigurationAuthorizationEndpoint :: Text
oidcConfigurationUserinfoSigningAlgValuesSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationUserinfoSignedResponseAlg :: OidcConfiguration -> [Text]
oidcConfigurationUserinfoEndpoint :: OidcConfiguration -> Maybe Text
oidcConfigurationTokenEndpointAuthMethodsSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationTokenEndpoint :: OidcConfiguration -> Text
oidcConfigurationSubjectTypesSupported :: OidcConfiguration -> [Text]
oidcConfigurationScopesSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationRevocationEndpoint :: OidcConfiguration -> Maybe Text
oidcConfigurationResponseTypesSupported :: OidcConfiguration -> [Text]
oidcConfigurationResponseModesSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationRequireRequestUriRegistration :: OidcConfiguration -> Maybe Bool
oidcConfigurationRequestUriParameterSupported :: OidcConfiguration -> Maybe Bool
oidcConfigurationRequestParameterSupported :: OidcConfiguration -> Maybe Bool
oidcConfigurationRequestObjectSigningAlgValuesSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationRegistrationEndpoint :: OidcConfiguration -> Maybe Text
oidcConfigurationJwksUri :: OidcConfiguration -> Text
oidcConfigurationIssuer :: OidcConfiguration -> Text
oidcConfigurationIdTokenSigningAlgValuesSupported :: OidcConfiguration -> [Text]
oidcConfigurationIdTokenSignedResponseAlg :: OidcConfiguration -> [Text]
oidcConfigurationGrantTypesSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationFrontchannelLogoutSupported :: OidcConfiguration -> Maybe Bool
oidcConfigurationFrontchannelLogoutSessionSupported :: OidcConfiguration -> Maybe Bool
oidcConfigurationEndSessionEndpoint :: OidcConfiguration -> Maybe Text
oidcConfigurationCodeChallengeMethodsSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationClaimsSupported :: OidcConfiguration -> Maybe [Text]
oidcConfigurationClaimsParameterSupported :: OidcConfiguration -> Maybe Bool
oidcConfigurationBackchannelLogoutSupported :: OidcConfiguration -> Maybe Bool
oidcConfigurationBackchannelLogoutSessionSupported :: OidcConfiguration -> Maybe Bool
oidcConfigurationAuthorizationEndpoint :: OidcConfiguration -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"authorization_endpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oidcConfigurationAuthorizationEndpoint
      , Key
"backchannel_logout_session_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationBackchannelLogoutSessionSupported
      , Key
"backchannel_logout_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationBackchannelLogoutSupported
      , Key
"claims_parameter_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationClaimsParameterSupported
      , Key
"claims_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationClaimsSupported
      , Key
"code_challenge_methods_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationCodeChallengeMethodsSupported
      , Key
"end_session_endpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcConfigurationEndSessionEndpoint
      , Key
"frontchannel_logout_session_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationFrontchannelLogoutSessionSupported
      , Key
"frontchannel_logout_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationFrontchannelLogoutSupported
      , Key
"grant_types_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationGrantTypesSupported
      , Key
"id_token_signed_response_alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
oidcConfigurationIdTokenSignedResponseAlg
      , Key
"id_token_signing_alg_values_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
oidcConfigurationIdTokenSigningAlgValuesSupported
      , Key
"issuer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oidcConfigurationIssuer
      , Key
"jwks_uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oidcConfigurationJwksUri
      , Key
"registration_endpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcConfigurationRegistrationEndpoint
      , Key
"request_object_signing_alg_values_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationRequestObjectSigningAlgValuesSupported
      , Key
"request_parameter_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationRequestParameterSupported
      , Key
"request_uri_parameter_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationRequestUriParameterSupported
      , Key
"require_request_uri_registration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcConfigurationRequireRequestUriRegistration
      , Key
"response_modes_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationResponseModesSupported
      , Key
"response_types_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
oidcConfigurationResponseTypesSupported
      , Key
"revocation_endpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcConfigurationRevocationEndpoint
      , Key
"scopes_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationScopesSupported
      , Key
"subject_types_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
oidcConfigurationSubjectTypesSupported
      , Key
"token_endpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
oidcConfigurationTokenEndpoint
      , Key
"token_endpoint_auth_methods_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationTokenEndpointAuthMethodsSupported
      , Key
"userinfo_endpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcConfigurationUserinfoEndpoint
      , Key
"userinfo_signed_response_alg" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
oidcConfigurationUserinfoSignedResponseAlg
      , Key
"userinfo_signing_alg_values_supported" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oidcConfigurationUserinfoSigningAlgValuesSupported
      ]


-- | Construct a value of type 'OidcConfiguration' (by applying it's required fields, if any)
mkOidcConfiguration
  :: Text -- ^ 'oidcConfigurationAuthorizationEndpoint': OAuth 2.0 Authorization Endpoint URL
  -> [Text] -- ^ 'oidcConfigurationIdTokenSignedResponseAlg': OpenID Connect Default ID Token Signing Algorithms  Algorithm used to sign OpenID Connect ID Tokens.
  -> [Text] -- ^ 'oidcConfigurationIdTokenSigningAlgValuesSupported': OpenID Connect Supported ID Token Signing Algorithms  JSON array containing a list of the JWS signing algorithms (alg values) supported by the OP for the ID Token to encode the Claims in a JWT.
  -> Text -- ^ 'oidcConfigurationIssuer': OpenID Connect Issuer URL  An URL using the https scheme with no query or fragment component that the OP asserts as its IssuerURL Identifier. If IssuerURL discovery is supported , this value MUST be identical to the issuer value returned by WebFinger. This also MUST be identical to the iss Claim value in ID Tokens issued from this IssuerURL.
  -> Text -- ^ 'oidcConfigurationJwksUri': OpenID Connect Well-Known JSON Web Keys URL  URL of the OP's JSON Web Key Set [JWK] document. This contains the signing key(s) the RP uses to validate signatures from the OP. The JWK Set MAY also contain the Server's encryption key(s), which are used by RPs to encrypt requests to the Server. When both signing and encryption keys are made available, a use (Key Use) parameter value is REQUIRED for all keys in the referenced JWK Set to indicate each key's intended usage. Although some algorithms allow the same key to be used for both signatures and encryption, doing so is NOT RECOMMENDED, as it is less secure. The JWK x5c parameter MAY be used to provide X.509 representations of keys provided. When used, the bare key values MUST still be present and MUST match those in the certificate.
  -> [Text] -- ^ 'oidcConfigurationResponseTypesSupported': OAuth 2.0 Supported Response Types  JSON array containing a list of the OAuth 2.0 response_type values that this OP supports. Dynamic OpenID Providers MUST support the code, id_token, and the token id_token Response Type values.
  -> [Text] -- ^ 'oidcConfigurationSubjectTypesSupported': OpenID Connect Supported Subject Types  JSON array containing a list of the Subject Identifier types that this OP supports. Valid types include pairwise and public.
  -> Text -- ^ 'oidcConfigurationTokenEndpoint': OAuth 2.0 Token Endpoint URL
  -> [Text] -- ^ 'oidcConfigurationUserinfoSignedResponseAlg': OpenID Connect User Userinfo Signing Algorithm  Algorithm used to sign OpenID Connect Userinfo Responses.
  -> OidcConfiguration
mkOidcConfiguration :: Text
-> [Text]
-> [Text]
-> Text
-> Text
-> [Text]
-> [Text]
-> Text
-> [Text]
-> OidcConfiguration
mkOidcConfiguration Text
oidcConfigurationAuthorizationEndpoint [Text]
oidcConfigurationIdTokenSignedResponseAlg [Text]
oidcConfigurationIdTokenSigningAlgValuesSupported Text
oidcConfigurationIssuer Text
oidcConfigurationJwksUri [Text]
oidcConfigurationResponseTypesSupported [Text]
oidcConfigurationSubjectTypesSupported Text
oidcConfigurationTokenEndpoint [Text]
oidcConfigurationUserinfoSignedResponseAlg =
  OidcConfiguration
  { Text
oidcConfigurationAuthorizationEndpoint :: Text
oidcConfigurationAuthorizationEndpoint :: Text
oidcConfigurationAuthorizationEndpoint
  , oidcConfigurationBackchannelLogoutSessionSupported :: Maybe Bool
oidcConfigurationBackchannelLogoutSessionSupported = forall a. Maybe a
Nothing
  , oidcConfigurationBackchannelLogoutSupported :: Maybe Bool
oidcConfigurationBackchannelLogoutSupported = forall a. Maybe a
Nothing
  , oidcConfigurationClaimsParameterSupported :: Maybe Bool
oidcConfigurationClaimsParameterSupported = forall a. Maybe a
Nothing
  , oidcConfigurationClaimsSupported :: Maybe [Text]
oidcConfigurationClaimsSupported = forall a. Maybe a
Nothing
  , oidcConfigurationCodeChallengeMethodsSupported :: Maybe [Text]
oidcConfigurationCodeChallengeMethodsSupported = forall a. Maybe a
Nothing
  , oidcConfigurationEndSessionEndpoint :: Maybe Text
oidcConfigurationEndSessionEndpoint = forall a. Maybe a
Nothing
  , oidcConfigurationFrontchannelLogoutSessionSupported :: Maybe Bool
oidcConfigurationFrontchannelLogoutSessionSupported = forall a. Maybe a
Nothing
  , oidcConfigurationFrontchannelLogoutSupported :: Maybe Bool
oidcConfigurationFrontchannelLogoutSupported = forall a. Maybe a
Nothing
  , oidcConfigurationGrantTypesSupported :: Maybe [Text]
oidcConfigurationGrantTypesSupported = forall a. Maybe a
Nothing
  , [Text]
oidcConfigurationIdTokenSignedResponseAlg :: [Text]
oidcConfigurationIdTokenSignedResponseAlg :: [Text]
oidcConfigurationIdTokenSignedResponseAlg
  , [Text]
oidcConfigurationIdTokenSigningAlgValuesSupported :: [Text]
oidcConfigurationIdTokenSigningAlgValuesSupported :: [Text]
oidcConfigurationIdTokenSigningAlgValuesSupported
  , Text
oidcConfigurationIssuer :: Text
oidcConfigurationIssuer :: Text
oidcConfigurationIssuer
  , Text
oidcConfigurationJwksUri :: Text
oidcConfigurationJwksUri :: Text
oidcConfigurationJwksUri
  , oidcConfigurationRegistrationEndpoint :: Maybe Text
oidcConfigurationRegistrationEndpoint = forall a. Maybe a
Nothing
  , oidcConfigurationRequestObjectSigningAlgValuesSupported :: Maybe [Text]
oidcConfigurationRequestObjectSigningAlgValuesSupported = forall a. Maybe a
Nothing
  , oidcConfigurationRequestParameterSupported :: Maybe Bool
oidcConfigurationRequestParameterSupported = forall a. Maybe a
Nothing
  , oidcConfigurationRequestUriParameterSupported :: Maybe Bool
oidcConfigurationRequestUriParameterSupported = forall a. Maybe a
Nothing
  , oidcConfigurationRequireRequestUriRegistration :: Maybe Bool
oidcConfigurationRequireRequestUriRegistration = forall a. Maybe a
Nothing
  , oidcConfigurationResponseModesSupported :: Maybe [Text]
oidcConfigurationResponseModesSupported = forall a. Maybe a
Nothing
  , [Text]
oidcConfigurationResponseTypesSupported :: [Text]
oidcConfigurationResponseTypesSupported :: [Text]
oidcConfigurationResponseTypesSupported
  , oidcConfigurationRevocationEndpoint :: Maybe Text
oidcConfigurationRevocationEndpoint = forall a. Maybe a
Nothing
  , oidcConfigurationScopesSupported :: Maybe [Text]
oidcConfigurationScopesSupported = forall a. Maybe a
Nothing
  , [Text]
oidcConfigurationSubjectTypesSupported :: [Text]
oidcConfigurationSubjectTypesSupported :: [Text]
oidcConfigurationSubjectTypesSupported
  , Text
oidcConfigurationTokenEndpoint :: Text
oidcConfigurationTokenEndpoint :: Text
oidcConfigurationTokenEndpoint
  , oidcConfigurationTokenEndpointAuthMethodsSupported :: Maybe [Text]
oidcConfigurationTokenEndpointAuthMethodsSupported = forall a. Maybe a
Nothing
  , oidcConfigurationUserinfoEndpoint :: Maybe Text
oidcConfigurationUserinfoEndpoint = forall a. Maybe a
Nothing
  , [Text]
oidcConfigurationUserinfoSignedResponseAlg :: [Text]
oidcConfigurationUserinfoSignedResponseAlg :: [Text]
oidcConfigurationUserinfoSignedResponseAlg
  , oidcConfigurationUserinfoSigningAlgValuesSupported :: Maybe [Text]
oidcConfigurationUserinfoSigningAlgValuesSupported = forall a. Maybe a
Nothing
  }

-- ** OidcUserInfo
-- | OidcUserInfo
-- OpenID Connect Userinfo
data OidcUserInfo = OidcUserInfo
  { OidcUserInfo -> Maybe Text
oidcUserInfoBirthdate :: Maybe Text -- ^ "birthdate" - End-User&#39;s birthday, represented as an ISO 8601:2004 [ISO8601‑2004] YYYY-MM-DD format. The year MAY be 0000, indicating that it is omitted. To represent only the year, YYYY format is allowed. Note that depending on the underlying platform&#39;s date related function, providing just year can result in varying month and day, so the implementers need to take this factor into account to correctly process the dates.
  , OidcUserInfo -> Maybe Text
oidcUserInfoEmail :: Maybe Text -- ^ "email" - End-User&#39;s preferred e-mail address. Its value MUST conform to the RFC 5322 [RFC5322] addr-spec syntax. The RP MUST NOT rely upon this value being unique, as discussed in Section 5.7.
  , OidcUserInfo -> Maybe Bool
oidcUserInfoEmailVerified :: Maybe Bool -- ^ "email_verified" - True if the End-User&#39;s e-mail address has been verified; otherwise false. When this Claim Value is true, this means that the OP took affirmative steps to ensure that this e-mail address was controlled by the End-User at the time the verification was performed. The means by which an e-mail address is verified is context-specific, and dependent upon the trust framework or contractual agreements within which the parties are operating.
  , OidcUserInfo -> Maybe Text
oidcUserInfoFamilyName :: Maybe Text -- ^ "family_name" - Surname(s) or last name(s) of the End-User. Note that in some cultures, people can have multiple family names or no family name; all can be present, with the names being separated by space characters.
  , OidcUserInfo -> Maybe Text
oidcUserInfoGender :: Maybe Text -- ^ "gender" - End-User&#39;s gender. Values defined by this specification are female and male. Other values MAY be used when neither of the defined values are applicable.
  , OidcUserInfo -> Maybe Text
oidcUserInfoGivenName :: Maybe Text -- ^ "given_name" - Given name(s) or first name(s) of the End-User. Note that in some cultures, people can have multiple given names; all can be present, with the names being separated by space characters.
  , OidcUserInfo -> Maybe Text
oidcUserInfoLocale :: Maybe Text -- ^ "locale" - End-User&#39;s locale, represented as a BCP47 [RFC5646] language tag. This is typically an ISO 639-1 Alpha-2 [ISO639‑1] language code in lowercase and an ISO 3166-1 Alpha-2 [ISO3166‑1] country code in uppercase, separated by a dash. For example, en-US or fr-CA. As a compatibility note, some implementations have used an underscore as the separator rather than a dash, for example, en_US; Relying Parties MAY choose to accept this locale syntax as well.
  , OidcUserInfo -> Maybe Text
oidcUserInfoMiddleName :: Maybe Text -- ^ "middle_name" - Middle name(s) of the End-User. Note that in some cultures, people can have multiple middle names; all can be present, with the names being separated by space characters. Also note that in some cultures, middle names are not used.
  , OidcUserInfo -> Maybe Text
oidcUserInfoName :: Maybe Text -- ^ "name" - End-User&#39;s full name in displayable form including all name parts, possibly including titles and suffixes, ordered according to the End-User&#39;s locale and preferences.
  , OidcUserInfo -> Maybe Text
oidcUserInfoNickname :: Maybe Text -- ^ "nickname" - Casual name of the End-User that may or may not be the same as the given_name. For instance, a nickname value of Mike might be returned alongside a given_name value of Michael.
  , OidcUserInfo -> Maybe Text
oidcUserInfoPhoneNumber :: Maybe Text -- ^ "phone_number" - End-User&#39;s preferred telephone number. E.164 [E.164] is RECOMMENDED as the format of this Claim, for example, +1 (425) 555-1212 or +56 (2) 687 2400. If the phone number contains an extension, it is RECOMMENDED that the extension be represented using the RFC 3966 [RFC3966] extension syntax, for example, +1 (604) 555-1234;ext&#x3D;5678.
  , OidcUserInfo -> Maybe Bool
oidcUserInfoPhoneNumberVerified :: Maybe Bool -- ^ "phone_number_verified" - True if the End-User&#39;s phone number has been verified; otherwise false. When this Claim Value is true, this means that the OP took affirmative steps to ensure that this phone number was controlled by the End-User at the time the verification was performed. The means by which a phone number is verified is context-specific, and dependent upon the trust framework or contractual agreements within which the parties are operating. When true, the phone_number Claim MUST be in E.164 format and any extensions MUST be represented in RFC 3966 format.
  , OidcUserInfo -> Maybe Text
oidcUserInfoPicture :: Maybe Text -- ^ "picture" - URL of the End-User&#39;s profile picture. This URL MUST refer to an image file (for example, a PNG, JPEG, or GIF image file), rather than to a Web page containing an image. Note that this URL SHOULD specifically reference a profile photo of the End-User suitable for displaying when describing the End-User, rather than an arbitrary photo taken by the End-User.
  , OidcUserInfo -> Maybe Text
oidcUserInfoPreferredUsername :: Maybe Text -- ^ "preferred_username" - Non-unique shorthand name by which the End-User wishes to be referred to at the RP, such as janedoe or j.doe. This value MAY be any valid JSON string including special characters such as @, /, or whitespace.
  , OidcUserInfo -> Maybe Text
oidcUserInfoProfile :: Maybe Text -- ^ "profile" - URL of the End-User&#39;s profile page. The contents of this Web page SHOULD be about the End-User.
  , OidcUserInfo -> Maybe Text
oidcUserInfoSub :: Maybe Text -- ^ "sub" - Subject - Identifier for the End-User at the IssuerURL.
  , OidcUserInfo -> Maybe Integer
oidcUserInfoUpdatedAt :: Maybe Integer -- ^ "updated_at" - Time the End-User&#39;s information was last updated. Its value is a JSON number representing the number of seconds from 1970-01-01T0:0:0Z as measured in UTC until the date/time.
  , OidcUserInfo -> Maybe Text
oidcUserInfoWebsite :: Maybe Text -- ^ "website" - URL of the End-User&#39;s Web page or blog. This Web page SHOULD contain information published by the End-User or an organization that the End-User is affiliated with.
  , OidcUserInfo -> Maybe Text
oidcUserInfoZoneinfo :: Maybe Text -- ^ "zoneinfo" - String from zoneinfo [zoneinfo] time zone database representing the End-User&#39;s time zone. For example, Europe/Paris or America/Los_Angeles.
  } deriving (Int -> OidcUserInfo -> ShowS
[OidcUserInfo] -> ShowS
OidcUserInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OidcUserInfo] -> ShowS
$cshowList :: [OidcUserInfo] -> ShowS
show :: OidcUserInfo -> String
$cshow :: OidcUserInfo -> String
showsPrec :: Int -> OidcUserInfo -> ShowS
$cshowsPrec :: Int -> OidcUserInfo -> ShowS
P.Show, OidcUserInfo -> OidcUserInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OidcUserInfo -> OidcUserInfo -> Bool
$c/= :: OidcUserInfo -> OidcUserInfo -> Bool
== :: OidcUserInfo -> OidcUserInfo -> Bool
$c== :: OidcUserInfo -> OidcUserInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON OidcUserInfo
instance A.FromJSON OidcUserInfo where
  parseJSON :: Value -> Parser OidcUserInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OidcUserInfo" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> OidcUserInfo
OidcUserInfo
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"birthdate")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email_verified")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"family_name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"gender")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"given_name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"locale")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"middle_name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nickname")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"phone_number")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"phone_number_verified")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"picture")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"preferred_username")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"profile")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sub")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"zoneinfo")

-- | ToJSON OidcUserInfo
instance A.ToJSON OidcUserInfo where
  toJSON :: OidcUserInfo -> Value
toJSON OidcUserInfo {Maybe Bool
Maybe Integer
Maybe Text
oidcUserInfoZoneinfo :: Maybe Text
oidcUserInfoWebsite :: Maybe Text
oidcUserInfoUpdatedAt :: Maybe Integer
oidcUserInfoSub :: Maybe Text
oidcUserInfoProfile :: Maybe Text
oidcUserInfoPreferredUsername :: Maybe Text
oidcUserInfoPicture :: Maybe Text
oidcUserInfoPhoneNumberVerified :: Maybe Bool
oidcUserInfoPhoneNumber :: Maybe Text
oidcUserInfoNickname :: Maybe Text
oidcUserInfoName :: Maybe Text
oidcUserInfoMiddleName :: Maybe Text
oidcUserInfoLocale :: Maybe Text
oidcUserInfoGivenName :: Maybe Text
oidcUserInfoGender :: Maybe Text
oidcUserInfoFamilyName :: Maybe Text
oidcUserInfoEmailVerified :: Maybe Bool
oidcUserInfoEmail :: Maybe Text
oidcUserInfoBirthdate :: Maybe Text
oidcUserInfoZoneinfo :: OidcUserInfo -> Maybe Text
oidcUserInfoWebsite :: OidcUserInfo -> Maybe Text
oidcUserInfoUpdatedAt :: OidcUserInfo -> Maybe Integer
oidcUserInfoSub :: OidcUserInfo -> Maybe Text
oidcUserInfoProfile :: OidcUserInfo -> Maybe Text
oidcUserInfoPreferredUsername :: OidcUserInfo -> Maybe Text
oidcUserInfoPicture :: OidcUserInfo -> Maybe Text
oidcUserInfoPhoneNumberVerified :: OidcUserInfo -> Maybe Bool
oidcUserInfoPhoneNumber :: OidcUserInfo -> Maybe Text
oidcUserInfoNickname :: OidcUserInfo -> Maybe Text
oidcUserInfoName :: OidcUserInfo -> Maybe Text
oidcUserInfoMiddleName :: OidcUserInfo -> Maybe Text
oidcUserInfoLocale :: OidcUserInfo -> Maybe Text
oidcUserInfoGivenName :: OidcUserInfo -> Maybe Text
oidcUserInfoGender :: OidcUserInfo -> Maybe Text
oidcUserInfoFamilyName :: OidcUserInfo -> Maybe Text
oidcUserInfoEmailVerified :: OidcUserInfo -> Maybe Bool
oidcUserInfoEmail :: OidcUserInfo -> Maybe Text
oidcUserInfoBirthdate :: OidcUserInfo -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"birthdate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoBirthdate
      , Key
"email" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoEmail
      , Key
"email_verified" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcUserInfoEmailVerified
      , Key
"family_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoFamilyName
      , Key
"gender" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoGender
      , Key
"given_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoGivenName
      , Key
"locale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoLocale
      , Key
"middle_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoMiddleName
      , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoName
      , Key
"nickname" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoNickname
      , Key
"phone_number" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoPhoneNumber
      , Key
"phone_number_verified" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oidcUserInfoPhoneNumberVerified
      , Key
"picture" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoPicture
      , Key
"preferred_username" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoPreferredUsername
      , Key
"profile" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoProfile
      , Key
"sub" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoSub
      , Key
"updated_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oidcUserInfoUpdatedAt
      , Key
"website" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoWebsite
      , Key
"zoneinfo" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oidcUserInfoZoneinfo
      ]


-- | Construct a value of type 'OidcUserInfo' (by applying it's required fields, if any)
mkOidcUserInfo
  :: OidcUserInfo
mkOidcUserInfo :: OidcUserInfo
mkOidcUserInfo =
  OidcUserInfo
  { oidcUserInfoBirthdate :: Maybe Text
oidcUserInfoBirthdate = forall a. Maybe a
Nothing
  , oidcUserInfoEmail :: Maybe Text
oidcUserInfoEmail = forall a. Maybe a
Nothing
  , oidcUserInfoEmailVerified :: Maybe Bool
oidcUserInfoEmailVerified = forall a. Maybe a
Nothing
  , oidcUserInfoFamilyName :: Maybe Text
oidcUserInfoFamilyName = forall a. Maybe a
Nothing
  , oidcUserInfoGender :: Maybe Text
oidcUserInfoGender = forall a. Maybe a
Nothing
  , oidcUserInfoGivenName :: Maybe Text
oidcUserInfoGivenName = forall a. Maybe a
Nothing
  , oidcUserInfoLocale :: Maybe Text
oidcUserInfoLocale = forall a. Maybe a
Nothing
  , oidcUserInfoMiddleName :: Maybe Text
oidcUserInfoMiddleName = forall a. Maybe a
Nothing
  , oidcUserInfoName :: Maybe Text
oidcUserInfoName = forall a. Maybe a
Nothing
  , oidcUserInfoNickname :: Maybe Text
oidcUserInfoNickname = forall a. Maybe a
Nothing
  , oidcUserInfoPhoneNumber :: Maybe Text
oidcUserInfoPhoneNumber = forall a. Maybe a
Nothing
  , oidcUserInfoPhoneNumberVerified :: Maybe Bool
oidcUserInfoPhoneNumberVerified = forall a. Maybe a
Nothing
  , oidcUserInfoPicture :: Maybe Text
oidcUserInfoPicture = forall a. Maybe a
Nothing
  , oidcUserInfoPreferredUsername :: Maybe Text
oidcUserInfoPreferredUsername = forall a. Maybe a
Nothing
  , oidcUserInfoProfile :: Maybe Text
oidcUserInfoProfile = forall a. Maybe a
Nothing
  , oidcUserInfoSub :: Maybe Text
oidcUserInfoSub = forall a. Maybe a
Nothing
  , oidcUserInfoUpdatedAt :: Maybe Integer
oidcUserInfoUpdatedAt = forall a. Maybe a
Nothing
  , oidcUserInfoWebsite :: Maybe Text
oidcUserInfoWebsite = forall a. Maybe a
Nothing
  , oidcUserInfoZoneinfo :: Maybe Text
oidcUserInfoZoneinfo = forall a. Maybe a
Nothing
  }

-- ** Pagination
-- | Pagination
data Pagination = Pagination
  { Pagination -> Maybe Integer
paginationPageSize :: Maybe Integer -- ^ "page_size" - Items per page  This is the number of items per page to return. For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
  , Pagination -> Maybe Text
paginationPageToken :: Maybe Text -- ^ "page_token" - Next Page Token  The next page token. For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
  } deriving (Int -> Pagination -> ShowS
[Pagination] -> ShowS
Pagination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pagination] -> ShowS
$cshowList :: [Pagination] -> ShowS
show :: Pagination -> String
$cshow :: Pagination -> String
showsPrec :: Int -> Pagination -> ShowS
$cshowsPrec :: Int -> Pagination -> ShowS
P.Show, Pagination -> Pagination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pagination -> Pagination -> Bool
$c/= :: Pagination -> Pagination -> Bool
== :: Pagination -> Pagination -> Bool
$c== :: Pagination -> Pagination -> Bool
P.Eq, P.Typeable)

-- | FromJSON Pagination
instance A.FromJSON Pagination where
  parseJSON :: Value -> Parser Pagination
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Pagination" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Text -> Pagination
Pagination
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page_size")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page_token")

-- | ToJSON Pagination
instance A.ToJSON Pagination where
  toJSON :: Pagination -> Value
toJSON Pagination {Maybe Integer
Maybe Text
paginationPageToken :: Maybe Text
paginationPageSize :: Maybe Integer
paginationPageToken :: Pagination -> Maybe Text
paginationPageSize :: Pagination -> Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"page_size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
paginationPageSize
      , Key
"page_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
paginationPageToken
      ]


-- | Construct a value of type 'Pagination' (by applying it's required fields, if any)
mkPagination
  :: Pagination
mkPagination :: Pagination
mkPagination =
  Pagination
  { paginationPageSize :: Maybe Integer
paginationPageSize = forall a. Maybe a
Nothing
  , paginationPageToken :: Maybe Text
paginationPageToken = forall a. Maybe a
Nothing
  }

-- ** PaginationHeaders
-- | PaginationHeaders
data PaginationHeaders = PaginationHeaders
  { PaginationHeaders -> Maybe Text
paginationHeadersLink :: Maybe Text -- ^ "link" - The link header contains pagination links.  For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).  in: header
  , PaginationHeaders -> Maybe Text
paginationHeadersXTotalCount :: Maybe Text -- ^ "x-total-count" - The total number of clients.  in: header
  } deriving (Int -> PaginationHeaders -> ShowS
[PaginationHeaders] -> ShowS
PaginationHeaders -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaginationHeaders] -> ShowS
$cshowList :: [PaginationHeaders] -> ShowS
show :: PaginationHeaders -> String
$cshow :: PaginationHeaders -> String
showsPrec :: Int -> PaginationHeaders -> ShowS
$cshowsPrec :: Int -> PaginationHeaders -> ShowS
P.Show, PaginationHeaders -> PaginationHeaders -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaginationHeaders -> PaginationHeaders -> Bool
$c/= :: PaginationHeaders -> PaginationHeaders -> Bool
== :: PaginationHeaders -> PaginationHeaders -> Bool
$c== :: PaginationHeaders -> PaginationHeaders -> Bool
P.Eq, P.Typeable)

-- | FromJSON PaginationHeaders
instance A.FromJSON PaginationHeaders where
  parseJSON :: Value -> Parser PaginationHeaders
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PaginationHeaders" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> PaginationHeaders
PaginationHeaders
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"link")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x-total-count")

-- | ToJSON PaginationHeaders
instance A.ToJSON PaginationHeaders where
  toJSON :: PaginationHeaders -> Value
toJSON PaginationHeaders {Maybe Text
paginationHeadersXTotalCount :: Maybe Text
paginationHeadersLink :: Maybe Text
paginationHeadersXTotalCount :: PaginationHeaders -> Maybe Text
paginationHeadersLink :: PaginationHeaders -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"link" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
paginationHeadersLink
      , Key
"x-total-count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
paginationHeadersXTotalCount
      ]


-- | Construct a value of type 'PaginationHeaders' (by applying it's required fields, if any)
mkPaginationHeaders
  :: PaginationHeaders
mkPaginationHeaders :: PaginationHeaders
mkPaginationHeaders =
  PaginationHeaders
  { paginationHeadersLink :: Maybe Text
paginationHeadersLink = forall a. Maybe a
Nothing
  , paginationHeadersXTotalCount :: Maybe Text
paginationHeadersXTotalCount = forall a. Maybe a
Nothing
  }

-- ** RejectOAuth2Request
-- | RejectOAuth2Request
-- The request payload used to accept a login or consent request.
-- 
data RejectOAuth2Request = RejectOAuth2Request
  { RejectOAuth2Request -> Maybe Text
rejectOAuth2RequestError :: Maybe Text -- ^ "error" - The error should follow the OAuth2 error format (e.g. &#x60;invalid_request&#x60;, &#x60;login_required&#x60;).  Defaults to &#x60;request_denied&#x60;.
  , RejectOAuth2Request -> Maybe Text
rejectOAuth2RequestErrorDebug :: Maybe Text -- ^ "error_debug" - Debug contains information to help resolve the problem as a developer. Usually not exposed to the public but only in the server logs.
  , RejectOAuth2Request -> Maybe Text
rejectOAuth2RequestErrorDescription :: Maybe Text -- ^ "error_description" - Description of the error in a human readable format.
  , RejectOAuth2Request -> Maybe Text
rejectOAuth2RequestErrorHint :: Maybe Text -- ^ "error_hint" - Hint to help resolve the error.
  , RejectOAuth2Request -> Maybe Integer
rejectOAuth2RequestStatusCode :: Maybe Integer -- ^ "status_code" - Represents the HTTP status code of the error (e.g. 401 or 403)  Defaults to 400
  } deriving (Int -> RejectOAuth2Request -> ShowS
[RejectOAuth2Request] -> ShowS
RejectOAuth2Request -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RejectOAuth2Request] -> ShowS
$cshowList :: [RejectOAuth2Request] -> ShowS
show :: RejectOAuth2Request -> String
$cshow :: RejectOAuth2Request -> String
showsPrec :: Int -> RejectOAuth2Request -> ShowS
$cshowsPrec :: Int -> RejectOAuth2Request -> ShowS
P.Show, RejectOAuth2Request -> RejectOAuth2Request -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RejectOAuth2Request -> RejectOAuth2Request -> Bool
$c/= :: RejectOAuth2Request -> RejectOAuth2Request -> Bool
== :: RejectOAuth2Request -> RejectOAuth2Request -> Bool
$c== :: RejectOAuth2Request -> RejectOAuth2Request -> Bool
P.Eq, P.Typeable)

-- | FromJSON RejectOAuth2Request
instance A.FromJSON RejectOAuth2Request where
  parseJSON :: Value -> Parser RejectOAuth2Request
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RejectOAuth2Request" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> RejectOAuth2Request
RejectOAuth2Request
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_debug")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_description")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_hint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status_code")

-- | ToJSON RejectOAuth2Request
instance A.ToJSON RejectOAuth2Request where
  toJSON :: RejectOAuth2Request -> Value
toJSON RejectOAuth2Request {Maybe Integer
Maybe Text
rejectOAuth2RequestStatusCode :: Maybe Integer
rejectOAuth2RequestErrorHint :: Maybe Text
rejectOAuth2RequestErrorDescription :: Maybe Text
rejectOAuth2RequestErrorDebug :: Maybe Text
rejectOAuth2RequestError :: Maybe Text
rejectOAuth2RequestStatusCode :: RejectOAuth2Request -> Maybe Integer
rejectOAuth2RequestErrorHint :: RejectOAuth2Request -> Maybe Text
rejectOAuth2RequestErrorDescription :: RejectOAuth2Request -> Maybe Text
rejectOAuth2RequestErrorDebug :: RejectOAuth2Request -> Maybe Text
rejectOAuth2RequestError :: RejectOAuth2Request -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectOAuth2RequestError
      , Key
"error_debug" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectOAuth2RequestErrorDebug
      , Key
"error_description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectOAuth2RequestErrorDescription
      , Key
"error_hint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectOAuth2RequestErrorHint
      , Key
"status_code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
rejectOAuth2RequestStatusCode
      ]


-- | Construct a value of type 'RejectOAuth2Request' (by applying it's required fields, if any)
mkRejectOAuth2Request
  :: RejectOAuth2Request
mkRejectOAuth2Request :: RejectOAuth2Request
mkRejectOAuth2Request =
  RejectOAuth2Request
  { rejectOAuth2RequestError :: Maybe Text
rejectOAuth2RequestError = forall a. Maybe a
Nothing
  , rejectOAuth2RequestErrorDebug :: Maybe Text
rejectOAuth2RequestErrorDebug = forall a. Maybe a
Nothing
  , rejectOAuth2RequestErrorDescription :: Maybe Text
rejectOAuth2RequestErrorDescription = forall a. Maybe a
Nothing
  , rejectOAuth2RequestErrorHint :: Maybe Text
rejectOAuth2RequestErrorHint = forall a. Maybe a
Nothing
  , rejectOAuth2RequestStatusCode :: Maybe Integer
rejectOAuth2RequestStatusCode = forall a. Maybe a
Nothing
  }

-- ** TokenPagination
-- | TokenPagination
data TokenPagination = TokenPagination
  { TokenPagination -> Maybe Integer
tokenPaginationPageSize :: Maybe Integer -- ^ "page_size" - Items per page  This is the number of items per page to return. For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
  , TokenPagination -> Maybe Text
tokenPaginationPageToken :: Maybe Text -- ^ "page_token" - Next Page Token  The next page token. For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
  } deriving (Int -> TokenPagination -> ShowS
[TokenPagination] -> ShowS
TokenPagination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenPagination] -> ShowS
$cshowList :: [TokenPagination] -> ShowS
show :: TokenPagination -> String
$cshow :: TokenPagination -> String
showsPrec :: Int -> TokenPagination -> ShowS
$cshowsPrec :: Int -> TokenPagination -> ShowS
P.Show, TokenPagination -> TokenPagination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenPagination -> TokenPagination -> Bool
$c/= :: TokenPagination -> TokenPagination -> Bool
== :: TokenPagination -> TokenPagination -> Bool
$c== :: TokenPagination -> TokenPagination -> Bool
P.Eq, P.Typeable)

-- | FromJSON TokenPagination
instance A.FromJSON TokenPagination where
  parseJSON :: Value -> Parser TokenPagination
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TokenPagination" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Text -> TokenPagination
TokenPagination
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page_size")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page_token")

-- | ToJSON TokenPagination
instance A.ToJSON TokenPagination where
  toJSON :: TokenPagination -> Value
toJSON TokenPagination {Maybe Integer
Maybe Text
tokenPaginationPageToken :: Maybe Text
tokenPaginationPageSize :: Maybe Integer
tokenPaginationPageToken :: TokenPagination -> Maybe Text
tokenPaginationPageSize :: TokenPagination -> Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"page_size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
tokenPaginationPageSize
      , Key
"page_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
tokenPaginationPageToken
      ]


-- | Construct a value of type 'TokenPagination' (by applying it's required fields, if any)
mkTokenPagination
  :: TokenPagination
mkTokenPagination :: TokenPagination
mkTokenPagination =
  TokenPagination
  { tokenPaginationPageSize :: Maybe Integer
tokenPaginationPageSize = forall a. Maybe a
Nothing
  , tokenPaginationPageToken :: Maybe Text
tokenPaginationPageToken = forall a. Maybe a
Nothing
  }

-- ** TokenPaginationHeaders
-- | TokenPaginationHeaders
data TokenPaginationHeaders = TokenPaginationHeaders
  { TokenPaginationHeaders -> Maybe Text
tokenPaginationHeadersLink :: Maybe Text -- ^ "link" - The link header contains pagination links.  For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).  in: header
  , TokenPaginationHeaders -> Maybe Text
tokenPaginationHeadersXTotalCount :: Maybe Text -- ^ "x-total-count" - The total number of clients.  in: header
  } deriving (Int -> TokenPaginationHeaders -> ShowS
[TokenPaginationHeaders] -> ShowS
TokenPaginationHeaders -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenPaginationHeaders] -> ShowS
$cshowList :: [TokenPaginationHeaders] -> ShowS
show :: TokenPaginationHeaders -> String
$cshow :: TokenPaginationHeaders -> String
showsPrec :: Int -> TokenPaginationHeaders -> ShowS
$cshowsPrec :: Int -> TokenPaginationHeaders -> ShowS
P.Show, TokenPaginationHeaders -> TokenPaginationHeaders -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenPaginationHeaders -> TokenPaginationHeaders -> Bool
$c/= :: TokenPaginationHeaders -> TokenPaginationHeaders -> Bool
== :: TokenPaginationHeaders -> TokenPaginationHeaders -> Bool
$c== :: TokenPaginationHeaders -> TokenPaginationHeaders -> Bool
P.Eq, P.Typeable)

-- | FromJSON TokenPaginationHeaders
instance A.FromJSON TokenPaginationHeaders where
  parseJSON :: Value -> Parser TokenPaginationHeaders
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TokenPaginationHeaders" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> TokenPaginationHeaders
TokenPaginationHeaders
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"link")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x-total-count")

-- | ToJSON TokenPaginationHeaders
instance A.ToJSON TokenPaginationHeaders where
  toJSON :: TokenPaginationHeaders -> Value
toJSON TokenPaginationHeaders {Maybe Text
tokenPaginationHeadersXTotalCount :: Maybe Text
tokenPaginationHeadersLink :: Maybe Text
tokenPaginationHeadersXTotalCount :: TokenPaginationHeaders -> Maybe Text
tokenPaginationHeadersLink :: TokenPaginationHeaders -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"link" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
tokenPaginationHeadersLink
      , Key
"x-total-count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
tokenPaginationHeadersXTotalCount
      ]


-- | Construct a value of type 'TokenPaginationHeaders' (by applying it's required fields, if any)
mkTokenPaginationHeaders
  :: TokenPaginationHeaders
mkTokenPaginationHeaders :: TokenPaginationHeaders
mkTokenPaginationHeaders =
  TokenPaginationHeaders
  { tokenPaginationHeadersLink :: Maybe Text
tokenPaginationHeadersLink = forall a. Maybe a
Nothing
  , tokenPaginationHeadersXTotalCount :: Maybe Text
tokenPaginationHeadersXTotalCount = forall a. Maybe a
Nothing
  }

-- ** TokenPaginationRequestParameters
-- | TokenPaginationRequestParameters
-- Pagination Request Parameters
-- 
-- The `Link` HTTP header contains multiple links (`first`, `next`, `last`, `previous`) formatted as: `<https://{project-slug}.projects.oryapis.com/admin/clients?page_size={limit}&page_token={offset}>; rel=\"{page}\"`  For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
data TokenPaginationRequestParameters = TokenPaginationRequestParameters
  { TokenPaginationRequestParameters -> Maybe Integer
tokenPaginationRequestParametersPageSize :: Maybe Integer -- ^ "page_size" - Items per Page  This is the number of items per page to return. For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
  , TokenPaginationRequestParameters -> Maybe Text
tokenPaginationRequestParametersPageToken :: Maybe Text -- ^ "page_token" - Next Page Token  The next page token. For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
  } deriving (Int -> TokenPaginationRequestParameters -> ShowS
[TokenPaginationRequestParameters] -> ShowS
TokenPaginationRequestParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenPaginationRequestParameters] -> ShowS
$cshowList :: [TokenPaginationRequestParameters] -> ShowS
show :: TokenPaginationRequestParameters -> String
$cshow :: TokenPaginationRequestParameters -> String
showsPrec :: Int -> TokenPaginationRequestParameters -> ShowS
$cshowsPrec :: Int -> TokenPaginationRequestParameters -> ShowS
P.Show, TokenPaginationRequestParameters
-> TokenPaginationRequestParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenPaginationRequestParameters
-> TokenPaginationRequestParameters -> Bool
$c/= :: TokenPaginationRequestParameters
-> TokenPaginationRequestParameters -> Bool
== :: TokenPaginationRequestParameters
-> TokenPaginationRequestParameters -> Bool
$c== :: TokenPaginationRequestParameters
-> TokenPaginationRequestParameters -> Bool
P.Eq, P.Typeable)

-- | FromJSON TokenPaginationRequestParameters
instance A.FromJSON TokenPaginationRequestParameters where
  parseJSON :: Value -> Parser TokenPaginationRequestParameters
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TokenPaginationRequestParameters" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Text -> TokenPaginationRequestParameters
TokenPaginationRequestParameters
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page_size")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page_token")

-- | ToJSON TokenPaginationRequestParameters
instance A.ToJSON TokenPaginationRequestParameters where
  toJSON :: TokenPaginationRequestParameters -> Value
toJSON TokenPaginationRequestParameters {Maybe Integer
Maybe Text
tokenPaginationRequestParametersPageToken :: Maybe Text
tokenPaginationRequestParametersPageSize :: Maybe Integer
tokenPaginationRequestParametersPageToken :: TokenPaginationRequestParameters -> Maybe Text
tokenPaginationRequestParametersPageSize :: TokenPaginationRequestParameters -> Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"page_size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
tokenPaginationRequestParametersPageSize
      , Key
"page_token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
tokenPaginationRequestParametersPageToken
      ]


-- | Construct a value of type 'TokenPaginationRequestParameters' (by applying it's required fields, if any)
mkTokenPaginationRequestParameters
  :: TokenPaginationRequestParameters
mkTokenPaginationRequestParameters :: TokenPaginationRequestParameters
mkTokenPaginationRequestParameters =
  TokenPaginationRequestParameters
  { tokenPaginationRequestParametersPageSize :: Maybe Integer
tokenPaginationRequestParametersPageSize = forall a. Maybe a
Nothing
  , tokenPaginationRequestParametersPageToken :: Maybe Text
tokenPaginationRequestParametersPageToken = forall a. Maybe a
Nothing
  }

-- ** TokenPaginationResponseHeaders
-- | TokenPaginationResponseHeaders
-- Pagination Response Header
-- 
-- The `Link` HTTP header contains multiple links (`first`, `next`, `last`, `previous`) formatted as: `<https://{project-slug}.projects.oryapis.com/admin/clients?page_size={limit}&page_token={offset}>; rel=\"{page}\"`  For details on pagination please head over to the [pagination documentation](https://www.ory.sh/docs/ecosystem/api-design#pagination).
data TokenPaginationResponseHeaders = TokenPaginationResponseHeaders
  { TokenPaginationResponseHeaders -> Maybe Text
tokenPaginationResponseHeadersLink :: Maybe Text -- ^ "link" - The Link HTTP Header  The &#x60;Link&#x60; header contains a comma-delimited list of links to the following pages:  first: The first page of results. next: The next page of results. prev: The previous page of results. last: The last page of results.  Pages are omitted if they do not exist. For example, if there is no next page, the &#x60;next&#x60; link is omitted. Examples:  &lt;/clients?page_size&#x3D;5&amp;page_token&#x3D;0&gt;; rel&#x3D;\&quot;first\&quot;,&lt;/clients?page_size&#x3D;5&amp;page_token&#x3D;15&gt;; rel&#x3D;\&quot;next\&quot;,&lt;/clients?page_size&#x3D;5&amp;page_token&#x3D;5&gt;; rel&#x3D;\&quot;prev\&quot;,&lt;/clients?page_size&#x3D;5&amp;page_token&#x3D;20&gt;; rel&#x3D;\&quot;last\&quot;
  , TokenPaginationResponseHeaders -> Maybe Integer
tokenPaginationResponseHeadersXTotalCount :: Maybe Integer -- ^ "x-total-count" - The X-Total-Count HTTP Header  The &#x60;X-Total-Count&#x60; header contains the total number of items in the collection.
  } deriving (Int -> TokenPaginationResponseHeaders -> ShowS
[TokenPaginationResponseHeaders] -> ShowS
TokenPaginationResponseHeaders -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenPaginationResponseHeaders] -> ShowS
$cshowList :: [TokenPaginationResponseHeaders] -> ShowS
show :: TokenPaginationResponseHeaders -> String
$cshow :: TokenPaginationResponseHeaders -> String
showsPrec :: Int -> TokenPaginationResponseHeaders -> ShowS
$cshowsPrec :: Int -> TokenPaginationResponseHeaders -> ShowS
P.Show, TokenPaginationResponseHeaders
-> TokenPaginationResponseHeaders -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenPaginationResponseHeaders
-> TokenPaginationResponseHeaders -> Bool
$c/= :: TokenPaginationResponseHeaders
-> TokenPaginationResponseHeaders -> Bool
== :: TokenPaginationResponseHeaders
-> TokenPaginationResponseHeaders -> Bool
$c== :: TokenPaginationResponseHeaders
-> TokenPaginationResponseHeaders -> Bool
P.Eq, P.Typeable)

-- | FromJSON TokenPaginationResponseHeaders
instance A.FromJSON TokenPaginationResponseHeaders where
  parseJSON :: Value -> Parser TokenPaginationResponseHeaders
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TokenPaginationResponseHeaders" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Integer -> TokenPaginationResponseHeaders
TokenPaginationResponseHeaders
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"link")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x-total-count")

-- | ToJSON TokenPaginationResponseHeaders
instance A.ToJSON TokenPaginationResponseHeaders where
  toJSON :: TokenPaginationResponseHeaders -> Value
toJSON TokenPaginationResponseHeaders {Maybe Integer
Maybe Text
tokenPaginationResponseHeadersXTotalCount :: Maybe Integer
tokenPaginationResponseHeadersLink :: Maybe Text
tokenPaginationResponseHeadersXTotalCount :: TokenPaginationResponseHeaders -> Maybe Integer
tokenPaginationResponseHeadersLink :: TokenPaginationResponseHeaders -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"link" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
tokenPaginationResponseHeadersLink
      , Key
"x-total-count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
tokenPaginationResponseHeadersXTotalCount
      ]


-- | Construct a value of type 'TokenPaginationResponseHeaders' (by applying it's required fields, if any)
mkTokenPaginationResponseHeaders
  :: TokenPaginationResponseHeaders
mkTokenPaginationResponseHeaders :: TokenPaginationResponseHeaders
mkTokenPaginationResponseHeaders =
  TokenPaginationResponseHeaders
  { tokenPaginationResponseHeadersLink :: Maybe Text
tokenPaginationResponseHeadersLink = forall a. Maybe a
Nothing
  , tokenPaginationResponseHeadersXTotalCount :: Maybe Integer
tokenPaginationResponseHeadersXTotalCount = forall a. Maybe a
Nothing
  }

-- ** TrustOAuth2JwtGrantIssuer
-- | TrustOAuth2JwtGrantIssuer
-- Trust OAuth2 JWT Bearer Grant Type Issuer Request Body
data TrustOAuth2JwtGrantIssuer = TrustOAuth2JwtGrantIssuer
  { TrustOAuth2JwtGrantIssuer -> Maybe Bool
trustOAuth2JwtGrantIssuerAllowAnySubject :: Maybe Bool -- ^ "allow_any_subject" - The \&quot;allow_any_subject\&quot; indicates that the issuer is allowed to have any principal as the subject of the JWT.
  , TrustOAuth2JwtGrantIssuer -> DateTime
trustOAuth2JwtGrantIssuerExpiresAt :: DateTime -- ^ /Required/ "expires_at" - The \&quot;expires_at\&quot; indicates, when grant will expire, so we will reject assertion from \&quot;issuer\&quot; targeting \&quot;subject\&quot;.
  , TrustOAuth2JwtGrantIssuer -> Text
trustOAuth2JwtGrantIssuerIssuer :: Text -- ^ /Required/ "issuer" - The \&quot;issuer\&quot; identifies the principal that issued the JWT assertion (same as \&quot;iss\&quot; claim in JWT).
  , TrustOAuth2JwtGrantIssuer -> JsonWebKey
trustOAuth2JwtGrantIssuerJwk :: JsonWebKey -- ^ /Required/ "jwk"
  , TrustOAuth2JwtGrantIssuer -> [Text]
trustOAuth2JwtGrantIssuerScope :: [Text] -- ^ /Required/ "scope" - The \&quot;scope\&quot; contains list of scope values (as described in Section 3.3 of OAuth 2.0 [RFC6749])
  , TrustOAuth2JwtGrantIssuer -> Maybe Text
trustOAuth2JwtGrantIssuerSubject :: Maybe Text -- ^ "subject" - The \&quot;subject\&quot; identifies the principal that is the subject of the JWT.
  } deriving (Int -> TrustOAuth2JwtGrantIssuer -> ShowS
[TrustOAuth2JwtGrantIssuer] -> ShowS
TrustOAuth2JwtGrantIssuer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrustOAuth2JwtGrantIssuer] -> ShowS
$cshowList :: [TrustOAuth2JwtGrantIssuer] -> ShowS
show :: TrustOAuth2JwtGrantIssuer -> String
$cshow :: TrustOAuth2JwtGrantIssuer -> String
showsPrec :: Int -> TrustOAuth2JwtGrantIssuer -> ShowS
$cshowsPrec :: Int -> TrustOAuth2JwtGrantIssuer -> ShowS
P.Show, TrustOAuth2JwtGrantIssuer -> TrustOAuth2JwtGrantIssuer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrustOAuth2JwtGrantIssuer -> TrustOAuth2JwtGrantIssuer -> Bool
$c/= :: TrustOAuth2JwtGrantIssuer -> TrustOAuth2JwtGrantIssuer -> Bool
== :: TrustOAuth2JwtGrantIssuer -> TrustOAuth2JwtGrantIssuer -> Bool
$c== :: TrustOAuth2JwtGrantIssuer -> TrustOAuth2JwtGrantIssuer -> Bool
P.Eq, P.Typeable)

-- | FromJSON TrustOAuth2JwtGrantIssuer
instance A.FromJSON TrustOAuth2JwtGrantIssuer where
  parseJSON :: Value -> Parser TrustOAuth2JwtGrantIssuer
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TrustOAuth2JwtGrantIssuer" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> DateTime
-> Text
-> JsonWebKey
-> [Text]
-> Maybe Text
-> TrustOAuth2JwtGrantIssuer
TrustOAuth2JwtGrantIssuer
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_any_subject")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"expires_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"issuer")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"jwk")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subject")

-- | ToJSON TrustOAuth2JwtGrantIssuer
instance A.ToJSON TrustOAuth2JwtGrantIssuer where
  toJSON :: TrustOAuth2JwtGrantIssuer -> Value
toJSON TrustOAuth2JwtGrantIssuer {[Text]
Maybe Bool
Maybe Text
Text
DateTime
JsonWebKey
trustOAuth2JwtGrantIssuerSubject :: Maybe Text
trustOAuth2JwtGrantIssuerScope :: [Text]
trustOAuth2JwtGrantIssuerJwk :: JsonWebKey
trustOAuth2JwtGrantIssuerIssuer :: Text
trustOAuth2JwtGrantIssuerExpiresAt :: DateTime
trustOAuth2JwtGrantIssuerAllowAnySubject :: Maybe Bool
trustOAuth2JwtGrantIssuerSubject :: TrustOAuth2JwtGrantIssuer -> Maybe Text
trustOAuth2JwtGrantIssuerScope :: TrustOAuth2JwtGrantIssuer -> [Text]
trustOAuth2JwtGrantIssuerJwk :: TrustOAuth2JwtGrantIssuer -> JsonWebKey
trustOAuth2JwtGrantIssuerIssuer :: TrustOAuth2JwtGrantIssuer -> Text
trustOAuth2JwtGrantIssuerExpiresAt :: TrustOAuth2JwtGrantIssuer -> DateTime
trustOAuth2JwtGrantIssuerAllowAnySubject :: TrustOAuth2JwtGrantIssuer -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allow_any_subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
trustOAuth2JwtGrantIssuerAllowAnySubject
      , Key
"expires_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
trustOAuth2JwtGrantIssuerExpiresAt
      , Key
"issuer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
trustOAuth2JwtGrantIssuerIssuer
      , Key
"jwk" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= JsonWebKey
trustOAuth2JwtGrantIssuerJwk
      , Key
"scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
trustOAuth2JwtGrantIssuerScope
      , Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
trustOAuth2JwtGrantIssuerSubject
      ]


-- | Construct a value of type 'TrustOAuth2JwtGrantIssuer' (by applying it's required fields, if any)
mkTrustOAuth2JwtGrantIssuer
  :: DateTime -- ^ 'trustOAuth2JwtGrantIssuerExpiresAt': The \"expires_at\" indicates, when grant will expire, so we will reject assertion from \"issuer\" targeting \"subject\".
  -> Text -- ^ 'trustOAuth2JwtGrantIssuerIssuer': The \"issuer\" identifies the principal that issued the JWT assertion (same as \"iss\" claim in JWT).
  -> JsonWebKey -- ^ 'trustOAuth2JwtGrantIssuerJwk' 
  -> [Text] -- ^ 'trustOAuth2JwtGrantIssuerScope': The \"scope\" contains list of scope values (as described in Section 3.3 of OAuth 2.0 [RFC6749])
  -> TrustOAuth2JwtGrantIssuer
mkTrustOAuth2JwtGrantIssuer :: DateTime
-> Text -> JsonWebKey -> [Text] -> TrustOAuth2JwtGrantIssuer
mkTrustOAuth2JwtGrantIssuer DateTime
trustOAuth2JwtGrantIssuerExpiresAt Text
trustOAuth2JwtGrantIssuerIssuer JsonWebKey
trustOAuth2JwtGrantIssuerJwk [Text]
trustOAuth2JwtGrantIssuerScope =
  TrustOAuth2JwtGrantIssuer
  { trustOAuth2JwtGrantIssuerAllowAnySubject :: Maybe Bool
trustOAuth2JwtGrantIssuerAllowAnySubject = forall a. Maybe a
Nothing
  , DateTime
trustOAuth2JwtGrantIssuerExpiresAt :: DateTime
trustOAuth2JwtGrantIssuerExpiresAt :: DateTime
trustOAuth2JwtGrantIssuerExpiresAt
  , Text
trustOAuth2JwtGrantIssuerIssuer :: Text
trustOAuth2JwtGrantIssuerIssuer :: Text
trustOAuth2JwtGrantIssuerIssuer
  , JsonWebKey
trustOAuth2JwtGrantIssuerJwk :: JsonWebKey
trustOAuth2JwtGrantIssuerJwk :: JsonWebKey
trustOAuth2JwtGrantIssuerJwk
  , [Text]
trustOAuth2JwtGrantIssuerScope :: [Text]
trustOAuth2JwtGrantIssuerScope :: [Text]
trustOAuth2JwtGrantIssuerScope
  , trustOAuth2JwtGrantIssuerSubject :: Maybe Text
trustOAuth2JwtGrantIssuerSubject = forall a. Maybe a
Nothing
  }

-- ** TrustedOAuth2JwtGrantIssuer
-- | TrustedOAuth2JwtGrantIssuer
-- OAuth2 JWT Bearer Grant Type Issuer Trust Relationship
data TrustedOAuth2JwtGrantIssuer = TrustedOAuth2JwtGrantIssuer
  { TrustedOAuth2JwtGrantIssuer -> Maybe Bool
trustedOAuth2JwtGrantIssuerAllowAnySubject :: Maybe Bool -- ^ "allow_any_subject" - The \&quot;allow_any_subject\&quot; indicates that the issuer is allowed to have any principal as the subject of the JWT.
  , TrustedOAuth2JwtGrantIssuer -> Maybe DateTime
trustedOAuth2JwtGrantIssuerCreatedAt :: Maybe DateTime -- ^ "created_at" - The \&quot;created_at\&quot; indicates, when grant was created.
  , TrustedOAuth2JwtGrantIssuer -> Maybe DateTime
trustedOAuth2JwtGrantIssuerExpiresAt :: Maybe DateTime -- ^ "expires_at" - The \&quot;expires_at\&quot; indicates, when grant will expire, so we will reject assertion from \&quot;issuer\&quot; targeting \&quot;subject\&quot;.
  , TrustedOAuth2JwtGrantIssuer -> Maybe Text
trustedOAuth2JwtGrantIssuerId :: Maybe Text -- ^ "id"
  , TrustedOAuth2JwtGrantIssuer -> Maybe Text
trustedOAuth2JwtGrantIssuerIssuer :: Maybe Text -- ^ "issuer" - The \&quot;issuer\&quot; identifies the principal that issued the JWT assertion (same as \&quot;iss\&quot; claim in JWT).
  , TrustedOAuth2JwtGrantIssuer
-> Maybe TrustedOAuth2JwtGrantJsonWebKey
trustedOAuth2JwtGrantIssuerPublicKey :: Maybe TrustedOAuth2JwtGrantJsonWebKey -- ^ "public_key"
  , TrustedOAuth2JwtGrantIssuer -> Maybe [Text]
trustedOAuth2JwtGrantIssuerScope :: Maybe [Text] -- ^ "scope" - The \&quot;scope\&quot; contains list of scope values (as described in Section 3.3 of OAuth 2.0 [RFC6749])
  , TrustedOAuth2JwtGrantIssuer -> Maybe Text
trustedOAuth2JwtGrantIssuerSubject :: Maybe Text -- ^ "subject" - The \&quot;subject\&quot; identifies the principal that is the subject of the JWT.
  } deriving (Int -> TrustedOAuth2JwtGrantIssuer -> ShowS
[TrustedOAuth2JwtGrantIssuer] -> ShowS
TrustedOAuth2JwtGrantIssuer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrustedOAuth2JwtGrantIssuer] -> ShowS
$cshowList :: [TrustedOAuth2JwtGrantIssuer] -> ShowS
show :: TrustedOAuth2JwtGrantIssuer -> String
$cshow :: TrustedOAuth2JwtGrantIssuer -> String
showsPrec :: Int -> TrustedOAuth2JwtGrantIssuer -> ShowS
$cshowsPrec :: Int -> TrustedOAuth2JwtGrantIssuer -> ShowS
P.Show, TrustedOAuth2JwtGrantIssuer -> TrustedOAuth2JwtGrantIssuer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrustedOAuth2JwtGrantIssuer -> TrustedOAuth2JwtGrantIssuer -> Bool
$c/= :: TrustedOAuth2JwtGrantIssuer -> TrustedOAuth2JwtGrantIssuer -> Bool
== :: TrustedOAuth2JwtGrantIssuer -> TrustedOAuth2JwtGrantIssuer -> Bool
$c== :: TrustedOAuth2JwtGrantIssuer -> TrustedOAuth2JwtGrantIssuer -> Bool
P.Eq, P.Typeable)

-- | FromJSON TrustedOAuth2JwtGrantIssuer
instance A.FromJSON TrustedOAuth2JwtGrantIssuer where
  parseJSON :: Value -> Parser TrustedOAuth2JwtGrantIssuer
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TrustedOAuth2JwtGrantIssuer" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe DateTime
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe TrustedOAuth2JwtGrantJsonWebKey
-> Maybe [Text]
-> Maybe Text
-> TrustedOAuth2JwtGrantIssuer
TrustedOAuth2JwtGrantIssuer
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_any_subject")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issuer")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"public_key")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subject")

-- | ToJSON TrustedOAuth2JwtGrantIssuer
instance A.ToJSON TrustedOAuth2JwtGrantIssuer where
  toJSON :: TrustedOAuth2JwtGrantIssuer -> Value
toJSON TrustedOAuth2JwtGrantIssuer {Maybe Bool
Maybe [Text]
Maybe Text
Maybe DateTime
Maybe TrustedOAuth2JwtGrantJsonWebKey
trustedOAuth2JwtGrantIssuerSubject :: Maybe Text
trustedOAuth2JwtGrantIssuerScope :: Maybe [Text]
trustedOAuth2JwtGrantIssuerPublicKey :: Maybe TrustedOAuth2JwtGrantJsonWebKey
trustedOAuth2JwtGrantIssuerIssuer :: Maybe Text
trustedOAuth2JwtGrantIssuerId :: Maybe Text
trustedOAuth2JwtGrantIssuerExpiresAt :: Maybe DateTime
trustedOAuth2JwtGrantIssuerCreatedAt :: Maybe DateTime
trustedOAuth2JwtGrantIssuerAllowAnySubject :: Maybe Bool
trustedOAuth2JwtGrantIssuerSubject :: TrustedOAuth2JwtGrantIssuer -> Maybe Text
trustedOAuth2JwtGrantIssuerScope :: TrustedOAuth2JwtGrantIssuer -> Maybe [Text]
trustedOAuth2JwtGrantIssuerPublicKey :: TrustedOAuth2JwtGrantIssuer
-> Maybe TrustedOAuth2JwtGrantJsonWebKey
trustedOAuth2JwtGrantIssuerIssuer :: TrustedOAuth2JwtGrantIssuer -> Maybe Text
trustedOAuth2JwtGrantIssuerId :: TrustedOAuth2JwtGrantIssuer -> Maybe Text
trustedOAuth2JwtGrantIssuerExpiresAt :: TrustedOAuth2JwtGrantIssuer -> Maybe DateTime
trustedOAuth2JwtGrantIssuerCreatedAt :: TrustedOAuth2JwtGrantIssuer -> Maybe DateTime
trustedOAuth2JwtGrantIssuerAllowAnySubject :: TrustedOAuth2JwtGrantIssuer -> Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allow_any_subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
trustedOAuth2JwtGrantIssuerAllowAnySubject
      , Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
trustedOAuth2JwtGrantIssuerCreatedAt
      , Key
"expires_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
trustedOAuth2JwtGrantIssuerExpiresAt
      , Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
trustedOAuth2JwtGrantIssuerId
      , Key
"issuer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
trustedOAuth2JwtGrantIssuerIssuer
      , Key
"public_key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TrustedOAuth2JwtGrantJsonWebKey
trustedOAuth2JwtGrantIssuerPublicKey
      , Key
"scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
trustedOAuth2JwtGrantIssuerScope
      , Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
trustedOAuth2JwtGrantIssuerSubject
      ]


-- | Construct a value of type 'TrustedOAuth2JwtGrantIssuer' (by applying it's required fields, if any)
mkTrustedOAuth2JwtGrantIssuer
  :: TrustedOAuth2JwtGrantIssuer
mkTrustedOAuth2JwtGrantIssuer :: TrustedOAuth2JwtGrantIssuer
mkTrustedOAuth2JwtGrantIssuer =
  TrustedOAuth2JwtGrantIssuer
  { trustedOAuth2JwtGrantIssuerAllowAnySubject :: Maybe Bool
trustedOAuth2JwtGrantIssuerAllowAnySubject = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantIssuerCreatedAt :: Maybe DateTime
trustedOAuth2JwtGrantIssuerCreatedAt = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantIssuerExpiresAt :: Maybe DateTime
trustedOAuth2JwtGrantIssuerExpiresAt = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantIssuerId :: Maybe Text
trustedOAuth2JwtGrantIssuerId = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantIssuerIssuer :: Maybe Text
trustedOAuth2JwtGrantIssuerIssuer = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantIssuerPublicKey :: Maybe TrustedOAuth2JwtGrantJsonWebKey
trustedOAuth2JwtGrantIssuerPublicKey = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantIssuerScope :: Maybe [Text]
trustedOAuth2JwtGrantIssuerScope = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantIssuerSubject :: Maybe Text
trustedOAuth2JwtGrantIssuerSubject = forall a. Maybe a
Nothing
  }

-- ** TrustedOAuth2JwtGrantJsonWebKey
-- | TrustedOAuth2JwtGrantJsonWebKey
-- OAuth2 JWT Bearer Grant Type Issuer Trusted JSON Web Key
data TrustedOAuth2JwtGrantJsonWebKey = TrustedOAuth2JwtGrantJsonWebKey
  { TrustedOAuth2JwtGrantJsonWebKey -> Maybe Text
trustedOAuth2JwtGrantJsonWebKeyKid :: Maybe Text -- ^ "kid" - The \&quot;key_id\&quot; is key unique identifier (same as kid header in jws/jwt).
  , TrustedOAuth2JwtGrantJsonWebKey -> Maybe Text
trustedOAuth2JwtGrantJsonWebKeySet :: Maybe Text -- ^ "set" - The \&quot;set\&quot; is basically a name for a group(set) of keys. Will be the same as \&quot;issuer\&quot; in grant.
  } deriving (Int -> TrustedOAuth2JwtGrantJsonWebKey -> ShowS
[TrustedOAuth2JwtGrantJsonWebKey] -> ShowS
TrustedOAuth2JwtGrantJsonWebKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrustedOAuth2JwtGrantJsonWebKey] -> ShowS
$cshowList :: [TrustedOAuth2JwtGrantJsonWebKey] -> ShowS
show :: TrustedOAuth2JwtGrantJsonWebKey -> String
$cshow :: TrustedOAuth2JwtGrantJsonWebKey -> String
showsPrec :: Int -> TrustedOAuth2JwtGrantJsonWebKey -> ShowS
$cshowsPrec :: Int -> TrustedOAuth2JwtGrantJsonWebKey -> ShowS
P.Show, TrustedOAuth2JwtGrantJsonWebKey
-> TrustedOAuth2JwtGrantJsonWebKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrustedOAuth2JwtGrantJsonWebKey
-> TrustedOAuth2JwtGrantJsonWebKey -> Bool
$c/= :: TrustedOAuth2JwtGrantJsonWebKey
-> TrustedOAuth2JwtGrantJsonWebKey -> Bool
== :: TrustedOAuth2JwtGrantJsonWebKey
-> TrustedOAuth2JwtGrantJsonWebKey -> Bool
$c== :: TrustedOAuth2JwtGrantJsonWebKey
-> TrustedOAuth2JwtGrantJsonWebKey -> Bool
P.Eq, P.Typeable)

-- | FromJSON TrustedOAuth2JwtGrantJsonWebKey
instance A.FromJSON TrustedOAuth2JwtGrantJsonWebKey where
  parseJSON :: Value -> Parser TrustedOAuth2JwtGrantJsonWebKey
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TrustedOAuth2JwtGrantJsonWebKey" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> TrustedOAuth2JwtGrantJsonWebKey
TrustedOAuth2JwtGrantJsonWebKey
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"kid")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"set")

-- | ToJSON TrustedOAuth2JwtGrantJsonWebKey
instance A.ToJSON TrustedOAuth2JwtGrantJsonWebKey where
  toJSON :: TrustedOAuth2JwtGrantJsonWebKey -> Value
toJSON TrustedOAuth2JwtGrantJsonWebKey {Maybe Text
trustedOAuth2JwtGrantJsonWebKeySet :: Maybe Text
trustedOAuth2JwtGrantJsonWebKeyKid :: Maybe Text
trustedOAuth2JwtGrantJsonWebKeySet :: TrustedOAuth2JwtGrantJsonWebKey -> Maybe Text
trustedOAuth2JwtGrantJsonWebKeyKid :: TrustedOAuth2JwtGrantJsonWebKey -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"kid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
trustedOAuth2JwtGrantJsonWebKeyKid
      , Key
"set" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
trustedOAuth2JwtGrantJsonWebKeySet
      ]


-- | Construct a value of type 'TrustedOAuth2JwtGrantJsonWebKey' (by applying it's required fields, if any)
mkTrustedOAuth2JwtGrantJsonWebKey
  :: TrustedOAuth2JwtGrantJsonWebKey
mkTrustedOAuth2JwtGrantJsonWebKey :: TrustedOAuth2JwtGrantJsonWebKey
mkTrustedOAuth2JwtGrantJsonWebKey =
  TrustedOAuth2JwtGrantJsonWebKey
  { trustedOAuth2JwtGrantJsonWebKeyKid :: Maybe Text
trustedOAuth2JwtGrantJsonWebKeyKid = forall a. Maybe a
Nothing
  , trustedOAuth2JwtGrantJsonWebKeySet :: Maybe Text
trustedOAuth2JwtGrantJsonWebKeySet = forall a. Maybe a
Nothing
  }

-- ** Version
-- | Version
data Version = Version
  { Version -> Maybe Text
versionVersion :: Maybe Text -- ^ "version" - Version is the service&#39;s version.
  } deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
P.Show, Version -> Version -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
P.Eq, P.Typeable)

-- | FromJSON Version
instance A.FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Version" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Version
Version
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")

-- | ToJSON Version
instance A.ToJSON Version where
  toJSON :: Version -> Value
toJSON Version {Maybe Text
versionVersion :: Maybe Text
versionVersion :: Version -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
versionVersion
      ]


-- | Construct a value of type 'Version' (by applying it's required fields, if any)
mkVersion
  :: Version
mkVersion :: Version
mkVersion =
  Version
  { versionVersion :: Maybe Text
versionVersion = forall a. Maybe a
Nothing
  }




-- * Auth Methods

-- ** AuthBasicBasic
data AuthBasicBasic =
  AuthBasicBasic B.ByteString B.ByteString -- ^ username password
  deriving (AuthBasicBasic -> AuthBasicBasic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthBasicBasic -> AuthBasicBasic -> Bool
$c/= :: AuthBasicBasic -> AuthBasicBasic -> Bool
== :: AuthBasicBasic -> AuthBasicBasic -> Bool
$c== :: AuthBasicBasic -> AuthBasicBasic -> Bool
P.Eq, Int -> AuthBasicBasic -> ShowS
[AuthBasicBasic] -> ShowS
AuthBasicBasic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthBasicBasic] -> ShowS
$cshowList :: [AuthBasicBasic] -> ShowS
show :: AuthBasicBasic -> String
$cshow :: AuthBasicBasic -> String
showsPrec :: Int -> AuthBasicBasic -> ShowS
$cshowsPrec :: Int -> AuthBasicBasic -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthBasicBasic where
  applyAuthMethod :: forall req contentType res accept.
OryHydraConfig
-> AuthBasicBasic
-> OryHydraRequest req contentType res accept
-> IO (OryHydraRequest req contentType res accept)
applyAuthMethod OryHydraConfig
_ a :: AuthBasicBasic
a@(AuthBasicBasic ByteString
user ByteString
pw) OryHydraRequest req contentType res accept
req =
    forall (f :: * -> *) a. Applicative f => a -> f a
P.pure forall a b. (a -> b) -> a -> b
$
    if (forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBasic
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` forall req contentType res accept.
OryHydraRequest req contentType res accept -> [TypeRep]
rAuthTypes OryHydraRequest req contentType res accept
req)
      then OryHydraRequest req contentType res accept
req forall req contentType res accept.
OryHydraRequest req contentType res accept
-> [Header] -> OryHydraRequest req contentType res accept
`setHeader` forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", ByteString -> Text
T.decodeUtf8 ByteString
cred)
           forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over forall req contentType res accept.
Lens_' (OryHydraRequest req contentType res accept) [TypeRep]
rAuthTypesL (forall a. (a -> Bool) -> [a] -> [a]
P.filter (forall a. Eq a => a -> a -> Bool
/= forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBasic
a))
      else OryHydraRequest req contentType res accept
req
    where cred :: ByteString
cred = ByteString -> ByteString -> ByteString
BC.append ByteString
"Basic " (ByteString -> ByteString
B64.encode forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BC.concat [ ByteString
user, ByteString
":", ByteString
pw ])

-- ** AuthBasicBearer
data AuthBasicBearer =
  AuthBasicBearer B.ByteString B.ByteString -- ^ username password
  deriving (AuthBasicBearer -> AuthBasicBearer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthBasicBearer -> AuthBasicBearer -> Bool
$c/= :: AuthBasicBearer -> AuthBasicBearer -> Bool
== :: AuthBasicBearer -> AuthBasicBearer -> Bool
$c== :: AuthBasicBearer -> AuthBasicBearer -> Bool
P.Eq, Int -> AuthBasicBearer -> ShowS
[AuthBasicBearer] -> ShowS
AuthBasicBearer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthBasicBearer] -> ShowS
$cshowList :: [AuthBasicBearer] -> ShowS
show :: AuthBasicBearer -> String
$cshow :: AuthBasicBearer -> String
showsPrec :: Int -> AuthBasicBearer -> ShowS
$cshowsPrec :: Int -> AuthBasicBearer -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthBasicBearer where
  applyAuthMethod :: forall req contentType res accept.
OryHydraConfig
-> AuthBasicBearer
-> OryHydraRequest req contentType res accept
-> IO (OryHydraRequest req contentType res accept)
applyAuthMethod OryHydraConfig
_ a :: AuthBasicBearer
a@(AuthBasicBearer ByteString
user ByteString
pw) OryHydraRequest req contentType res accept
req =
    forall (f :: * -> *) a. Applicative f => a -> f a
P.pure forall a b. (a -> b) -> a -> b
$
    if (forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBearer
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` forall req contentType res accept.
OryHydraRequest req contentType res accept -> [TypeRep]
rAuthTypes OryHydraRequest req contentType res accept
req)
      then OryHydraRequest req contentType res accept
req forall req contentType res accept.
OryHydraRequest req contentType res accept
-> [Header] -> OryHydraRequest req contentType res accept
`setHeader` forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", ByteString -> Text
T.decodeUtf8 ByteString
cred)
           forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over forall req contentType res accept.
Lens_' (OryHydraRequest req contentType res accept) [TypeRep]
rAuthTypesL (forall a. (a -> Bool) -> [a] -> [a]
P.filter (forall a. Eq a => a -> a -> Bool
/= forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBearer
a))
      else OryHydraRequest req contentType res accept
req
    where cred :: ByteString
cred = ByteString -> ByteString -> ByteString
BC.append ByteString
"Basic " (ByteString -> ByteString
B64.encode forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BC.concat [ ByteString
user, ByteString
":", ByteString
pw ])

-- ** AuthOAuthOauth2
data AuthOAuthOauth2 =
  AuthOAuthOauth2 Text -- ^ secret
  deriving (AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
$c/= :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
== :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
$c== :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
P.Eq, Int -> AuthOAuthOauth2 -> ShowS
[AuthOAuthOauth2] -> ShowS
AuthOAuthOauth2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthOAuthOauth2] -> ShowS
$cshowList :: [AuthOAuthOauth2] -> ShowS
show :: AuthOAuthOauth2 -> String
$cshow :: AuthOAuthOauth2 -> String
showsPrec :: Int -> AuthOAuthOauth2 -> ShowS
$cshowsPrec :: Int -> AuthOAuthOauth2 -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthOAuthOauth2 where
  applyAuthMethod :: forall req contentType res accept.
OryHydraConfig
-> AuthOAuthOauth2
-> OryHydraRequest req contentType res accept
-> IO (OryHydraRequest req contentType res accept)
applyAuthMethod OryHydraConfig
_ a :: AuthOAuthOauth2
a@(AuthOAuthOauth2 Text
secret) OryHydraRequest req contentType res accept
req =
    forall (f :: * -> *) a. Applicative f => a -> f a
P.pure forall a b. (a -> b) -> a -> b
$
    if (forall a. Typeable a => a -> TypeRep
P.typeOf AuthOAuthOauth2
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` forall req contentType res accept.
OryHydraRequest req contentType res accept -> [TypeRep]
rAuthTypes OryHydraRequest req contentType res accept
req)
      then OryHydraRequest req contentType res accept
req forall req contentType res accept.
OryHydraRequest req contentType res accept
-> [Header] -> OryHydraRequest req contentType res accept
`setHeader` forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", Text
"Bearer " forall a. Semigroup a => a -> a -> a
<> Text
secret)
           forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over forall req contentType res accept.
Lens_' (OryHydraRequest req contentType res accept) [TypeRep]
rAuthTypesL (forall a. (a -> Bool) -> [a] -> [a]
P.filter (forall a. Eq a => a -> a -> Bool
/= forall a. Typeable a => a -> TypeRep
P.typeOf AuthOAuthOauth2
a))
      else OryHydraRequest req contentType res accept
req