{-
   ORY Hydra

   Welcome to the ORY Hydra HTTP API documentation. You will find documentation for all HTTP APIs here.

   OpenAPI Version: 3.0.1
   ORY Hydra API version: latest
   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
(All -> All -> Bool) -> (All -> All -> Bool) -> Eq All
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
(Int -> All -> ShowS)
-> (All -> String) -> ([All] -> ShowS) -> Show All
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
(Client -> Client -> Bool)
-> (Client -> Client -> Bool) -> Eq Client
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
(Int -> Client -> ShowS)
-> (Client -> String) -> ([Client] -> ShowS) -> Show Client
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
(ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool) -> Eq ClientId
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
(Int -> ClientId -> ShowS)
-> (ClientId -> String) -> ([ClientId] -> ShowS) -> Show ClientId
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)

-- ** Code
newtype Code = Code { Code -> Text
unCode :: Text } deriving (Code -> Code -> Bool
(Code -> Code -> Bool) -> (Code -> Code -> Bool) -> Eq Code
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
(Int -> Code -> ShowS)
-> (Code -> String) -> ([Code] -> ShowS) -> Show Code
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
(ConsentChallenge -> ConsentChallenge -> Bool)
-> (ConsentChallenge -> ConsentChallenge -> Bool)
-> Eq ConsentChallenge
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
(Int -> ConsentChallenge -> ShowS)
-> (ConsentChallenge -> String)
-> ([ConsentChallenge] -> ShowS)
-> Show ConsentChallenge
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)

-- ** GrantType
newtype GrantType = GrantType { GrantType -> Text
unGrantType :: Text } deriving (GrantType -> GrantType -> Bool
(GrantType -> GrantType -> Bool)
-> (GrantType -> GrantType -> Bool) -> Eq GrantType
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
(Int -> GrantType -> ShowS)
-> (GrantType -> String)
-> ([GrantType] -> ShowS)
-> Show GrantType
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
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
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
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
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)

-- ** Kid
newtype Kid = Kid { Kid -> Text
unKid :: Text } deriving (Kid -> Kid -> Bool
(Kid -> Kid -> Bool) -> (Kid -> Kid -> Bool) -> Eq Kid
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
(Int -> Kid -> ShowS)
-> (Kid -> String) -> ([Kid] -> ShowS) -> Show Kid
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)

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

-- ** LoginChallenge
newtype LoginChallenge = LoginChallenge { LoginChallenge -> Text
unLoginChallenge :: Text } deriving (LoginChallenge -> LoginChallenge -> Bool
(LoginChallenge -> LoginChallenge -> Bool)
-> (LoginChallenge -> LoginChallenge -> Bool) -> Eq LoginChallenge
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
(Int -> LoginChallenge -> ShowS)
-> (LoginChallenge -> String)
-> ([LoginChallenge] -> ShowS)
-> Show LoginChallenge
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)

-- ** LogoutChallenge
newtype LogoutChallenge = LogoutChallenge { LogoutChallenge -> Text
unLogoutChallenge :: Text } deriving (LogoutChallenge -> LogoutChallenge -> Bool
(LogoutChallenge -> LogoutChallenge -> Bool)
-> (LogoutChallenge -> LogoutChallenge -> Bool)
-> Eq LogoutChallenge
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
(Int -> LogoutChallenge -> ShowS)
-> (LogoutChallenge -> String)
-> ([LogoutChallenge] -> ShowS)
-> Show LogoutChallenge
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)

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

-- ** RedirectUri
newtype RedirectUri = RedirectUri { RedirectUri -> Text
unRedirectUri :: Text } deriving (RedirectUri -> RedirectUri -> Bool
(RedirectUri -> RedirectUri -> Bool)
-> (RedirectUri -> RedirectUri -> Bool) -> Eq RedirectUri
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
(Int -> RedirectUri -> ShowS)
-> (RedirectUri -> String)
-> ([RedirectUri] -> ShowS)
-> Show RedirectUri
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
(RefreshToken -> RefreshToken -> Bool)
-> (RefreshToken -> RefreshToken -> Bool) -> Eq RefreshToken
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
(Int -> RefreshToken -> ShowS)
-> (RefreshToken -> String)
-> ([RefreshToken] -> ShowS)
-> Show RefreshToken
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
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
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
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
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
(Set -> Set -> Bool) -> (Set -> Set -> Bool) -> Eq Set
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
(Int -> Set -> ShowS)
-> (Set -> String) -> ([Set] -> ShowS) -> Show Set
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
(Subject -> Subject -> Bool)
-> (Subject -> Subject -> Bool) -> Eq Subject
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
(Int -> Subject -> ShowS)
-> (Subject -> String) -> ([Subject] -> ShowS) -> Show Subject
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
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
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
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
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


-- ** AcceptConsentRequest
-- | AcceptConsentRequest
-- The request payload used to accept a consent request.
-- 
data AcceptConsentRequest = AcceptConsentRequest
  { AcceptConsentRequest -> Maybe [Text]
acceptConsentRequestGrantAccessTokenAudience :: Maybe [Text] -- ^ "grant_access_token_audience"
  , AcceptConsentRequest -> Maybe [Text]
acceptConsentRequestGrantScope :: Maybe [Text] -- ^ "grant_scope"
  , AcceptConsentRequest -> Maybe DateTime
acceptConsentRequestHandledAt :: Maybe DateTime -- ^ "handled_at"
  , AcceptConsentRequest -> Maybe Bool
acceptConsentRequestRemember :: 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.
  , AcceptConsentRequest -> Maybe Integer
acceptConsentRequestRememberFor :: 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.
  , AcceptConsentRequest -> Maybe ConsentRequestSession
acceptConsentRequestSession :: Maybe ConsentRequestSession -- ^ "session"
  } deriving (Int -> AcceptConsentRequest -> ShowS
[AcceptConsentRequest] -> ShowS
AcceptConsentRequest -> String
(Int -> AcceptConsentRequest -> ShowS)
-> (AcceptConsentRequest -> String)
-> ([AcceptConsentRequest] -> ShowS)
-> Show AcceptConsentRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptConsentRequest] -> ShowS
$cshowList :: [AcceptConsentRequest] -> ShowS
show :: AcceptConsentRequest -> String
$cshow :: AcceptConsentRequest -> String
showsPrec :: Int -> AcceptConsentRequest -> ShowS
$cshowsPrec :: Int -> AcceptConsentRequest -> ShowS
P.Show, AcceptConsentRequest -> AcceptConsentRequest -> Bool
(AcceptConsentRequest -> AcceptConsentRequest -> Bool)
-> (AcceptConsentRequest -> AcceptConsentRequest -> Bool)
-> Eq AcceptConsentRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptConsentRequest -> AcceptConsentRequest -> Bool
$c/= :: AcceptConsentRequest -> AcceptConsentRequest -> Bool
== :: AcceptConsentRequest -> AcceptConsentRequest -> Bool
$c== :: AcceptConsentRequest -> AcceptConsentRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON AcceptConsentRequest
instance A.ToJSON AcceptConsentRequest where
  toJSON :: AcceptConsentRequest -> Value
toJSON AcceptConsentRequest {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe DateTime
Maybe ConsentRequestSession
acceptConsentRequestSession :: Maybe ConsentRequestSession
acceptConsentRequestRememberFor :: Maybe Integer
acceptConsentRequestRemember :: Maybe Bool
acceptConsentRequestHandledAt :: Maybe DateTime
acceptConsentRequestGrantScope :: Maybe [Text]
acceptConsentRequestGrantAccessTokenAudience :: Maybe [Text]
acceptConsentRequestSession :: AcceptConsentRequest -> Maybe ConsentRequestSession
acceptConsentRequestRememberFor :: AcceptConsentRequest -> Maybe Integer
acceptConsentRequestRemember :: AcceptConsentRequest -> Maybe Bool
acceptConsentRequestHandledAt :: AcceptConsentRequest -> Maybe DateTime
acceptConsentRequestGrantScope :: AcceptConsentRequest -> Maybe [Text]
acceptConsentRequestGrantAccessTokenAudience :: AcceptConsentRequest -> Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"grant_access_token_audience" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
acceptConsentRequestGrantAccessTokenAudience
      , Key
"grant_scope" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
acceptConsentRequestGrantScope
      , Key
"handled_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
acceptConsentRequestHandledAt
      , Key
"remember" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
acceptConsentRequestRemember
      , Key
"remember_for" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
acceptConsentRequestRememberFor
      , Key
"session" Key -> Maybe ConsentRequestSession -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ConsentRequestSession
acceptConsentRequestSession
      ]


-- | Construct a value of type 'AcceptConsentRequest' (by applying it's required fields, if any)
mkAcceptConsentRequest
  :: AcceptConsentRequest
mkAcceptConsentRequest :: AcceptConsentRequest
mkAcceptConsentRequest =
  AcceptConsentRequest :: Maybe [Text]
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Bool
-> Maybe Integer
-> Maybe ConsentRequestSession
-> AcceptConsentRequest
AcceptConsentRequest
  { acceptConsentRequestGrantAccessTokenAudience :: Maybe [Text]
acceptConsentRequestGrantAccessTokenAudience = Maybe [Text]
forall a. Maybe a
Nothing
  , acceptConsentRequestGrantScope :: Maybe [Text]
acceptConsentRequestGrantScope = Maybe [Text]
forall a. Maybe a
Nothing
  , acceptConsentRequestHandledAt :: Maybe DateTime
acceptConsentRequestHandledAt = Maybe DateTime
forall a. Maybe a
Nothing
  , acceptConsentRequestRemember :: Maybe Bool
acceptConsentRequestRemember = Maybe Bool
forall a. Maybe a
Nothing
  , acceptConsentRequestRememberFor :: Maybe Integer
acceptConsentRequestRememberFor = Maybe Integer
forall a. Maybe a
Nothing
  , acceptConsentRequestSession :: Maybe ConsentRequestSession
acceptConsentRequestSession = Maybe ConsentRequestSession
forall a. Maybe a
Nothing
  }

-- ** AcceptLoginRequest
-- | AcceptLoginRequest
-- HandledLoginRequest is the request payload used to accept a login request.
-- 
data AcceptLoginRequest = AcceptLoginRequest
  { AcceptLoginRequest -> Maybe Text
acceptLoginRequestAcr :: 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.
  , AcceptLoginRequest -> Maybe Value
acceptLoginRequestContext :: Maybe A.Value -- ^ "context"
  , AcceptLoginRequest -> Maybe Text
acceptLoginRequestForceSubjectIdentifier :: 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.
  , AcceptLoginRequest -> Maybe Bool
acceptLoginRequestRemember :: 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.
  , AcceptLoginRequest -> Maybe Integer
acceptLoginRequestRememberFor :: 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).
  , AcceptLoginRequest -> Text
acceptLoginRequestSubject :: Text -- ^ /Required/ "subject" - Subject is the user ID of the end-user that authenticated.
  } deriving (Int -> AcceptLoginRequest -> ShowS
[AcceptLoginRequest] -> ShowS
AcceptLoginRequest -> String
(Int -> AcceptLoginRequest -> ShowS)
-> (AcceptLoginRequest -> String)
-> ([AcceptLoginRequest] -> ShowS)
-> Show AcceptLoginRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptLoginRequest] -> ShowS
$cshowList :: [AcceptLoginRequest] -> ShowS
show :: AcceptLoginRequest -> String
$cshow :: AcceptLoginRequest -> String
showsPrec :: Int -> AcceptLoginRequest -> ShowS
$cshowsPrec :: Int -> AcceptLoginRequest -> ShowS
P.Show, AcceptLoginRequest -> AcceptLoginRequest -> Bool
(AcceptLoginRequest -> AcceptLoginRequest -> Bool)
-> (AcceptLoginRequest -> AcceptLoginRequest -> Bool)
-> Eq AcceptLoginRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptLoginRequest -> AcceptLoginRequest -> Bool
$c/= :: AcceptLoginRequest -> AcceptLoginRequest -> Bool
== :: AcceptLoginRequest -> AcceptLoginRequest -> Bool
$c== :: AcceptLoginRequest -> AcceptLoginRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON AcceptLoginRequest
instance A.ToJSON AcceptLoginRequest where
  toJSON :: AcceptLoginRequest -> Value
toJSON AcceptLoginRequest {Maybe Bool
Maybe Integer
Maybe Text
Maybe Value
Text
acceptLoginRequestSubject :: Text
acceptLoginRequestRememberFor :: Maybe Integer
acceptLoginRequestRemember :: Maybe Bool
acceptLoginRequestForceSubjectIdentifier :: Maybe Text
acceptLoginRequestContext :: Maybe Value
acceptLoginRequestAcr :: Maybe Text
acceptLoginRequestSubject :: AcceptLoginRequest -> Text
acceptLoginRequestRememberFor :: AcceptLoginRequest -> Maybe Integer
acceptLoginRequestRemember :: AcceptLoginRequest -> Maybe Bool
acceptLoginRequestForceSubjectIdentifier :: AcceptLoginRequest -> Maybe Text
acceptLoginRequestContext :: AcceptLoginRequest -> Maybe Value
acceptLoginRequestAcr :: AcceptLoginRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"acr" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
acceptLoginRequestAcr
      , Key
"context" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
acceptLoginRequestContext
      , Key
"force_subject_identifier" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
acceptLoginRequestForceSubjectIdentifier
      , Key
"remember" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
acceptLoginRequestRemember
      , Key
"remember_for" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
acceptLoginRequestRememberFor
      , Key
"subject" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
acceptLoginRequestSubject
      ]


-- | Construct a value of type 'AcceptLoginRequest' (by applying it's required fields, if any)
mkAcceptLoginRequest
  :: Text -- ^ 'acceptLoginRequestSubject': Subject is the user ID of the end-user that authenticated.
  -> AcceptLoginRequest
mkAcceptLoginRequest :: Text -> AcceptLoginRequest
mkAcceptLoginRequest Text
acceptLoginRequestSubject =
  AcceptLoginRequest :: Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Text
-> AcceptLoginRequest
AcceptLoginRequest
  { acceptLoginRequestAcr :: Maybe Text
acceptLoginRequestAcr = Maybe Text
forall a. Maybe a
Nothing
  , acceptLoginRequestContext :: Maybe Value
acceptLoginRequestContext = Maybe Value
forall a. Maybe a
Nothing
  , acceptLoginRequestForceSubjectIdentifier :: Maybe Text
acceptLoginRequestForceSubjectIdentifier = Maybe Text
forall a. Maybe a
Nothing
  , acceptLoginRequestRemember :: Maybe Bool
acceptLoginRequestRemember = Maybe Bool
forall a. Maybe a
Nothing
  , acceptLoginRequestRememberFor :: Maybe Integer
acceptLoginRequestRememberFor = Maybe Integer
forall a. Maybe a
Nothing
  , Text
acceptLoginRequestSubject :: Text
acceptLoginRequestSubject :: Text
acceptLoginRequestSubject
  }

-- ** CompletedRequest
-- | CompletedRequest
-- The response payload sent when accepting or rejecting a login or consent request.
-- 
data CompletedRequest = CompletedRequest
  { CompletedRequest -> Text
completedRequestRedirectTo :: Text -- ^ /Required/ "redirect_to" - RedirectURL is the URL which you should redirect the user to once the authentication process is completed.
  } deriving (Int -> CompletedRequest -> ShowS
[CompletedRequest] -> ShowS
CompletedRequest -> String
(Int -> CompletedRequest -> ShowS)
-> (CompletedRequest -> String)
-> ([CompletedRequest] -> ShowS)
-> Show CompletedRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletedRequest] -> ShowS
$cshowList :: [CompletedRequest] -> ShowS
show :: CompletedRequest -> String
$cshow :: CompletedRequest -> String
showsPrec :: Int -> CompletedRequest -> ShowS
$cshowsPrec :: Int -> CompletedRequest -> ShowS
P.Show, CompletedRequest -> CompletedRequest -> Bool
(CompletedRequest -> CompletedRequest -> Bool)
-> (CompletedRequest -> CompletedRequest -> Bool)
-> Eq CompletedRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletedRequest -> CompletedRequest -> Bool
$c/= :: CompletedRequest -> CompletedRequest -> Bool
== :: CompletedRequest -> CompletedRequest -> Bool
$c== :: CompletedRequest -> CompletedRequest -> Bool
P.Eq, P.Typeable)

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

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


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

-- ** ConsentRequest
-- | ConsentRequest
-- Contains information on an ongoing consent request.
-- 
data ConsentRequest = ConsentRequest
  { ConsentRequest -> Maybe Text
consentRequestAcr :: 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.
  , ConsentRequest -> Text
consentRequestChallenge :: Text -- ^ /Required/ "challenge" - ID is the identifier (\&quot;authorization challenge\&quot;) of the consent authorization request. It is used to identify the session.
  , ConsentRequest -> Maybe OAuth2Client
consentRequestClient :: Maybe OAuth2Client -- ^ "client"
  , ConsentRequest -> Maybe Value
consentRequestContext :: Maybe A.Value -- ^ "context"
  , ConsentRequest -> Maybe Text
consentRequestLoginChallenge :: 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.
  , ConsentRequest -> Maybe Text
consentRequestLoginSessionId :: 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.
  , ConsentRequest -> Maybe OpenIDConnectContext
consentRequestOidcContext :: Maybe OpenIDConnectContext -- ^ "oidc_context"
  , ConsentRequest -> Maybe Text
consentRequestRequestUrl :: 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.
  , ConsentRequest -> Maybe [Text]
consentRequestRequestedAccessTokenAudience :: Maybe [Text] -- ^ "requested_access_token_audience"
  , ConsentRequest -> Maybe [Text]
consentRequestRequestedScope :: Maybe [Text] -- ^ "requested_scope"
  , ConsentRequest -> Maybe Bool
consentRequestSkip :: 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.
  , ConsentRequest -> Maybe Text
consentRequestSubject :: 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 -> ConsentRequest -> ShowS
[ConsentRequest] -> ShowS
ConsentRequest -> String
(Int -> ConsentRequest -> ShowS)
-> (ConsentRequest -> String)
-> ([ConsentRequest] -> ShowS)
-> Show ConsentRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsentRequest] -> ShowS
$cshowList :: [ConsentRequest] -> ShowS
show :: ConsentRequest -> String
$cshow :: ConsentRequest -> String
showsPrec :: Int -> ConsentRequest -> ShowS
$cshowsPrec :: Int -> ConsentRequest -> ShowS
P.Show, ConsentRequest -> ConsentRequest -> Bool
(ConsentRequest -> ConsentRequest -> Bool)
-> (ConsentRequest -> ConsentRequest -> Bool) -> Eq ConsentRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsentRequest -> ConsentRequest -> Bool
$c/= :: ConsentRequest -> ConsentRequest -> Bool
== :: ConsentRequest -> ConsentRequest -> Bool
$c== :: ConsentRequest -> ConsentRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON ConsentRequest
instance A.ToJSON ConsentRequest where
  toJSON :: ConsentRequest -> Value
toJSON ConsentRequest {Maybe Bool
Maybe [Text]
Maybe Text
Maybe Value
Maybe OpenIDConnectContext
Maybe OAuth2Client
Text
consentRequestSubject :: Maybe Text
consentRequestSkip :: Maybe Bool
consentRequestRequestedScope :: Maybe [Text]
consentRequestRequestedAccessTokenAudience :: Maybe [Text]
consentRequestRequestUrl :: Maybe Text
consentRequestOidcContext :: Maybe OpenIDConnectContext
consentRequestLoginSessionId :: Maybe Text
consentRequestLoginChallenge :: Maybe Text
consentRequestContext :: Maybe Value
consentRequestClient :: Maybe OAuth2Client
consentRequestChallenge :: Text
consentRequestAcr :: Maybe Text
consentRequestSubject :: ConsentRequest -> Maybe Text
consentRequestSkip :: ConsentRequest -> Maybe Bool
consentRequestRequestedScope :: ConsentRequest -> Maybe [Text]
consentRequestRequestedAccessTokenAudience :: ConsentRequest -> Maybe [Text]
consentRequestRequestUrl :: ConsentRequest -> Maybe Text
consentRequestOidcContext :: ConsentRequest -> Maybe OpenIDConnectContext
consentRequestLoginSessionId :: ConsentRequest -> Maybe Text
consentRequestLoginChallenge :: ConsentRequest -> Maybe Text
consentRequestContext :: ConsentRequest -> Maybe Value
consentRequestClient :: ConsentRequest -> Maybe OAuth2Client
consentRequestChallenge :: ConsentRequest -> Text
consentRequestAcr :: ConsentRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"acr" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
consentRequestAcr
      , Key
"challenge" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
consentRequestChallenge
      , Key
"client" Key -> Maybe OAuth2Client -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OAuth2Client
consentRequestClient
      , Key
"context" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
consentRequestContext
      , Key
"login_challenge" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
consentRequestLoginChallenge
      , Key
"login_session_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
consentRequestLoginSessionId
      , Key
"oidc_context" Key -> Maybe OpenIDConnectContext -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OpenIDConnectContext
consentRequestOidcContext
      , Key
"request_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
consentRequestRequestUrl
      , Key
"requested_access_token_audience" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
consentRequestRequestedAccessTokenAudience
      , Key
"requested_scope" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
consentRequestRequestedScope
      , Key
"skip" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
consentRequestSkip
      , Key
"subject" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
consentRequestSubject
      ]


-- | Construct a value of type 'ConsentRequest' (by applying it's required fields, if any)
mkConsentRequest
  :: Text -- ^ 'consentRequestChallenge': ID is the identifier (\"authorization challenge\") of the consent authorization request. It is used to identify the session.
  -> ConsentRequest
mkConsentRequest :: Text -> ConsentRequest
mkConsentRequest Text
consentRequestChallenge =
  ConsentRequest :: Maybe Text
-> Text
-> Maybe OAuth2Client
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe OpenIDConnectContext
-> Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Text
-> ConsentRequest
ConsentRequest
  { consentRequestAcr :: Maybe Text
consentRequestAcr = Maybe Text
forall a. Maybe a
Nothing
  , Text
consentRequestChallenge :: Text
consentRequestChallenge :: Text
consentRequestChallenge
  , consentRequestClient :: Maybe OAuth2Client
consentRequestClient = Maybe OAuth2Client
forall a. Maybe a
Nothing
  , consentRequestContext :: Maybe Value
consentRequestContext = Maybe Value
forall a. Maybe a
Nothing
  , consentRequestLoginChallenge :: Maybe Text
consentRequestLoginChallenge = Maybe Text
forall a. Maybe a
Nothing
  , consentRequestLoginSessionId :: Maybe Text
consentRequestLoginSessionId = Maybe Text
forall a. Maybe a
Nothing
  , consentRequestOidcContext :: Maybe OpenIDConnectContext
consentRequestOidcContext = Maybe OpenIDConnectContext
forall a. Maybe a
Nothing
  , consentRequestRequestUrl :: Maybe Text
consentRequestRequestUrl = Maybe Text
forall a. Maybe a
Nothing
  , consentRequestRequestedAccessTokenAudience :: Maybe [Text]
consentRequestRequestedAccessTokenAudience = Maybe [Text]
forall a. Maybe a
Nothing
  , consentRequestRequestedScope :: Maybe [Text]
consentRequestRequestedScope = Maybe [Text]
forall a. Maybe a
Nothing
  , consentRequestSkip :: Maybe Bool
consentRequestSkip = Maybe Bool
forall a. Maybe a
Nothing
  , consentRequestSubject :: Maybe Text
consentRequestSubject = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ConsentRequestSession
-- | ConsentRequestSession
-- Used to pass session data to a consent request.
-- 
data ConsentRequestSession = ConsentRequestSession
  { ConsentRequestSession -> Maybe Value
consentRequestSessionAccessToken :: 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!
  , ConsentRequestSession -> Maybe Value
consentRequestSessionIdToken :: 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 -> ConsentRequestSession -> ShowS
[ConsentRequestSession] -> ShowS
ConsentRequestSession -> String
(Int -> ConsentRequestSession -> ShowS)
-> (ConsentRequestSession -> String)
-> ([ConsentRequestSession] -> ShowS)
-> Show ConsentRequestSession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsentRequestSession] -> ShowS
$cshowList :: [ConsentRequestSession] -> ShowS
show :: ConsentRequestSession -> String
$cshow :: ConsentRequestSession -> String
showsPrec :: Int -> ConsentRequestSession -> ShowS
$cshowsPrec :: Int -> ConsentRequestSession -> ShowS
P.Show, ConsentRequestSession -> ConsentRequestSession -> Bool
(ConsentRequestSession -> ConsentRequestSession -> Bool)
-> (ConsentRequestSession -> ConsentRequestSession -> Bool)
-> Eq ConsentRequestSession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsentRequestSession -> ConsentRequestSession -> Bool
$c/= :: ConsentRequestSession -> ConsentRequestSession -> Bool
== :: ConsentRequestSession -> ConsentRequestSession -> Bool
$c== :: ConsentRequestSession -> ConsentRequestSession -> Bool
P.Eq, P.Typeable)

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

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


-- | Construct a value of type 'ConsentRequestSession' (by applying it's required fields, if any)
mkConsentRequestSession
  :: ConsentRequestSession
mkConsentRequestSession :: ConsentRequestSession
mkConsentRequestSession =
  ConsentRequestSession :: Maybe Value -> Maybe Value -> ConsentRequestSession
ConsentRequestSession
  { consentRequestSessionAccessToken :: Maybe Value
consentRequestSessionAccessToken = Maybe Value
forall a. Maybe a
Nothing
  , consentRequestSessionIdToken :: Maybe Value
consentRequestSessionIdToken = Maybe Value
forall a. Maybe a
Nothing
  }

-- ** ContainerWaitOKBodyError
-- | ContainerWaitOKBodyError
-- ContainerWaitOKBodyError container waiting error, if any
data ContainerWaitOKBodyError = ContainerWaitOKBodyError
  { ContainerWaitOKBodyError -> Maybe Text
containerWaitOKBodyErrorMessage :: Maybe Text -- ^ "Message" - Details of an error
  } deriving (Int -> ContainerWaitOKBodyError -> ShowS
[ContainerWaitOKBodyError] -> ShowS
ContainerWaitOKBodyError -> String
(Int -> ContainerWaitOKBodyError -> ShowS)
-> (ContainerWaitOKBodyError -> String)
-> ([ContainerWaitOKBodyError] -> ShowS)
-> Show ContainerWaitOKBodyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContainerWaitOKBodyError] -> ShowS
$cshowList :: [ContainerWaitOKBodyError] -> ShowS
show :: ContainerWaitOKBodyError -> String
$cshow :: ContainerWaitOKBodyError -> String
showsPrec :: Int -> ContainerWaitOKBodyError -> ShowS
$cshowsPrec :: Int -> ContainerWaitOKBodyError -> ShowS
P.Show, ContainerWaitOKBodyError -> ContainerWaitOKBodyError -> Bool
(ContainerWaitOKBodyError -> ContainerWaitOKBodyError -> Bool)
-> (ContainerWaitOKBodyError -> ContainerWaitOKBodyError -> Bool)
-> Eq ContainerWaitOKBodyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContainerWaitOKBodyError -> ContainerWaitOKBodyError -> Bool
$c/= :: ContainerWaitOKBodyError -> ContainerWaitOKBodyError -> Bool
== :: ContainerWaitOKBodyError -> ContainerWaitOKBodyError -> Bool
$c== :: ContainerWaitOKBodyError -> ContainerWaitOKBodyError -> Bool
P.Eq, P.Typeable)

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

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


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

-- ** FlushInactiveOAuth2TokensRequest
-- | FlushInactiveOAuth2TokensRequest
data FlushInactiveOAuth2TokensRequest = FlushInactiveOAuth2TokensRequest
  { FlushInactiveOAuth2TokensRequest -> Maybe DateTime
flushInactiveOAuth2TokensRequestNotAfter :: Maybe DateTime -- ^ "notAfter" - NotAfter sets after which point tokens should not be flushed. This is useful when you want to keep a history of recently issued tokens for auditing.
  } deriving (Int -> FlushInactiveOAuth2TokensRequest -> ShowS
[FlushInactiveOAuth2TokensRequest] -> ShowS
FlushInactiveOAuth2TokensRequest -> String
(Int -> FlushInactiveOAuth2TokensRequest -> ShowS)
-> (FlushInactiveOAuth2TokensRequest -> String)
-> ([FlushInactiveOAuth2TokensRequest] -> ShowS)
-> Show FlushInactiveOAuth2TokensRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlushInactiveOAuth2TokensRequest] -> ShowS
$cshowList :: [FlushInactiveOAuth2TokensRequest] -> ShowS
show :: FlushInactiveOAuth2TokensRequest -> String
$cshow :: FlushInactiveOAuth2TokensRequest -> String
showsPrec :: Int -> FlushInactiveOAuth2TokensRequest -> ShowS
$cshowsPrec :: Int -> FlushInactiveOAuth2TokensRequest -> ShowS
P.Show, FlushInactiveOAuth2TokensRequest
-> FlushInactiveOAuth2TokensRequest -> Bool
(FlushInactiveOAuth2TokensRequest
 -> FlushInactiveOAuth2TokensRequest -> Bool)
-> (FlushInactiveOAuth2TokensRequest
    -> FlushInactiveOAuth2TokensRequest -> Bool)
-> Eq FlushInactiveOAuth2TokensRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlushInactiveOAuth2TokensRequest
-> FlushInactiveOAuth2TokensRequest -> Bool
$c/= :: FlushInactiveOAuth2TokensRequest
-> FlushInactiveOAuth2TokensRequest -> Bool
== :: FlushInactiveOAuth2TokensRequest
-> FlushInactiveOAuth2TokensRequest -> Bool
$c== :: FlushInactiveOAuth2TokensRequest
-> FlushInactiveOAuth2TokensRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON FlushInactiveOAuth2TokensRequest
instance A.ToJSON FlushInactiveOAuth2TokensRequest where
  toJSON :: FlushInactiveOAuth2TokensRequest -> Value
toJSON FlushInactiveOAuth2TokensRequest {Maybe DateTime
flushInactiveOAuth2TokensRequestNotAfter :: Maybe DateTime
flushInactiveOAuth2TokensRequestNotAfter :: FlushInactiveOAuth2TokensRequest -> Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"notAfter" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
flushInactiveOAuth2TokensRequestNotAfter
      ]


-- | Construct a value of type 'FlushInactiveOAuth2TokensRequest' (by applying it's required fields, if any)
mkFlushInactiveOAuth2TokensRequest
  :: FlushInactiveOAuth2TokensRequest
mkFlushInactiveOAuth2TokensRequest :: FlushInactiveOAuth2TokensRequest
mkFlushInactiveOAuth2TokensRequest =
  FlushInactiveOAuth2TokensRequest :: Maybe DateTime -> FlushInactiveOAuth2TokensRequest
FlushInactiveOAuth2TokensRequest
  { flushInactiveOAuth2TokensRequestNotAfter :: Maybe DateTime
flushInactiveOAuth2TokensRequestNotAfter = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** GenericError
-- | GenericError
-- Error response
-- 
-- Error responses are sent when an error (e.g. unauthorized, bad request, ...) occurred.
data GenericError = GenericError
  { GenericError -> Maybe Text
genericErrorDebug :: Maybe Text -- ^ "debug" - Debug contains debug information. This is usually not available and has to be enabled.
  , GenericError -> Text
genericErrorError :: Text -- ^ /Required/ "error" - Name is the error name.
  , GenericError -> Maybe Text
genericErrorErrorDescription :: Maybe Text -- ^ "error_description" - Description contains further information on the nature of the error.
  , GenericError -> Maybe Integer
genericErrorStatusCode :: Maybe Integer -- ^ "status_code" - Code represents the error status code (404, 403, 401, ...).
  } deriving (Int -> GenericError -> ShowS
[GenericError] -> ShowS
GenericError -> String
(Int -> GenericError -> ShowS)
-> (GenericError -> String)
-> ([GenericError] -> ShowS)
-> Show GenericError
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
(GenericError -> GenericError -> Bool)
-> (GenericError -> GenericError -> Bool) -> Eq GenericError
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 = String
-> (Object -> Parser GenericError) -> Value -> Parser GenericError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"GenericError" ((Object -> Parser GenericError) -> Value -> Parser GenericError)
-> (Object -> Parser GenericError) -> Value -> Parser GenericError
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Text -> Maybe Text -> Maybe Integer -> GenericError
GenericError
      (Maybe Text -> Text -> Maybe Text -> Maybe Integer -> GenericError)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> Maybe Integer -> GenericError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"debug")
      Parser (Text -> Maybe Text -> Maybe Integer -> GenericError)
-> Parser Text
-> Parser (Maybe Text -> Maybe Integer -> GenericError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"error")
      Parser (Maybe Text -> Maybe Integer -> GenericError)
-> Parser (Maybe Text) -> Parser (Maybe Integer -> GenericError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_description")
      Parser (Maybe Integer -> GenericError)
-> Parser (Maybe Integer) -> Parser GenericError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status_code")

-- | ToJSON GenericError
instance A.ToJSON GenericError where
  toJSON :: GenericError -> Value
toJSON GenericError {Maybe Integer
Maybe Text
Text
genericErrorStatusCode :: Maybe Integer
genericErrorErrorDescription :: Maybe Text
genericErrorError :: Text
genericErrorDebug :: Maybe Text
genericErrorStatusCode :: GenericError -> Maybe Integer
genericErrorErrorDescription :: GenericError -> Maybe Text
genericErrorError :: GenericError -> Text
genericErrorDebug :: GenericError -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"debug" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
genericErrorDebug
      , Key
"error" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
genericErrorError
      , Key
"error_description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
genericErrorErrorDescription
      , Key
"status_code" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
genericErrorStatusCode
      ]


-- | Construct a value of type 'GenericError' (by applying it's required fields, if any)
mkGenericError
  :: Text -- ^ 'genericErrorError': Name is the error name.
  -> GenericError
mkGenericError :: Text -> GenericError
mkGenericError Text
genericErrorError =
  GenericError :: Maybe Text -> Text -> Maybe Text -> Maybe Integer -> GenericError
GenericError
  { genericErrorDebug :: Maybe Text
genericErrorDebug = Maybe Text
forall a. Maybe a
Nothing
  , Text
genericErrorError :: Text
genericErrorError :: Text
genericErrorError
  , genericErrorErrorDescription :: Maybe Text
genericErrorErrorDescription = Maybe Text
forall a. Maybe a
Nothing
  , genericErrorStatusCode :: Maybe Integer
genericErrorStatusCode = Maybe Integer
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
(Int -> HealthNotReadyStatus -> ShowS)
-> (HealthNotReadyStatus -> String)
-> ([HealthNotReadyStatus] -> ShowS)
-> Show HealthNotReadyStatus
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
(HealthNotReadyStatus -> HealthNotReadyStatus -> Bool)
-> (HealthNotReadyStatus -> HealthNotReadyStatus -> Bool)
-> Eq HealthNotReadyStatus
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 = String
-> (Object -> Parser HealthNotReadyStatus)
-> Value
-> Parser HealthNotReadyStatus
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HealthNotReadyStatus" ((Object -> Parser HealthNotReadyStatus)
 -> Value -> Parser HealthNotReadyStatus)
-> (Object -> Parser HealthNotReadyStatus)
-> Value
-> Parser HealthNotReadyStatus
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe (Map String Text) -> HealthNotReadyStatus
HealthNotReadyStatus
      (Maybe (Map String Text) -> HealthNotReadyStatus)
-> Parser (Maybe (Map String Text)) -> Parser HealthNotReadyStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe (Map String Text))
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" Key -> Maybe (Map String Text) -> (Key, Value)
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 :: Maybe (Map String Text) -> HealthNotReadyStatus
HealthNotReadyStatus
  { healthNotReadyStatusErrors :: Maybe (Map String Text)
healthNotReadyStatusErrors = Maybe (Map String Text)
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
(Int -> HealthStatus -> ShowS)
-> (HealthStatus -> String)
-> ([HealthStatus] -> ShowS)
-> Show HealthStatus
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
(HealthStatus -> HealthStatus -> Bool)
-> (HealthStatus -> HealthStatus -> Bool) -> Eq HealthStatus
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 = String
-> (Object -> Parser HealthStatus) -> Value -> Parser HealthStatus
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HealthStatus" ((Object -> Parser HealthStatus) -> Value -> Parser HealthStatus)
-> (Object -> Parser HealthStatus) -> Value -> Parser HealthStatus
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> HealthStatus
HealthStatus
      (Maybe Text -> HealthStatus)
-> Parser (Maybe Text) -> Parser HealthStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
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" Key -> Maybe Text -> (Key, Value)
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 :: Maybe Text -> HealthStatus
HealthStatus
  { healthStatusStatus :: Maybe Text
healthStatusStatus = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** JSONWebKey
-- | JSONWebKey
-- It is important that this model object is named JSONWebKey for \"swagger generate spec\" to generate only on definition of a 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
(Int -> JSONWebKey -> ShowS)
-> (JSONWebKey -> String)
-> ([JSONWebKey] -> ShowS)
-> Show JSONWebKey
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
(JSONWebKey -> JSONWebKey -> Bool)
-> (JSONWebKey -> JSONWebKey -> Bool) -> Eq JSONWebKey
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 = String
-> (Object -> Parser JSONWebKey) -> Value -> Parser JSONWebKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"JSONWebKey" ((Object -> Parser JSONWebKey) -> Value -> Parser JSONWebKey)
-> (Object -> Parser JSONWebKey) -> Value -> Parser 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
      (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)
-> Parser Text
-> Parser
     (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)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"alg")
      Parser
  (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)
-> Parser (Maybe Text)
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"crv")
      Parser
  (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)
-> Parser (Maybe Text)
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"d")
      Parser
  (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)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dp")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dq")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"e")
      Parser
  (Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"k")
      Parser
  (Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"kid")
      Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"kty")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"n")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"p")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"q")
      Parser
  (Maybe Text
   -> Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser
     (Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"qi")
      Parser
  (Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> JSONWebKey)
-> Parser Text
-> Parser (Maybe Text -> Maybe [Text] -> Maybe Text -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"use")
      Parser (Maybe Text -> Maybe [Text] -> Maybe Text -> JSONWebKey)
-> Parser (Maybe Text)
-> Parser (Maybe [Text] -> Maybe Text -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x")
      Parser (Maybe [Text] -> Maybe Text -> JSONWebKey)
-> Parser (Maybe [Text]) -> Parser (Maybe Text -> JSONWebKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x5c")
      Parser (Maybe Text -> JSONWebKey)
-> Parser (Maybe Text) -> Parser JSONWebKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
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" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jSONWebKeyAlg
      , Key
"crv" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyCrv
      , Key
"d" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyD
      , Key
"dp" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyDp
      , Key
"dq" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyDq
      , Key
"e" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyE
      , Key
"k" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyK
      , Key
"kid" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jSONWebKeyKid
      , Key
"kty" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jSONWebKeyKty
      , Key
"n" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyN
      , Key
"p" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyP
      , Key
"q" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyQ
      , Key
"qi" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyQi
      , Key
"use" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jSONWebKeyUse
      , Key
"x" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
jSONWebKeyX
      , Key
"x5c" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
jSONWebKeyX5c
      , Key
"y" Key -> Maybe Text -> (Key, Value)
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
-> 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
  { Text
jSONWebKeyAlg :: Text
jSONWebKeyAlg :: Text
jSONWebKeyAlg
  , jSONWebKeyCrv :: Maybe Text
jSONWebKeyCrv = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyD :: Maybe Text
jSONWebKeyD = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyDp :: Maybe Text
jSONWebKeyDp = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyDq :: Maybe Text
jSONWebKeyDq = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyE :: Maybe Text
jSONWebKeyE = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyK :: Maybe Text
jSONWebKeyK = Maybe Text
forall a. Maybe a
Nothing
  , Text
jSONWebKeyKid :: Text
jSONWebKeyKid :: Text
jSONWebKeyKid
  , Text
jSONWebKeyKty :: Text
jSONWebKeyKty :: Text
jSONWebKeyKty
  , jSONWebKeyN :: Maybe Text
jSONWebKeyN = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyP :: Maybe Text
jSONWebKeyP = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyQ :: Maybe Text
jSONWebKeyQ = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyQi :: Maybe Text
jSONWebKeyQi = Maybe Text
forall a. Maybe a
Nothing
  , Text
jSONWebKeyUse :: Text
jSONWebKeyUse :: Text
jSONWebKeyUse
  , jSONWebKeyX :: Maybe Text
jSONWebKeyX = Maybe Text
forall a. Maybe a
Nothing
  , jSONWebKeyX5c :: Maybe [Text]
jSONWebKeyX5c = Maybe [Text]
forall a. Maybe a
Nothing
  , jSONWebKeyY :: Maybe Text
jSONWebKeyY = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** JSONWebKeySet
-- | JSONWebKeySet
-- It is important that this model object is named JSONWebKeySet for \"swagger generate spec\" to generate only on definition of a JSONWebKeySet. Since one with the same name is previously defined as client.Client.JSONWebKeys and this one is last, this one will be effectively written in the swagger spec.
data JSONWebKeySet = JSONWebKeySet
  { JSONWebKeySet -> Maybe [JSONWebKey]
jSONWebKeySetKeys :: Maybe [JSONWebKey] -- ^ "keys" - The value of the \&quot;keys\&quot; parameter is an array of 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
(Int -> JSONWebKeySet -> ShowS)
-> (JSONWebKeySet -> String)
-> ([JSONWebKeySet] -> ShowS)
-> Show JSONWebKeySet
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
(JSONWebKeySet -> JSONWebKeySet -> Bool)
-> (JSONWebKeySet -> JSONWebKeySet -> Bool) -> Eq JSONWebKeySet
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 = String
-> (Object -> Parser JSONWebKeySet)
-> Value
-> Parser JSONWebKeySet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"JSONWebKeySet" ((Object -> Parser JSONWebKeySet) -> Value -> Parser JSONWebKeySet)
-> (Object -> Parser JSONWebKeySet)
-> Value
-> Parser JSONWebKeySet
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [JSONWebKey] -> JSONWebKeySet
JSONWebKeySet
      (Maybe [JSONWebKey] -> JSONWebKeySet)
-> Parser (Maybe [JSONWebKey]) -> Parser JSONWebKeySet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [JSONWebKey])
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" Key -> Maybe [JSONWebKey] -> (Key, Value)
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 :: Maybe [JSONWebKey] -> JSONWebKeySet
JSONWebKeySet
  { jSONWebKeySetKeys :: Maybe [JSONWebKey]
jSONWebKeySetKeys = Maybe [JSONWebKey]
forall a. Maybe a
Nothing
  }

-- ** JsonWebKeySetGeneratorRequest
-- | JsonWebKeySetGeneratorRequest
data JsonWebKeySetGeneratorRequest = JsonWebKeySetGeneratorRequest
  { JsonWebKeySetGeneratorRequest -> Text
jsonWebKeySetGeneratorRequestAlg :: Text -- ^ /Required/ "alg" - The algorithm to be used for creating the key. Supports \&quot;RS256\&quot;, \&quot;ES512\&quot;, \&quot;HS512\&quot;, and \&quot;HS256\&quot;
  , JsonWebKeySetGeneratorRequest -> Text
jsonWebKeySetGeneratorRequestKid :: Text -- ^ /Required/ "kid" - The kid of the key to be created
  , JsonWebKeySetGeneratorRequest -> Text
jsonWebKeySetGeneratorRequestUse :: Text -- ^ /Required/ "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 -> JsonWebKeySetGeneratorRequest -> ShowS
[JsonWebKeySetGeneratorRequest] -> ShowS
JsonWebKeySetGeneratorRequest -> String
(Int -> JsonWebKeySetGeneratorRequest -> ShowS)
-> (JsonWebKeySetGeneratorRequest -> String)
-> ([JsonWebKeySetGeneratorRequest] -> ShowS)
-> Show JsonWebKeySetGeneratorRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonWebKeySetGeneratorRequest] -> ShowS
$cshowList :: [JsonWebKeySetGeneratorRequest] -> ShowS
show :: JsonWebKeySetGeneratorRequest -> String
$cshow :: JsonWebKeySetGeneratorRequest -> String
showsPrec :: Int -> JsonWebKeySetGeneratorRequest -> ShowS
$cshowsPrec :: Int -> JsonWebKeySetGeneratorRequest -> ShowS
P.Show, JsonWebKeySetGeneratorRequest
-> JsonWebKeySetGeneratorRequest -> Bool
(JsonWebKeySetGeneratorRequest
 -> JsonWebKeySetGeneratorRequest -> Bool)
-> (JsonWebKeySetGeneratorRequest
    -> JsonWebKeySetGeneratorRequest -> Bool)
-> Eq JsonWebKeySetGeneratorRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonWebKeySetGeneratorRequest
-> JsonWebKeySetGeneratorRequest -> Bool
$c/= :: JsonWebKeySetGeneratorRequest
-> JsonWebKeySetGeneratorRequest -> Bool
== :: JsonWebKeySetGeneratorRequest
-> JsonWebKeySetGeneratorRequest -> Bool
$c== :: JsonWebKeySetGeneratorRequest
-> JsonWebKeySetGeneratorRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON JsonWebKeySetGeneratorRequest
instance A.ToJSON JsonWebKeySetGeneratorRequest where
  toJSON :: JsonWebKeySetGeneratorRequest -> Value
toJSON JsonWebKeySetGeneratorRequest {Text
jsonWebKeySetGeneratorRequestUse :: Text
jsonWebKeySetGeneratorRequestKid :: Text
jsonWebKeySetGeneratorRequestAlg :: Text
jsonWebKeySetGeneratorRequestUse :: JsonWebKeySetGeneratorRequest -> Text
jsonWebKeySetGeneratorRequestKid :: JsonWebKeySetGeneratorRequest -> Text
jsonWebKeySetGeneratorRequestAlg :: JsonWebKeySetGeneratorRequest -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"alg" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonWebKeySetGeneratorRequestAlg
      , Key
"kid" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonWebKeySetGeneratorRequestKid
      , Key
"use" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
jsonWebKeySetGeneratorRequestUse
      ]


-- | Construct a value of type 'JsonWebKeySetGeneratorRequest' (by applying it's required fields, if any)
mkJsonWebKeySetGeneratorRequest
  :: Text -- ^ 'jsonWebKeySetGeneratorRequestAlg': The algorithm to be used for creating the key. Supports \"RS256\", \"ES512\", \"HS512\", and \"HS256\"
  -> Text -- ^ 'jsonWebKeySetGeneratorRequestKid': The kid of the key to be created
  -> Text -- ^ 'jsonWebKeySetGeneratorRequestUse': 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\".
  -> JsonWebKeySetGeneratorRequest
mkJsonWebKeySetGeneratorRequest :: Text -> Text -> Text -> JsonWebKeySetGeneratorRequest
mkJsonWebKeySetGeneratorRequest Text
jsonWebKeySetGeneratorRequestAlg Text
jsonWebKeySetGeneratorRequestKid Text
jsonWebKeySetGeneratorRequestUse =
  JsonWebKeySetGeneratorRequest :: Text -> Text -> Text -> JsonWebKeySetGeneratorRequest
JsonWebKeySetGeneratorRequest
  { Text
jsonWebKeySetGeneratorRequestAlg :: Text
jsonWebKeySetGeneratorRequestAlg :: Text
jsonWebKeySetGeneratorRequestAlg
  , Text
jsonWebKeySetGeneratorRequestKid :: Text
jsonWebKeySetGeneratorRequestKid :: Text
jsonWebKeySetGeneratorRequestKid
  , Text
jsonWebKeySetGeneratorRequestUse :: Text
jsonWebKeySetGeneratorRequestUse :: Text
jsonWebKeySetGeneratorRequestUse
  }

-- ** LoginRequest
-- | LoginRequest
-- Contains information on an ongoing login request.
-- 
data LoginRequest = LoginRequest
  { LoginRequest -> Text
loginRequestChallenge :: Text -- ^ /Required/ "challenge" - ID is the identifier (\&quot;login challenge\&quot;) of the login request. It is used to identify the session.
  , LoginRequest -> OAuth2Client
loginRequestClient :: OAuth2Client -- ^ /Required/ "client"
  , LoginRequest -> Maybe OpenIDConnectContext
loginRequestOidcContext :: Maybe OpenIDConnectContext -- ^ "oidc_context"
  , LoginRequest -> Text
loginRequestRequestUrl :: 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.
  , LoginRequest -> [Text]
loginRequestRequestedAccessTokenAudience :: [Text] -- ^ /Required/ "requested_access_token_audience"
  , LoginRequest -> [Text]
loginRequestRequestedScope :: [Text] -- ^ /Required/ "requested_scope"
  , LoginRequest -> Maybe Text
loginRequestSessionId :: 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.
  , LoginRequest -> Bool
loginRequestSkip :: 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.
  , LoginRequest -> Text
loginRequestSubject :: 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 -> LoginRequest -> ShowS
[LoginRequest] -> ShowS
LoginRequest -> String
(Int -> LoginRequest -> ShowS)
-> (LoginRequest -> String)
-> ([LoginRequest] -> ShowS)
-> Show LoginRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoginRequest] -> ShowS
$cshowList :: [LoginRequest] -> ShowS
show :: LoginRequest -> String
$cshow :: LoginRequest -> String
showsPrec :: Int -> LoginRequest -> ShowS
$cshowsPrec :: Int -> LoginRequest -> ShowS
P.Show, LoginRequest -> LoginRequest -> Bool
(LoginRequest -> LoginRequest -> Bool)
-> (LoginRequest -> LoginRequest -> Bool) -> Eq LoginRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginRequest -> LoginRequest -> Bool
$c/= :: LoginRequest -> LoginRequest -> Bool
== :: LoginRequest -> LoginRequest -> Bool
$c== :: LoginRequest -> LoginRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON LoginRequest
instance A.ToJSON LoginRequest where
  toJSON :: LoginRequest -> Value
toJSON LoginRequest {Bool
[Text]
Maybe Text
Maybe OpenIDConnectContext
Text
OAuth2Client
loginRequestSubject :: Text
loginRequestSkip :: Bool
loginRequestSessionId :: Maybe Text
loginRequestRequestedScope :: [Text]
loginRequestRequestedAccessTokenAudience :: [Text]
loginRequestRequestUrl :: Text
loginRequestOidcContext :: Maybe OpenIDConnectContext
loginRequestClient :: OAuth2Client
loginRequestChallenge :: Text
loginRequestSubject :: LoginRequest -> Text
loginRequestSkip :: LoginRequest -> Bool
loginRequestSessionId :: LoginRequest -> Maybe Text
loginRequestRequestedScope :: LoginRequest -> [Text]
loginRequestRequestedAccessTokenAudience :: LoginRequest -> [Text]
loginRequestRequestUrl :: LoginRequest -> Text
loginRequestOidcContext :: LoginRequest -> Maybe OpenIDConnectContext
loginRequestClient :: LoginRequest -> OAuth2Client
loginRequestChallenge :: LoginRequest -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"challenge" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
loginRequestChallenge
      , Key
"client" Key -> OAuth2Client -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OAuth2Client
loginRequestClient
      , Key
"oidc_context" Key -> Maybe OpenIDConnectContext -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe OpenIDConnectContext
loginRequestOidcContext
      , Key
"request_url" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
loginRequestRequestUrl
      , Key
"requested_access_token_audience" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
loginRequestRequestedAccessTokenAudience
      , Key
"requested_scope" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
loginRequestRequestedScope
      , Key
"session_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
loginRequestSessionId
      , Key
"skip" Key -> Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
loginRequestSkip
      , Key
"subject" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
loginRequestSubject
      ]


-- | Construct a value of type 'LoginRequest' (by applying it's required fields, if any)
mkLoginRequest
  :: Text -- ^ 'loginRequestChallenge': ID is the identifier (\"login challenge\") of the login request. It is used to identify the session.
  -> OAuth2Client -- ^ 'loginRequestClient' 
  -> Text -- ^ 'loginRequestRequestUrl': 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] -- ^ 'loginRequestRequestedAccessTokenAudience' 
  -> [Text] -- ^ 'loginRequestRequestedScope' 
  -> Bool -- ^ 'loginRequestSkip': 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 -- ^ 'loginRequestSubject': 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.
  -> LoginRequest
mkLoginRequest :: Text
-> OAuth2Client
-> Text
-> [Text]
-> [Text]
-> Bool
-> Text
-> LoginRequest
mkLoginRequest Text
loginRequestChallenge OAuth2Client
loginRequestClient Text
loginRequestRequestUrl [Text]
loginRequestRequestedAccessTokenAudience [Text]
loginRequestRequestedScope Bool
loginRequestSkip Text
loginRequestSubject =
  LoginRequest :: Text
-> OAuth2Client
-> Maybe OpenIDConnectContext
-> Text
-> [Text]
-> [Text]
-> Maybe Text
-> Bool
-> Text
-> LoginRequest
LoginRequest
  { Text
loginRequestChallenge :: Text
loginRequestChallenge :: Text
loginRequestChallenge
  , OAuth2Client
loginRequestClient :: OAuth2Client
loginRequestClient :: OAuth2Client
loginRequestClient
  , loginRequestOidcContext :: Maybe OpenIDConnectContext
loginRequestOidcContext = Maybe OpenIDConnectContext
forall a. Maybe a
Nothing
  , Text
loginRequestRequestUrl :: Text
loginRequestRequestUrl :: Text
loginRequestRequestUrl
  , [Text]
loginRequestRequestedAccessTokenAudience :: [Text]
loginRequestRequestedAccessTokenAudience :: [Text]
loginRequestRequestedAccessTokenAudience
  , [Text]
loginRequestRequestedScope :: [Text]
loginRequestRequestedScope :: [Text]
loginRequestRequestedScope
  , loginRequestSessionId :: Maybe Text
loginRequestSessionId = Maybe Text
forall a. Maybe a
Nothing
  , Bool
loginRequestSkip :: Bool
loginRequestSkip :: Bool
loginRequestSkip
  , Text
loginRequestSubject :: Text
loginRequestSubject :: Text
loginRequestSubject
  }

-- ** LogoutRequest
-- | LogoutRequest
-- Contains information about an ongoing logout request.
-- 
data LogoutRequest = LogoutRequest
  { LogoutRequest -> Maybe Text
logoutRequestRequestUrl :: Maybe Text -- ^ "request_url" - RequestURL is the original Logout URL requested.
  , LogoutRequest -> Maybe Bool
logoutRequestRpInitiated :: 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.
  , LogoutRequest -> Maybe Text
logoutRequestSid :: Maybe Text -- ^ "sid" - SessionID is the login session ID that was requested to log out.
  , LogoutRequest -> Maybe Text
logoutRequestSubject :: Maybe Text -- ^ "subject" - Subject is the user for whom the logout was request.
  } deriving (Int -> LogoutRequest -> ShowS
[LogoutRequest] -> ShowS
LogoutRequest -> String
(Int -> LogoutRequest -> ShowS)
-> (LogoutRequest -> String)
-> ([LogoutRequest] -> ShowS)
-> Show LogoutRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogoutRequest] -> ShowS
$cshowList :: [LogoutRequest] -> ShowS
show :: LogoutRequest -> String
$cshow :: LogoutRequest -> String
showsPrec :: Int -> LogoutRequest -> ShowS
$cshowsPrec :: Int -> LogoutRequest -> ShowS
P.Show, LogoutRequest -> LogoutRequest -> Bool
(LogoutRequest -> LogoutRequest -> Bool)
-> (LogoutRequest -> LogoutRequest -> Bool) -> Eq LogoutRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogoutRequest -> LogoutRequest -> Bool
$c/= :: LogoutRequest -> LogoutRequest -> Bool
== :: LogoutRequest -> LogoutRequest -> Bool
$c== :: LogoutRequest -> LogoutRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON LogoutRequest
instance A.ToJSON LogoutRequest where
  toJSON :: LogoutRequest -> Value
toJSON LogoutRequest {Maybe Bool
Maybe Text
logoutRequestSubject :: Maybe Text
logoutRequestSid :: Maybe Text
logoutRequestRpInitiated :: Maybe Bool
logoutRequestRequestUrl :: Maybe Text
logoutRequestSubject :: LogoutRequest -> Maybe Text
logoutRequestSid :: LogoutRequest -> Maybe Text
logoutRequestRpInitiated :: LogoutRequest -> Maybe Bool
logoutRequestRequestUrl :: LogoutRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"request_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
logoutRequestRequestUrl
      , Key
"rp_initiated" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
logoutRequestRpInitiated
      , Key
"sid" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
logoutRequestSid
      , Key
"subject" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
logoutRequestSubject
      ]


-- | Construct a value of type 'LogoutRequest' (by applying it's required fields, if any)
mkLogoutRequest
  :: LogoutRequest
mkLogoutRequest :: LogoutRequest
mkLogoutRequest =
  LogoutRequest :: Maybe Text
-> Maybe Bool -> Maybe Text -> Maybe Text -> LogoutRequest
LogoutRequest
  { logoutRequestRequestUrl :: Maybe Text
logoutRequestRequestUrl = Maybe Text
forall a. Maybe a
Nothing
  , logoutRequestRpInitiated :: Maybe Bool
logoutRequestRpInitiated = Maybe Bool
forall a. Maybe a
Nothing
  , logoutRequestSid :: Maybe Text
logoutRequestSid = Maybe Text
forall a. Maybe a
Nothing
  , logoutRequestSubject :: Maybe Text
logoutRequestSubject = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OAuth2Client
-- | OAuth2Client
-- Client represents an OAuth 2.0 Client.
-- 
data OAuth2Client = OAuth2Client
  { OAuth2Client -> Maybe [Text]
oAuth2ClientAllowedCorsOrigins :: Maybe [Text] -- ^ "allowed_cors_origins"
  , OAuth2Client -> Maybe [Text]
oAuth2ClientAudience :: Maybe [Text] -- ^ "audience"
  , OAuth2Client -> Maybe Bool
oAuth2ClientBackchannelLogoutSessionRequired :: Maybe Bool -- ^ "backchannel_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" - RP URL that will cause the RP to log itself out when sent a Logout Token by the OP.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientId :: Maybe Text -- ^ "client_id" - ID  is the id for this client.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientName :: Maybe Text -- ^ "client_name" - Name is the human-readable string name of the client to be presented to the end-user during authorization.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientSecret :: Maybe Text -- ^ "client_secret" - Secret is the client&#39;s secret. The secret will be included in the create request as cleartext, and then never again. The secret is stored using BCrypt so it is impossible to recover it. Tell your users that they need to write the secret down as it will not be made available again.
  , OAuth2Client -> Maybe Integer
oAuth2ClientClientSecretExpiresAt :: Maybe Integer -- ^ "client_secret_expires_at" - SecretExpiresAt is an integer holding the time at which the client secret will expire or 0 if it will not expire. The time is represented as the number of seconds from 1970-01-01T00:00:00Z as measured in UTC until the date/time of expiration.  This feature is currently not supported and it&#39;s value will always be set to 0.
  , OAuth2Client -> Maybe Text
oAuth2ClientClientUri :: Maybe Text -- ^ "client_uri" - ClientURI is an 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" - CreatedAt returns the timestamp of the client&#39;s creation.
  , OAuth2Client -> Maybe Bool
oAuth2ClientFrontchannelLogoutSessionRequired :: Maybe Bool -- ^ "frontchannel_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" - 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 Value
oAuth2ClientJwks :: Maybe A.Value -- ^ "jwks"
  , OAuth2Client -> Maybe Text
oAuth2ClientJwksUri :: Maybe Text -- ^ "jwks_uri" - 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
oAuth2ClientLogoUri :: Maybe Text -- ^ "logo_uri" - LogoURI is an URL string that references a logo for the client.
  , OAuth2Client -> Maybe Value
oAuth2ClientMetadata :: Maybe A.Value -- ^ "metadata"
  , OAuth2Client -> Maybe Text
oAuth2ClientOwner :: Maybe Text -- ^ "owner" - Owner is a string identifying the owner of the OAuth 2.0 Client.
  , OAuth2Client -> Maybe Text
oAuth2ClientPolicyUri :: Maybe Text -- ^ "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
oAuth2ClientRequestObjectSigningAlg :: Maybe Text -- ^ "request_object_signing_alg" - 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" - 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" - 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" - SubjectType requested for responses to this Client. The subject_types_supported 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" - Requested Client Authentication method for the Token Endpoint. The options are client_secret_post, client_secret_basic, private_key_jwt, and none.
  , OAuth2Client -> Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg :: Maybe Text -- ^ "token_endpoint_auth_signing_alg" - Requested Client Authentication signing algorithm for the Token Endpoint.
  , OAuth2Client -> Maybe Text
oAuth2ClientTosUri :: Maybe Text -- ^ "tos_uri" - TermsOfServiceURI is a URL string that points 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" - UpdatedAt returns the timestamp of the last update.
  , OAuth2Client -> Maybe Text
oAuth2ClientUserinfoSignedResponseAlg :: Maybe Text -- ^ "userinfo_signed_response_alg" - 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
(Int -> OAuth2Client -> ShowS)
-> (OAuth2Client -> String)
-> ([OAuth2Client] -> ShowS)
-> Show OAuth2Client
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
(OAuth2Client -> OAuth2Client -> Bool)
-> (OAuth2Client -> OAuth2Client -> Bool) -> Eq OAuth2Client
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 = String
-> (Object -> Parser OAuth2Client) -> Value -> Parser OAuth2Client
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuth2Client" ((Object -> Parser OAuth2Client) -> Value -> Parser OAuth2Client)
-> (Object -> Parser OAuth2Client) -> Value -> Parser OAuth2Client
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe Value
-> 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 DateTime
-> Maybe Text
-> OAuth2Client
OAuth2Client
      (Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe DateTime
 -> Maybe Bool
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Value
 -> 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 DateTime
 -> Maybe Text
 -> OAuth2Client)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowed_cors_origins")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"audience")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backchannel_logout_session_required")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backchannel_logout_uri")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_name")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_secret")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_secret_expires_at")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_uri")
      Parser
  (Maybe [Text]
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe [Text])
-> Parser
     (Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contacts")
      Parser
  (Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontchannel_logout_session_required")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"frontchannel_logout_uri")
      Parser
  (Maybe [Text]
   -> Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Value
      -> 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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grant_types")
      Parser
  (Maybe Value
   -> 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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Value)
-> Parser
     (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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jwks")
      Parser
  (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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jwks_uri")
      Parser
  (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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (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 DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logo_uri")
      Parser
  (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 DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Value)
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata")
      Parser
  (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)
-> Parser (Maybe Text)
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")
      Parser
  (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)
-> Parser (Maybe Text)
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"policy_uri")
      Parser
  (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)
-> Parser (Maybe [Text])
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"post_logout_redirect_uris")
      Parser
  (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)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"redirect_uris")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_object_signing_alg")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_uris")
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_types")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sector_identifier_uri")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subject_type")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe DateTime -> Maybe Text -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_endpoint_auth_method")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe DateTime -> Maybe Text -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe DateTime -> Maybe Text -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_endpoint_auth_signing_alg")
      Parser (Maybe Text -> Maybe DateTime -> Maybe Text -> OAuth2Client)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe Text -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tos_uri")
      Parser (Maybe DateTime -> Maybe Text -> OAuth2Client)
-> Parser (Maybe DateTime) -> Parser (Maybe Text -> OAuth2Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe Text -> OAuth2Client)
-> Parser (Maybe Text) -> Parser OAuth2Client
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
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
oAuth2ClientRedirectUris :: Maybe [Text]
oAuth2ClientPostLogoutRedirectUris :: Maybe [Text]
oAuth2ClientPolicyUri :: Maybe Text
oAuth2ClientOwner :: Maybe Text
oAuth2ClientMetadata :: Maybe Value
oAuth2ClientLogoUri :: Maybe Text
oAuth2ClientJwksUri :: Maybe Text
oAuth2ClientJwks :: Maybe Value
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
oAuth2ClientBackchannelLogoutUri :: Maybe Text
oAuth2ClientBackchannelLogoutSessionRequired :: Maybe Bool
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
oAuth2ClientRedirectUris :: OAuth2Client -> Maybe [Text]
oAuth2ClientPostLogoutRedirectUris :: OAuth2Client -> Maybe [Text]
oAuth2ClientPolicyUri :: OAuth2Client -> Maybe Text
oAuth2ClientOwner :: OAuth2Client -> Maybe Text
oAuth2ClientMetadata :: OAuth2Client -> Maybe Value
oAuth2ClientLogoUri :: OAuth2Client -> Maybe Text
oAuth2ClientJwksUri :: OAuth2Client -> Maybe Text
oAuth2ClientJwks :: OAuth2Client -> Maybe Value
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
oAuth2ClientBackchannelLogoutUri :: OAuth2Client -> Maybe Text
oAuth2ClientBackchannelLogoutSessionRequired :: OAuth2Client -> Maybe Bool
oAuth2ClientAudience :: OAuth2Client -> Maybe [Text]
oAuth2ClientAllowedCorsOrigins :: OAuth2Client -> Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allowed_cors_origins" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientAllowedCorsOrigins
      , Key
"audience" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientAudience
      , Key
"backchannel_logout_session_required" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oAuth2ClientBackchannelLogoutSessionRequired
      , Key
"backchannel_logout_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientBackchannelLogoutUri
      , Key
"client_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientId
      , Key
"client_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientName
      , Key
"client_secret" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientSecret
      , Key
"client_secret_expires_at" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2ClientClientSecretExpiresAt
      , Key
"client_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientClientUri
      , Key
"contacts" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientContacts
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ClientCreatedAt
      , Key
"frontchannel_logout_session_required" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
oAuth2ClientFrontchannelLogoutSessionRequired
      , Key
"frontchannel_logout_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientFrontchannelLogoutUri
      , Key
"grant_types" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientGrantTypes
      , Key
"jwks" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
oAuth2ClientJwks
      , Key
"jwks_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientJwksUri
      , Key
"logo_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientLogoUri
      , Key
"metadata" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
oAuth2ClientMetadata
      , Key
"owner" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientOwner
      , Key
"policy_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientPolicyUri
      , Key
"post_logout_redirect_uris" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientPostLogoutRedirectUris
      , Key
"redirect_uris" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientRedirectUris
      , Key
"request_object_signing_alg" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientRequestObjectSigningAlg
      , Key
"request_uris" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientRequestUris
      , Key
"response_types" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2ClientResponseTypes
      , Key
"scope" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientScope
      , Key
"sector_identifier_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientSectorIdentifierUri
      , Key
"subject_type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientSubjectType
      , Key
"token_endpoint_auth_method" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenEndpointAuthMethod
      , Key
"token_endpoint_auth_signing_alg" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg
      , Key
"tos_uri" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2ClientTosUri
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
oAuth2ClientUpdatedAt
      , Key
"userinfo_signed_response_alg" Key -> Maybe Text -> (Key, Value)
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 :: Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe Value
-> 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 DateTime
-> Maybe Text
-> OAuth2Client
OAuth2Client
  { oAuth2ClientAllowedCorsOrigins :: Maybe [Text]
oAuth2ClientAllowedCorsOrigins = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientAudience :: Maybe [Text]
oAuth2ClientAudience = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientBackchannelLogoutSessionRequired :: Maybe Bool
oAuth2ClientBackchannelLogoutSessionRequired = Maybe Bool
forall a. Maybe a
Nothing
  , oAuth2ClientBackchannelLogoutUri :: Maybe Text
oAuth2ClientBackchannelLogoutUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientClientId :: Maybe Text
oAuth2ClientClientId = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientClientName :: Maybe Text
oAuth2ClientClientName = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientClientSecret :: Maybe Text
oAuth2ClientClientSecret = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientClientSecretExpiresAt :: Maybe Integer
oAuth2ClientClientSecretExpiresAt = Maybe Integer
forall a. Maybe a
Nothing
  , oAuth2ClientClientUri :: Maybe Text
oAuth2ClientClientUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientContacts :: Maybe [Text]
oAuth2ClientContacts = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientCreatedAt :: Maybe DateTime
oAuth2ClientCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , oAuth2ClientFrontchannelLogoutSessionRequired :: Maybe Bool
oAuth2ClientFrontchannelLogoutSessionRequired = Maybe Bool
forall a. Maybe a
Nothing
  , oAuth2ClientFrontchannelLogoutUri :: Maybe Text
oAuth2ClientFrontchannelLogoutUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientGrantTypes :: Maybe [Text]
oAuth2ClientGrantTypes = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientJwks :: Maybe Value
oAuth2ClientJwks = Maybe Value
forall a. Maybe a
Nothing
  , oAuth2ClientJwksUri :: Maybe Text
oAuth2ClientJwksUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientLogoUri :: Maybe Text
oAuth2ClientLogoUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientMetadata :: Maybe Value
oAuth2ClientMetadata = Maybe Value
forall a. Maybe a
Nothing
  , oAuth2ClientOwner :: Maybe Text
oAuth2ClientOwner = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientPolicyUri :: Maybe Text
oAuth2ClientPolicyUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientPostLogoutRedirectUris :: Maybe [Text]
oAuth2ClientPostLogoutRedirectUris = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientRedirectUris :: Maybe [Text]
oAuth2ClientRedirectUris = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientRequestObjectSigningAlg :: Maybe Text
oAuth2ClientRequestObjectSigningAlg = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientRequestUris :: Maybe [Text]
oAuth2ClientRequestUris = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientResponseTypes :: Maybe [Text]
oAuth2ClientResponseTypes = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2ClientScope :: Maybe Text
oAuth2ClientScope = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientSectorIdentifierUri :: Maybe Text
oAuth2ClientSectorIdentifierUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientSubjectType :: Maybe Text
oAuth2ClientSubjectType = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientTokenEndpointAuthMethod :: Maybe Text
oAuth2ClientTokenEndpointAuthMethod = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientTokenEndpointAuthSigningAlg :: Maybe Text
oAuth2ClientTokenEndpointAuthSigningAlg = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientTosUri :: Maybe Text
oAuth2ClientTosUri = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2ClientUpdatedAt :: Maybe DateTime
oAuth2ClientUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , oAuth2ClientUserinfoSignedResponseAlg :: Maybe Text
oAuth2ClientUserinfoSignedResponseAlg = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OAuth2TokenIntrospection
-- | OAuth2TokenIntrospection
-- Introspection contains an access token's session data as specified by IETF RFC 7662, see:
-- 
-- https://tools.ietf.org/html/rfc7662
data OAuth2TokenIntrospection = OAuth2TokenIntrospection
  { OAuth2TokenIntrospection -> Bool
oAuth2TokenIntrospectionActive :: 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).
  , OAuth2TokenIntrospection -> Maybe [Text]
oAuth2TokenIntrospectionAud :: Maybe [Text] -- ^ "aud" - Audience contains a list of the token&#39;s intended audiences.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionClientId :: Maybe Text -- ^ "client_id" - ID is aclient identifier for the OAuth 2.0 client that requested this token.
  , OAuth2TokenIntrospection -> Maybe Integer
oAuth2TokenIntrospectionExp :: 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.
  , OAuth2TokenIntrospection -> Maybe Value
oAuth2TokenIntrospectionExt :: Maybe A.Value -- ^ "ext" - Extra is arbitrary data set by the session.
  , OAuth2TokenIntrospection -> Maybe Integer
oAuth2TokenIntrospectionIat :: 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.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionIss :: Maybe Text -- ^ "iss" - IssuerURL is a string representing the issuer of this token
  , OAuth2TokenIntrospection -> Maybe Integer
oAuth2TokenIntrospectionNbf :: 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.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionObfuscatedSubject :: 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.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionScope :: Maybe Text -- ^ "scope" - Scope is a JSON string containing a space-separated list of scopes associated with this token.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionSub :: 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.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionTokenType :: Maybe Text -- ^ "token_type" - TokenType is the introspected token&#39;s type, typically &#x60;Bearer&#x60;.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionTokenUse :: Maybe Text -- ^ "token_use" - TokenUse is the introspected token&#39;s use, for example &#x60;access_token&#x60; or &#x60;refresh_token&#x60;.
  , OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionUsername :: Maybe Text -- ^ "username" - Username is a human-readable identifier for the resource owner who authorized this token.
  } deriving (Int -> OAuth2TokenIntrospection -> ShowS
[OAuth2TokenIntrospection] -> ShowS
OAuth2TokenIntrospection -> String
(Int -> OAuth2TokenIntrospection -> ShowS)
-> (OAuth2TokenIntrospection -> String)
-> ([OAuth2TokenIntrospection] -> ShowS)
-> Show OAuth2TokenIntrospection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2TokenIntrospection] -> ShowS
$cshowList :: [OAuth2TokenIntrospection] -> ShowS
show :: OAuth2TokenIntrospection -> String
$cshow :: OAuth2TokenIntrospection -> String
showsPrec :: Int -> OAuth2TokenIntrospection -> ShowS
$cshowsPrec :: Int -> OAuth2TokenIntrospection -> ShowS
P.Show, OAuth2TokenIntrospection -> OAuth2TokenIntrospection -> Bool
(OAuth2TokenIntrospection -> OAuth2TokenIntrospection -> Bool)
-> (OAuth2TokenIntrospection -> OAuth2TokenIntrospection -> Bool)
-> Eq OAuth2TokenIntrospection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2TokenIntrospection -> OAuth2TokenIntrospection -> Bool
$c/= :: OAuth2TokenIntrospection -> OAuth2TokenIntrospection -> Bool
== :: OAuth2TokenIntrospection -> OAuth2TokenIntrospection -> Bool
$c== :: OAuth2TokenIntrospection -> OAuth2TokenIntrospection -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON OAuth2TokenIntrospection
instance A.ToJSON OAuth2TokenIntrospection where
  toJSON :: OAuth2TokenIntrospection -> Value
toJSON OAuth2TokenIntrospection {Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe Value
oAuth2TokenIntrospectionUsername :: Maybe Text
oAuth2TokenIntrospectionTokenUse :: Maybe Text
oAuth2TokenIntrospectionTokenType :: Maybe Text
oAuth2TokenIntrospectionSub :: Maybe Text
oAuth2TokenIntrospectionScope :: Maybe Text
oAuth2TokenIntrospectionObfuscatedSubject :: Maybe Text
oAuth2TokenIntrospectionNbf :: Maybe Integer
oAuth2TokenIntrospectionIss :: Maybe Text
oAuth2TokenIntrospectionIat :: Maybe Integer
oAuth2TokenIntrospectionExt :: Maybe Value
oAuth2TokenIntrospectionExp :: Maybe Integer
oAuth2TokenIntrospectionClientId :: Maybe Text
oAuth2TokenIntrospectionAud :: Maybe [Text]
oAuth2TokenIntrospectionActive :: Bool
oAuth2TokenIntrospectionUsername :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionTokenUse :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionTokenType :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionSub :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionScope :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionObfuscatedSubject :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionNbf :: OAuth2TokenIntrospection -> Maybe Integer
oAuth2TokenIntrospectionIss :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionIat :: OAuth2TokenIntrospection -> Maybe Integer
oAuth2TokenIntrospectionExt :: OAuth2TokenIntrospection -> Maybe Value
oAuth2TokenIntrospectionExp :: OAuth2TokenIntrospection -> Maybe Integer
oAuth2TokenIntrospectionClientId :: OAuth2TokenIntrospection -> Maybe Text
oAuth2TokenIntrospectionAud :: OAuth2TokenIntrospection -> Maybe [Text]
oAuth2TokenIntrospectionActive :: OAuth2TokenIntrospection -> Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"active" Key -> Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
oAuth2TokenIntrospectionActive
      , Key
"aud" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
oAuth2TokenIntrospectionAud
      , Key
"client_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionClientId
      , Key
"exp" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2TokenIntrospectionExp
      , Key
"ext" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
oAuth2TokenIntrospectionExt
      , Key
"iat" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2TokenIntrospectionIat
      , Key
"iss" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionIss
      , Key
"nbf" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oAuth2TokenIntrospectionNbf
      , Key
"obfuscated_subject" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionObfuscatedSubject
      , Key
"scope" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionScope
      , Key
"sub" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionSub
      , Key
"token_type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionTokenType
      , Key
"token_use" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionTokenUse
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oAuth2TokenIntrospectionUsername
      ]


-- | Construct a value of type 'OAuth2TokenIntrospection' (by applying it's required fields, if any)
mkOAuth2TokenIntrospection
  :: Bool -- ^ 'oAuth2TokenIntrospectionActive': 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).
  -> OAuth2TokenIntrospection
mkOAuth2TokenIntrospection :: Bool -> OAuth2TokenIntrospection
mkOAuth2TokenIntrospection Bool
oAuth2TokenIntrospectionActive =
  OAuth2TokenIntrospection :: Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe Integer
-> Maybe Value
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> OAuth2TokenIntrospection
OAuth2TokenIntrospection
  { Bool
oAuth2TokenIntrospectionActive :: Bool
oAuth2TokenIntrospectionActive :: Bool
oAuth2TokenIntrospectionActive
  , oAuth2TokenIntrospectionAud :: Maybe [Text]
oAuth2TokenIntrospectionAud = Maybe [Text]
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionClientId :: Maybe Text
oAuth2TokenIntrospectionClientId = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionExp :: Maybe Integer
oAuth2TokenIntrospectionExp = Maybe Integer
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionExt :: Maybe Value
oAuth2TokenIntrospectionExt = Maybe Value
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionIat :: Maybe Integer
oAuth2TokenIntrospectionIat = Maybe Integer
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionIss :: Maybe Text
oAuth2TokenIntrospectionIss = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionNbf :: Maybe Integer
oAuth2TokenIntrospectionNbf = Maybe Integer
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionObfuscatedSubject :: Maybe Text
oAuth2TokenIntrospectionObfuscatedSubject = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionScope :: Maybe Text
oAuth2TokenIntrospectionScope = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionSub :: Maybe Text
oAuth2TokenIntrospectionSub = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionTokenType :: Maybe Text
oAuth2TokenIntrospectionTokenType = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionTokenUse :: Maybe Text
oAuth2TokenIntrospectionTokenUse = Maybe Text
forall a. Maybe a
Nothing
  , oAuth2TokenIntrospectionUsername :: Maybe Text
oAuth2TokenIntrospectionUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Oauth2TokenResponse
-- | Oauth2TokenResponse
-- The Access Token Response
data Oauth2TokenResponse = Oauth2TokenResponse
  { Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseAccessToken :: Maybe Text -- ^ "access_token"
  , Oauth2TokenResponse -> Maybe Integer
oauth2TokenResponseExpiresIn :: Maybe Integer -- ^ "expires_in"
  , Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseIdToken :: Maybe Text -- ^ "id_token"
  , Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseRefreshToken :: Maybe Text -- ^ "refresh_token"
  , Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseScope :: Maybe Text -- ^ "scope"
  , Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseTokenType :: Maybe Text -- ^ "token_type"
  } deriving (Int -> Oauth2TokenResponse -> ShowS
[Oauth2TokenResponse] -> ShowS
Oauth2TokenResponse -> String
(Int -> Oauth2TokenResponse -> ShowS)
-> (Oauth2TokenResponse -> String)
-> ([Oauth2TokenResponse] -> ShowS)
-> Show Oauth2TokenResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Oauth2TokenResponse] -> ShowS
$cshowList :: [Oauth2TokenResponse] -> ShowS
show :: Oauth2TokenResponse -> String
$cshow :: Oauth2TokenResponse -> String
showsPrec :: Int -> Oauth2TokenResponse -> ShowS
$cshowsPrec :: Int -> Oauth2TokenResponse -> ShowS
P.Show, Oauth2TokenResponse -> Oauth2TokenResponse -> Bool
(Oauth2TokenResponse -> Oauth2TokenResponse -> Bool)
-> (Oauth2TokenResponse -> Oauth2TokenResponse -> Bool)
-> Eq Oauth2TokenResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Oauth2TokenResponse -> Oauth2TokenResponse -> Bool
$c/= :: Oauth2TokenResponse -> Oauth2TokenResponse -> Bool
== :: Oauth2TokenResponse -> Oauth2TokenResponse -> Bool
$c== :: Oauth2TokenResponse -> Oauth2TokenResponse -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON Oauth2TokenResponse
instance A.ToJSON Oauth2TokenResponse where
  toJSON :: Oauth2TokenResponse -> Value
toJSON Oauth2TokenResponse {Maybe Integer
Maybe Text
oauth2TokenResponseTokenType :: Maybe Text
oauth2TokenResponseScope :: Maybe Text
oauth2TokenResponseRefreshToken :: Maybe Text
oauth2TokenResponseIdToken :: Maybe Text
oauth2TokenResponseExpiresIn :: Maybe Integer
oauth2TokenResponseAccessToken :: Maybe Text
oauth2TokenResponseTokenType :: Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseScope :: Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseRefreshToken :: Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseIdToken :: Oauth2TokenResponse -> Maybe Text
oauth2TokenResponseExpiresIn :: Oauth2TokenResponse -> Maybe Integer
oauth2TokenResponseAccessToken :: Oauth2TokenResponse -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"access_token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oauth2TokenResponseAccessToken
      , Key
"expires_in" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
oauth2TokenResponseExpiresIn
      , Key
"id_token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oauth2TokenResponseIdToken
      , Key
"refresh_token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oauth2TokenResponseRefreshToken
      , Key
"scope" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oauth2TokenResponseScope
      , Key
"token_type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
oauth2TokenResponseTokenType
      ]


-- | Construct a value of type 'Oauth2TokenResponse' (by applying it's required fields, if any)
mkOauth2TokenResponse
  :: Oauth2TokenResponse
mkOauth2TokenResponse :: Oauth2TokenResponse
mkOauth2TokenResponse =
  Oauth2TokenResponse :: Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Oauth2TokenResponse
Oauth2TokenResponse
  { oauth2TokenResponseAccessToken :: Maybe Text
oauth2TokenResponseAccessToken = Maybe Text
forall a. Maybe a
Nothing
  , oauth2TokenResponseExpiresIn :: Maybe Integer
oauth2TokenResponseExpiresIn = Maybe Integer
forall a. Maybe a
Nothing
  , oauth2TokenResponseIdToken :: Maybe Text
oauth2TokenResponseIdToken = Maybe Text
forall a. Maybe a
Nothing
  , oauth2TokenResponseRefreshToken :: Maybe Text
oauth2TokenResponseRefreshToken = Maybe Text
forall a. Maybe a
Nothing
  , oauth2TokenResponseScope :: Maybe Text
oauth2TokenResponseScope = Maybe Text
forall a. Maybe a
Nothing
  , oauth2TokenResponseTokenType :: Maybe Text
oauth2TokenResponseTokenType = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OpenIDConnectContext
-- | OpenIDConnectContext
-- Contains optional information about the OpenID Connect request.
-- 
data OpenIDConnectContext = OpenIDConnectContext
  { OpenIDConnectContext -> Maybe [Text]
openIDConnectContextAcrValues :: 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.
  , OpenIDConnectContext -> Maybe Text
openIDConnectContextDisplay :: 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.
  , OpenIDConnectContext -> Maybe Value
openIDConnectContextIdTokenHintClaims :: Maybe 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.
  , OpenIDConnectContext -> Maybe Text
openIDConnectContextLoginHint :: 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.
  , OpenIDConnectContext -> Maybe [Text]
openIDConnectContextUiLocales :: 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 -> OpenIDConnectContext -> ShowS
[OpenIDConnectContext] -> ShowS
OpenIDConnectContext -> String
(Int -> OpenIDConnectContext -> ShowS)
-> (OpenIDConnectContext -> String)
-> ([OpenIDConnectContext] -> ShowS)
-> Show OpenIDConnectContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenIDConnectContext] -> ShowS
$cshowList :: [OpenIDConnectContext] -> ShowS
show :: OpenIDConnectContext -> String
$cshow :: OpenIDConnectContext -> String
showsPrec :: Int -> OpenIDConnectContext -> ShowS
$cshowsPrec :: Int -> OpenIDConnectContext -> ShowS
P.Show, OpenIDConnectContext -> OpenIDConnectContext -> Bool
(OpenIDConnectContext -> OpenIDConnectContext -> Bool)
-> (OpenIDConnectContext -> OpenIDConnectContext -> Bool)
-> Eq OpenIDConnectContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenIDConnectContext -> OpenIDConnectContext -> Bool
$c/= :: OpenIDConnectContext -> OpenIDConnectContext -> Bool
== :: OpenIDConnectContext -> OpenIDConnectContext -> Bool
$c== :: OpenIDConnectContext -> OpenIDConnectContext -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON OpenIDConnectContext
instance A.ToJSON OpenIDConnectContext where
  toJSON :: OpenIDConnectContext -> Value
toJSON OpenIDConnectContext {Maybe [Text]
Maybe Text
Maybe Value
openIDConnectContextUiLocales :: Maybe [Text]
openIDConnectContextLoginHint :: Maybe Text
openIDConnectContextIdTokenHintClaims :: Maybe Value
openIDConnectContextDisplay :: Maybe Text
openIDConnectContextAcrValues :: Maybe [Text]
openIDConnectContextUiLocales :: OpenIDConnectContext -> Maybe [Text]
openIDConnectContextLoginHint :: OpenIDConnectContext -> Maybe Text
openIDConnectContextIdTokenHintClaims :: OpenIDConnectContext -> Maybe Value
openIDConnectContextDisplay :: OpenIDConnectContext -> Maybe Text
openIDConnectContextAcrValues :: OpenIDConnectContext -> Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"acr_values" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
openIDConnectContextAcrValues
      , Key
"display" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openIDConnectContextDisplay
      , Key
"id_token_hint_claims" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
openIDConnectContextIdTokenHintClaims
      , Key
"login_hint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
openIDConnectContextLoginHint
      , Key
"ui_locales" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
openIDConnectContextUiLocales
      ]


-- | Construct a value of type 'OpenIDConnectContext' (by applying it's required fields, if any)
mkOpenIDConnectContext
  :: OpenIDConnectContext
mkOpenIDConnectContext :: OpenIDConnectContext
mkOpenIDConnectContext =
  OpenIDConnectContext :: Maybe [Text]
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe [Text]
-> OpenIDConnectContext
OpenIDConnectContext
  { openIDConnectContextAcrValues :: Maybe [Text]
openIDConnectContextAcrValues = Maybe [Text]
forall a. Maybe a
Nothing
  , openIDConnectContextDisplay :: Maybe Text
openIDConnectContextDisplay = Maybe Text
forall a. Maybe a
Nothing
  , openIDConnectContextIdTokenHintClaims :: Maybe Value
openIDConnectContextIdTokenHintClaims = Maybe Value
forall a. Maybe a
Nothing
  , openIDConnectContextLoginHint :: Maybe Text
openIDConnectContextLoginHint = Maybe Text
forall a. Maybe a
Nothing
  , openIDConnectContextUiLocales :: Maybe [Text]
openIDConnectContextUiLocales = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** PluginConfig
-- | PluginConfig
-- PluginConfig The config of a plugin.
-- 
data PluginConfig = PluginConfig
  { PluginConfig -> PluginConfigArgs
pluginConfigArgs :: PluginConfigArgs -- ^ /Required/ "Args"
  , PluginConfig -> Text
pluginConfigDescription :: Text -- ^ /Required/ "Description" - description
  , PluginConfig -> Maybe Text
pluginConfigDockerVersion :: Maybe Text -- ^ "DockerVersion" - Docker Version used to create the plugin
  , PluginConfig -> Text
pluginConfigDocumentation :: Text -- ^ /Required/ "Documentation" - documentation
  , PluginConfig -> [Text]
pluginConfigEntrypoint :: [Text] -- ^ /Required/ "Entrypoint" - entrypoint
  , PluginConfig -> [PluginEnv]
pluginConfigEnv :: [PluginEnv] -- ^ /Required/ "Env" - env
  , PluginConfig -> PluginConfigInterface
pluginConfigInterface :: PluginConfigInterface -- ^ /Required/ "Interface"
  , PluginConfig -> Bool
pluginConfigIpcHost :: Bool -- ^ /Required/ "IpcHost" - ipc host
  , PluginConfig -> PluginConfigLinux
pluginConfigLinux :: PluginConfigLinux -- ^ /Required/ "Linux"
  , PluginConfig -> [PluginMount]
pluginConfigMounts :: [PluginMount] -- ^ /Required/ "Mounts" - mounts
  , PluginConfig -> PluginConfigNetwork
pluginConfigNetwork :: PluginConfigNetwork -- ^ /Required/ "Network"
  , PluginConfig -> Bool
pluginConfigPidHost :: Bool -- ^ /Required/ "PidHost" - pid host
  , PluginConfig -> Text
pluginConfigPropagatedMount :: Text -- ^ /Required/ "PropagatedMount" - propagated mount
  , PluginConfig -> Maybe PluginConfigUser
pluginConfigUser :: Maybe PluginConfigUser -- ^ "User"
  , PluginConfig -> Text
pluginConfigWorkDir :: Text -- ^ /Required/ "WorkDir" - work dir
  , PluginConfig -> Maybe PluginConfigRootfs
pluginConfigRootfs :: Maybe PluginConfigRootfs -- ^ "rootfs"
  } deriving (Int -> PluginConfig -> ShowS
[PluginConfig] -> ShowS
PluginConfig -> String
(Int -> PluginConfig -> ShowS)
-> (PluginConfig -> String)
-> ([PluginConfig] -> ShowS)
-> Show PluginConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginConfig] -> ShowS
$cshowList :: [PluginConfig] -> ShowS
show :: PluginConfig -> String
$cshow :: PluginConfig -> String
showsPrec :: Int -> PluginConfig -> ShowS
$cshowsPrec :: Int -> PluginConfig -> ShowS
P.Show, PluginConfig -> PluginConfig -> Bool
(PluginConfig -> PluginConfig -> Bool)
-> (PluginConfig -> PluginConfig -> Bool) -> Eq PluginConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginConfig -> PluginConfig -> Bool
$c/= :: PluginConfig -> PluginConfig -> Bool
== :: PluginConfig -> PluginConfig -> Bool
$c== :: PluginConfig -> PluginConfig -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginConfig
instance A.FromJSON PluginConfig where
  parseJSON :: Value -> Parser PluginConfig
parseJSON = String
-> (Object -> Parser PluginConfig) -> Value -> Parser PluginConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginConfig" ((Object -> Parser PluginConfig) -> Value -> Parser PluginConfig)
-> (Object -> Parser PluginConfig) -> Value -> Parser PluginConfig
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    PluginConfigArgs
-> Text
-> Maybe Text
-> Text
-> [Text]
-> [PluginEnv]
-> PluginConfigInterface
-> Bool
-> PluginConfigLinux
-> [PluginMount]
-> PluginConfigNetwork
-> Bool
-> Text
-> Maybe PluginConfigUser
-> Text
-> Maybe PluginConfigRootfs
-> PluginConfig
PluginConfig
      (PluginConfigArgs
 -> Text
 -> Maybe Text
 -> Text
 -> [Text]
 -> [PluginEnv]
 -> PluginConfigInterface
 -> Bool
 -> PluginConfigLinux
 -> [PluginMount]
 -> PluginConfigNetwork
 -> Bool
 -> Text
 -> Maybe PluginConfigUser
 -> Text
 -> Maybe PluginConfigRootfs
 -> PluginConfig)
-> Parser PluginConfigArgs
-> Parser
     (Text
      -> Maybe Text
      -> Text
      -> [Text]
      -> [PluginEnv]
      -> PluginConfigInterface
      -> Bool
      -> PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser PluginConfigArgs
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Args")
      Parser
  (Text
   -> Maybe Text
   -> Text
   -> [Text]
   -> [PluginEnv]
   -> PluginConfigInterface
   -> Bool
   -> PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser Text
-> Parser
     (Maybe Text
      -> Text
      -> [Text]
      -> [PluginEnv]
      -> PluginConfigInterface
      -> Bool
      -> PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Description")
      Parser
  (Maybe Text
   -> Text
   -> [Text]
   -> [PluginEnv]
   -> PluginConfigInterface
   -> Bool
   -> PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> [Text]
      -> [PluginEnv]
      -> PluginConfigInterface
      -> Bool
      -> PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"DockerVersion")
      Parser
  (Text
   -> [Text]
   -> [PluginEnv]
   -> PluginConfigInterface
   -> Bool
   -> PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser Text
-> Parser
     ([Text]
      -> [PluginEnv]
      -> PluginConfigInterface
      -> Bool
      -> PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Documentation")
      Parser
  ([Text]
   -> [PluginEnv]
   -> PluginConfigInterface
   -> Bool
   -> PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser [Text]
-> Parser
     ([PluginEnv]
      -> PluginConfigInterface
      -> Bool
      -> PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Entrypoint")
      Parser
  ([PluginEnv]
   -> PluginConfigInterface
   -> Bool
   -> PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser [PluginEnv]
-> Parser
     (PluginConfigInterface
      -> Bool
      -> PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [PluginEnv]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Env")
      Parser
  (PluginConfigInterface
   -> Bool
   -> PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser PluginConfigInterface
-> Parser
     (Bool
      -> PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser PluginConfigInterface
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Interface")
      Parser
  (Bool
   -> PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser Bool
-> Parser
     (PluginConfigLinux
      -> [PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"IpcHost")
      Parser
  (PluginConfigLinux
   -> [PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser PluginConfigLinux
-> Parser
     ([PluginMount]
      -> PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser PluginConfigLinux
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Linux")
      Parser
  ([PluginMount]
   -> PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser [PluginMount]
-> Parser
     (PluginConfigNetwork
      -> Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [PluginMount]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Mounts")
      Parser
  (PluginConfigNetwork
   -> Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser PluginConfigNetwork
-> Parser
     (Bool
      -> Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser PluginConfigNetwork
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Network")
      Parser
  (Bool
   -> Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser Bool
-> Parser
     (Text
      -> Maybe PluginConfigUser
      -> Text
      -> Maybe PluginConfigRootfs
      -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"PidHost")
      Parser
  (Text
   -> Maybe PluginConfigUser
   -> Text
   -> Maybe PluginConfigRootfs
   -> PluginConfig)
-> Parser Text
-> Parser
     (Maybe PluginConfigUser
      -> Text -> Maybe PluginConfigRootfs -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"PropagatedMount")
      Parser
  (Maybe PluginConfigUser
   -> Text -> Maybe PluginConfigRootfs -> PluginConfig)
-> Parser (Maybe PluginConfigUser)
-> Parser (Text -> Maybe PluginConfigRootfs -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PluginConfigUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"User")
      Parser (Text -> Maybe PluginConfigRootfs -> PluginConfig)
-> Parser Text -> Parser (Maybe PluginConfigRootfs -> PluginConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"WorkDir")
      Parser (Maybe PluginConfigRootfs -> PluginConfig)
-> Parser (Maybe PluginConfigRootfs) -> Parser PluginConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PluginConfigRootfs)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rootfs")

-- | ToJSON PluginConfig
instance A.ToJSON PluginConfig where
  toJSON :: PluginConfig -> Value
toJSON PluginConfig {Bool
[Text]
[PluginMount]
[PluginEnv]
Maybe Text
Maybe PluginConfigUser
Maybe PluginConfigRootfs
Text
PluginConfigNetwork
PluginConfigLinux
PluginConfigInterface
PluginConfigArgs
pluginConfigRootfs :: Maybe PluginConfigRootfs
pluginConfigWorkDir :: Text
pluginConfigUser :: Maybe PluginConfigUser
pluginConfigPropagatedMount :: Text
pluginConfigPidHost :: Bool
pluginConfigNetwork :: PluginConfigNetwork
pluginConfigMounts :: [PluginMount]
pluginConfigLinux :: PluginConfigLinux
pluginConfigIpcHost :: Bool
pluginConfigInterface :: PluginConfigInterface
pluginConfigEnv :: [PluginEnv]
pluginConfigEntrypoint :: [Text]
pluginConfigDocumentation :: Text
pluginConfigDockerVersion :: Maybe Text
pluginConfigDescription :: Text
pluginConfigArgs :: PluginConfigArgs
pluginConfigRootfs :: PluginConfig -> Maybe PluginConfigRootfs
pluginConfigWorkDir :: PluginConfig -> Text
pluginConfigUser :: PluginConfig -> Maybe PluginConfigUser
pluginConfigPropagatedMount :: PluginConfig -> Text
pluginConfigPidHost :: PluginConfig -> Bool
pluginConfigNetwork :: PluginConfig -> PluginConfigNetwork
pluginConfigMounts :: PluginConfig -> [PluginMount]
pluginConfigLinux :: PluginConfig -> PluginConfigLinux
pluginConfigIpcHost :: PluginConfig -> Bool
pluginConfigInterface :: PluginConfig -> PluginConfigInterface
pluginConfigEnv :: PluginConfig -> [PluginEnv]
pluginConfigEntrypoint :: PluginConfig -> [Text]
pluginConfigDocumentation :: PluginConfig -> Text
pluginConfigDockerVersion :: PluginConfig -> Maybe Text
pluginConfigDescription :: PluginConfig -> Text
pluginConfigArgs :: PluginConfig -> PluginConfigArgs
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Args" Key -> PluginConfigArgs -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PluginConfigArgs
pluginConfigArgs
      , Key
"Description" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginConfigDescription
      , Key
"DockerVersion" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
pluginConfigDockerVersion
      , Key
"Documentation" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginConfigDocumentation
      , Key
"Entrypoint" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginConfigEntrypoint
      , Key
"Env" Key -> [PluginEnv] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PluginEnv]
pluginConfigEnv
      , Key
"Interface" Key -> PluginConfigInterface -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PluginConfigInterface
pluginConfigInterface
      , Key
"IpcHost" Key -> Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
pluginConfigIpcHost
      , Key
"Linux" Key -> PluginConfigLinux -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PluginConfigLinux
pluginConfigLinux
      , Key
"Mounts" Key -> [PluginMount] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PluginMount]
pluginConfigMounts
      , Key
"Network" Key -> PluginConfigNetwork -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PluginConfigNetwork
pluginConfigNetwork
      , Key
"PidHost" Key -> Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
pluginConfigPidHost
      , Key
"PropagatedMount" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginConfigPropagatedMount
      , Key
"User" Key -> Maybe PluginConfigUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe PluginConfigUser
pluginConfigUser
      , Key
"WorkDir" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginConfigWorkDir
      , Key
"rootfs" Key -> Maybe PluginConfigRootfs -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe PluginConfigRootfs
pluginConfigRootfs
      ]


-- | Construct a value of type 'PluginConfig' (by applying it's required fields, if any)
mkPluginConfig
  :: PluginConfigArgs -- ^ 'pluginConfigArgs' 
  -> Text -- ^ 'pluginConfigDescription': description
  -> Text -- ^ 'pluginConfigDocumentation': documentation
  -> [Text] -- ^ 'pluginConfigEntrypoint': entrypoint
  -> [PluginEnv] -- ^ 'pluginConfigEnv': env
  -> PluginConfigInterface -- ^ 'pluginConfigInterface' 
  -> Bool -- ^ 'pluginConfigIpcHost': ipc host
  -> PluginConfigLinux -- ^ 'pluginConfigLinux' 
  -> [PluginMount] -- ^ 'pluginConfigMounts': mounts
  -> PluginConfigNetwork -- ^ 'pluginConfigNetwork' 
  -> Bool -- ^ 'pluginConfigPidHost': pid host
  -> Text -- ^ 'pluginConfigPropagatedMount': propagated mount
  -> Text -- ^ 'pluginConfigWorkDir': work dir
  -> PluginConfig
mkPluginConfig :: PluginConfigArgs
-> Text
-> Text
-> [Text]
-> [PluginEnv]
-> PluginConfigInterface
-> Bool
-> PluginConfigLinux
-> [PluginMount]
-> PluginConfigNetwork
-> Bool
-> Text
-> Text
-> PluginConfig
mkPluginConfig PluginConfigArgs
pluginConfigArgs Text
pluginConfigDescription Text
pluginConfigDocumentation [Text]
pluginConfigEntrypoint [PluginEnv]
pluginConfigEnv PluginConfigInterface
pluginConfigInterface Bool
pluginConfigIpcHost PluginConfigLinux
pluginConfigLinux [PluginMount]
pluginConfigMounts PluginConfigNetwork
pluginConfigNetwork Bool
pluginConfigPidHost Text
pluginConfigPropagatedMount Text
pluginConfigWorkDir =
  PluginConfig :: PluginConfigArgs
-> Text
-> Maybe Text
-> Text
-> [Text]
-> [PluginEnv]
-> PluginConfigInterface
-> Bool
-> PluginConfigLinux
-> [PluginMount]
-> PluginConfigNetwork
-> Bool
-> Text
-> Maybe PluginConfigUser
-> Text
-> Maybe PluginConfigRootfs
-> PluginConfig
PluginConfig
  { PluginConfigArgs
pluginConfigArgs :: PluginConfigArgs
pluginConfigArgs :: PluginConfigArgs
pluginConfigArgs
  , Text
pluginConfigDescription :: Text
pluginConfigDescription :: Text
pluginConfigDescription
  , pluginConfigDockerVersion :: Maybe Text
pluginConfigDockerVersion = Maybe Text
forall a. Maybe a
Nothing
  , Text
pluginConfigDocumentation :: Text
pluginConfigDocumentation :: Text
pluginConfigDocumentation
  , [Text]
pluginConfigEntrypoint :: [Text]
pluginConfigEntrypoint :: [Text]
pluginConfigEntrypoint
  , [PluginEnv]
pluginConfigEnv :: [PluginEnv]
pluginConfigEnv :: [PluginEnv]
pluginConfigEnv
  , PluginConfigInterface
pluginConfigInterface :: PluginConfigInterface
pluginConfigInterface :: PluginConfigInterface
pluginConfigInterface
  , Bool
pluginConfigIpcHost :: Bool
pluginConfigIpcHost :: Bool
pluginConfigIpcHost
  , PluginConfigLinux
pluginConfigLinux :: PluginConfigLinux
pluginConfigLinux :: PluginConfigLinux
pluginConfigLinux
  , [PluginMount]
pluginConfigMounts :: [PluginMount]
pluginConfigMounts :: [PluginMount]
pluginConfigMounts
  , PluginConfigNetwork
pluginConfigNetwork :: PluginConfigNetwork
pluginConfigNetwork :: PluginConfigNetwork
pluginConfigNetwork
  , Bool
pluginConfigPidHost :: Bool
pluginConfigPidHost :: Bool
pluginConfigPidHost
  , Text
pluginConfigPropagatedMount :: Text
pluginConfigPropagatedMount :: Text
pluginConfigPropagatedMount
  , pluginConfigUser :: Maybe PluginConfigUser
pluginConfigUser = Maybe PluginConfigUser
forall a. Maybe a
Nothing
  , Text
pluginConfigWorkDir :: Text
pluginConfigWorkDir :: Text
pluginConfigWorkDir
  , pluginConfigRootfs :: Maybe PluginConfigRootfs
pluginConfigRootfs = Maybe PluginConfigRootfs
forall a. Maybe a
Nothing
  }

-- ** PluginConfigArgs
-- | PluginConfigArgs
-- PluginConfigArgs plugin config args
data PluginConfigArgs = PluginConfigArgs
  { PluginConfigArgs -> Text
pluginConfigArgsDescription :: Text -- ^ /Required/ "Description" - description
  , PluginConfigArgs -> Text
pluginConfigArgsName :: Text -- ^ /Required/ "Name" - name
  , PluginConfigArgs -> [Text]
pluginConfigArgsSettable :: [Text] -- ^ /Required/ "Settable" - settable
  , PluginConfigArgs -> [Text]
pluginConfigArgsValue :: [Text] -- ^ /Required/ "Value" - value
  } deriving (Int -> PluginConfigArgs -> ShowS
[PluginConfigArgs] -> ShowS
PluginConfigArgs -> String
(Int -> PluginConfigArgs -> ShowS)
-> (PluginConfigArgs -> String)
-> ([PluginConfigArgs] -> ShowS)
-> Show PluginConfigArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginConfigArgs] -> ShowS
$cshowList :: [PluginConfigArgs] -> ShowS
show :: PluginConfigArgs -> String
$cshow :: PluginConfigArgs -> String
showsPrec :: Int -> PluginConfigArgs -> ShowS
$cshowsPrec :: Int -> PluginConfigArgs -> ShowS
P.Show, PluginConfigArgs -> PluginConfigArgs -> Bool
(PluginConfigArgs -> PluginConfigArgs -> Bool)
-> (PluginConfigArgs -> PluginConfigArgs -> Bool)
-> Eq PluginConfigArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginConfigArgs -> PluginConfigArgs -> Bool
$c/= :: PluginConfigArgs -> PluginConfigArgs -> Bool
== :: PluginConfigArgs -> PluginConfigArgs -> Bool
$c== :: PluginConfigArgs -> PluginConfigArgs -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginConfigArgs
instance A.FromJSON PluginConfigArgs where
  parseJSON :: Value -> Parser PluginConfigArgs
parseJSON = String
-> (Object -> Parser PluginConfigArgs)
-> Value
-> Parser PluginConfigArgs
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginConfigArgs" ((Object -> Parser PluginConfigArgs)
 -> Value -> Parser PluginConfigArgs)
-> (Object -> Parser PluginConfigArgs)
-> Value
-> Parser PluginConfigArgs
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> [Text] -> [Text] -> PluginConfigArgs
PluginConfigArgs
      (Text -> Text -> [Text] -> [Text] -> PluginConfigArgs)
-> Parser Text
-> Parser (Text -> [Text] -> [Text] -> PluginConfigArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Description")
      Parser (Text -> [Text] -> [Text] -> PluginConfigArgs)
-> Parser Text -> Parser ([Text] -> [Text] -> PluginConfigArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Name")
      Parser ([Text] -> [Text] -> PluginConfigArgs)
-> Parser [Text] -> Parser ([Text] -> PluginConfigArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Settable")
      Parser ([Text] -> PluginConfigArgs)
-> Parser [Text] -> Parser PluginConfigArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Value")

-- | ToJSON PluginConfigArgs
instance A.ToJSON PluginConfigArgs where
  toJSON :: PluginConfigArgs -> Value
toJSON PluginConfigArgs {[Text]
Text
pluginConfigArgsValue :: [Text]
pluginConfigArgsSettable :: [Text]
pluginConfigArgsName :: Text
pluginConfigArgsDescription :: Text
pluginConfigArgsValue :: PluginConfigArgs -> [Text]
pluginConfigArgsSettable :: PluginConfigArgs -> [Text]
pluginConfigArgsName :: PluginConfigArgs -> Text
pluginConfigArgsDescription :: PluginConfigArgs -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Description" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginConfigArgsDescription
      , Key
"Name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginConfigArgsName
      , Key
"Settable" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginConfigArgsSettable
      , Key
"Value" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginConfigArgsValue
      ]


-- | Construct a value of type 'PluginConfigArgs' (by applying it's required fields, if any)
mkPluginConfigArgs
  :: Text -- ^ 'pluginConfigArgsDescription': description
  -> Text -- ^ 'pluginConfigArgsName': name
  -> [Text] -- ^ 'pluginConfigArgsSettable': settable
  -> [Text] -- ^ 'pluginConfigArgsValue': value
  -> PluginConfigArgs
mkPluginConfigArgs :: Text -> Text -> [Text] -> [Text] -> PluginConfigArgs
mkPluginConfigArgs Text
pluginConfigArgsDescription Text
pluginConfigArgsName [Text]
pluginConfigArgsSettable [Text]
pluginConfigArgsValue =
  PluginConfigArgs :: Text -> Text -> [Text] -> [Text] -> PluginConfigArgs
PluginConfigArgs
  { Text
pluginConfigArgsDescription :: Text
pluginConfigArgsDescription :: Text
pluginConfigArgsDescription
  , Text
pluginConfigArgsName :: Text
pluginConfigArgsName :: Text
pluginConfigArgsName
  , [Text]
pluginConfigArgsSettable :: [Text]
pluginConfigArgsSettable :: [Text]
pluginConfigArgsSettable
  , [Text]
pluginConfigArgsValue :: [Text]
pluginConfigArgsValue :: [Text]
pluginConfigArgsValue
  }

-- ** PluginConfigInterface
-- | PluginConfigInterface
-- PluginConfigInterface The interface between Docker and the plugin
data PluginConfigInterface = PluginConfigInterface
  { PluginConfigInterface -> Maybe Text
pluginConfigInterfaceProtocolScheme :: Maybe Text -- ^ "ProtocolScheme" - Protocol to use for clients connecting to the plugin.
  , PluginConfigInterface -> Text
pluginConfigInterfaceSocket :: Text -- ^ /Required/ "Socket" - socket
  , PluginConfigInterface -> [PluginInterfaceType]
pluginConfigInterfaceTypes :: [PluginInterfaceType] -- ^ /Required/ "Types" - types
  } deriving (Int -> PluginConfigInterface -> ShowS
[PluginConfigInterface] -> ShowS
PluginConfigInterface -> String
(Int -> PluginConfigInterface -> ShowS)
-> (PluginConfigInterface -> String)
-> ([PluginConfigInterface] -> ShowS)
-> Show PluginConfigInterface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginConfigInterface] -> ShowS
$cshowList :: [PluginConfigInterface] -> ShowS
show :: PluginConfigInterface -> String
$cshow :: PluginConfigInterface -> String
showsPrec :: Int -> PluginConfigInterface -> ShowS
$cshowsPrec :: Int -> PluginConfigInterface -> ShowS
P.Show, PluginConfigInterface -> PluginConfigInterface -> Bool
(PluginConfigInterface -> PluginConfigInterface -> Bool)
-> (PluginConfigInterface -> PluginConfigInterface -> Bool)
-> Eq PluginConfigInterface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginConfigInterface -> PluginConfigInterface -> Bool
$c/= :: PluginConfigInterface -> PluginConfigInterface -> Bool
== :: PluginConfigInterface -> PluginConfigInterface -> Bool
$c== :: PluginConfigInterface -> PluginConfigInterface -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginConfigInterface
instance A.FromJSON PluginConfigInterface where
  parseJSON :: Value -> Parser PluginConfigInterface
parseJSON = String
-> (Object -> Parser PluginConfigInterface)
-> Value
-> Parser PluginConfigInterface
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginConfigInterface" ((Object -> Parser PluginConfigInterface)
 -> Value -> Parser PluginConfigInterface)
-> (Object -> Parser PluginConfigInterface)
-> Value
-> Parser PluginConfigInterface
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Text -> [PluginInterfaceType] -> PluginConfigInterface
PluginConfigInterface
      (Maybe Text
 -> Text -> [PluginInterfaceType] -> PluginConfigInterface)
-> Parser (Maybe Text)
-> Parser (Text -> [PluginInterfaceType] -> PluginConfigInterface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ProtocolScheme")
      Parser (Text -> [PluginInterfaceType] -> PluginConfigInterface)
-> Parser Text
-> Parser ([PluginInterfaceType] -> PluginConfigInterface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Socket")
      Parser ([PluginInterfaceType] -> PluginConfigInterface)
-> Parser [PluginInterfaceType] -> Parser PluginConfigInterface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [PluginInterfaceType]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Types")

-- | ToJSON PluginConfigInterface
instance A.ToJSON PluginConfigInterface where
  toJSON :: PluginConfigInterface -> Value
toJSON PluginConfigInterface {[PluginInterfaceType]
Maybe Text
Text
pluginConfigInterfaceTypes :: [PluginInterfaceType]
pluginConfigInterfaceSocket :: Text
pluginConfigInterfaceProtocolScheme :: Maybe Text
pluginConfigInterfaceTypes :: PluginConfigInterface -> [PluginInterfaceType]
pluginConfigInterfaceSocket :: PluginConfigInterface -> Text
pluginConfigInterfaceProtocolScheme :: PluginConfigInterface -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"ProtocolScheme" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
pluginConfigInterfaceProtocolScheme
      , Key
"Socket" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginConfigInterfaceSocket
      , Key
"Types" Key -> [PluginInterfaceType] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PluginInterfaceType]
pluginConfigInterfaceTypes
      ]


-- | Construct a value of type 'PluginConfigInterface' (by applying it's required fields, if any)
mkPluginConfigInterface
  :: Text -- ^ 'pluginConfigInterfaceSocket': socket
  -> [PluginInterfaceType] -- ^ 'pluginConfigInterfaceTypes': types
  -> PluginConfigInterface
mkPluginConfigInterface :: Text -> [PluginInterfaceType] -> PluginConfigInterface
mkPluginConfigInterface Text
pluginConfigInterfaceSocket [PluginInterfaceType]
pluginConfigInterfaceTypes =
  PluginConfigInterface :: Maybe Text
-> Text -> [PluginInterfaceType] -> PluginConfigInterface
PluginConfigInterface
  { pluginConfigInterfaceProtocolScheme :: Maybe Text
pluginConfigInterfaceProtocolScheme = Maybe Text
forall a. Maybe a
Nothing
  , Text
pluginConfigInterfaceSocket :: Text
pluginConfigInterfaceSocket :: Text
pluginConfigInterfaceSocket
  , [PluginInterfaceType]
pluginConfigInterfaceTypes :: [PluginInterfaceType]
pluginConfigInterfaceTypes :: [PluginInterfaceType]
pluginConfigInterfaceTypes
  }

-- ** PluginConfigLinux
-- | PluginConfigLinux
-- PluginConfigLinux plugin config linux
data PluginConfigLinux = PluginConfigLinux
  { PluginConfigLinux -> Bool
pluginConfigLinuxAllowAllDevices :: Bool -- ^ /Required/ "AllowAllDevices" - allow all devices
  , PluginConfigLinux -> [Text]
pluginConfigLinuxCapabilities :: [Text] -- ^ /Required/ "Capabilities" - capabilities
  , PluginConfigLinux -> [PluginDevice]
pluginConfigLinuxDevices :: [PluginDevice] -- ^ /Required/ "Devices" - devices
  } deriving (Int -> PluginConfigLinux -> ShowS
[PluginConfigLinux] -> ShowS
PluginConfigLinux -> String
(Int -> PluginConfigLinux -> ShowS)
-> (PluginConfigLinux -> String)
-> ([PluginConfigLinux] -> ShowS)
-> Show PluginConfigLinux
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginConfigLinux] -> ShowS
$cshowList :: [PluginConfigLinux] -> ShowS
show :: PluginConfigLinux -> String
$cshow :: PluginConfigLinux -> String
showsPrec :: Int -> PluginConfigLinux -> ShowS
$cshowsPrec :: Int -> PluginConfigLinux -> ShowS
P.Show, PluginConfigLinux -> PluginConfigLinux -> Bool
(PluginConfigLinux -> PluginConfigLinux -> Bool)
-> (PluginConfigLinux -> PluginConfigLinux -> Bool)
-> Eq PluginConfigLinux
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginConfigLinux -> PluginConfigLinux -> Bool
$c/= :: PluginConfigLinux -> PluginConfigLinux -> Bool
== :: PluginConfigLinux -> PluginConfigLinux -> Bool
$c== :: PluginConfigLinux -> PluginConfigLinux -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginConfigLinux
instance A.FromJSON PluginConfigLinux where
  parseJSON :: Value -> Parser PluginConfigLinux
parseJSON = String
-> (Object -> Parser PluginConfigLinux)
-> Value
-> Parser PluginConfigLinux
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginConfigLinux" ((Object -> Parser PluginConfigLinux)
 -> Value -> Parser PluginConfigLinux)
-> (Object -> Parser PluginConfigLinux)
-> Value
-> Parser PluginConfigLinux
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool -> [Text] -> [PluginDevice] -> PluginConfigLinux
PluginConfigLinux
      (Bool -> [Text] -> [PluginDevice] -> PluginConfigLinux)
-> Parser Bool
-> Parser ([Text] -> [PluginDevice] -> PluginConfigLinux)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"AllowAllDevices")
      Parser ([Text] -> [PluginDevice] -> PluginConfigLinux)
-> Parser [Text] -> Parser ([PluginDevice] -> PluginConfigLinux)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Capabilities")
      Parser ([PluginDevice] -> PluginConfigLinux)
-> Parser [PluginDevice] -> Parser PluginConfigLinux
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [PluginDevice]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Devices")

-- | ToJSON PluginConfigLinux
instance A.ToJSON PluginConfigLinux where
  toJSON :: PluginConfigLinux -> Value
toJSON PluginConfigLinux {Bool
[Text]
[PluginDevice]
pluginConfigLinuxDevices :: [PluginDevice]
pluginConfigLinuxCapabilities :: [Text]
pluginConfigLinuxAllowAllDevices :: Bool
pluginConfigLinuxDevices :: PluginConfigLinux -> [PluginDevice]
pluginConfigLinuxCapabilities :: PluginConfigLinux -> [Text]
pluginConfigLinuxAllowAllDevices :: PluginConfigLinux -> Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"AllowAllDevices" Key -> Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
pluginConfigLinuxAllowAllDevices
      , Key
"Capabilities" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginConfigLinuxCapabilities
      , Key
"Devices" Key -> [PluginDevice] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PluginDevice]
pluginConfigLinuxDevices
      ]


-- | Construct a value of type 'PluginConfigLinux' (by applying it's required fields, if any)
mkPluginConfigLinux
  :: Bool -- ^ 'pluginConfigLinuxAllowAllDevices': allow all devices
  -> [Text] -- ^ 'pluginConfigLinuxCapabilities': capabilities
  -> [PluginDevice] -- ^ 'pluginConfigLinuxDevices': devices
  -> PluginConfigLinux
mkPluginConfigLinux :: Bool -> [Text] -> [PluginDevice] -> PluginConfigLinux
mkPluginConfigLinux Bool
pluginConfigLinuxAllowAllDevices [Text]
pluginConfigLinuxCapabilities [PluginDevice]
pluginConfigLinuxDevices =
  PluginConfigLinux :: Bool -> [Text] -> [PluginDevice] -> PluginConfigLinux
PluginConfigLinux
  { Bool
pluginConfigLinuxAllowAllDevices :: Bool
pluginConfigLinuxAllowAllDevices :: Bool
pluginConfigLinuxAllowAllDevices
  , [Text]
pluginConfigLinuxCapabilities :: [Text]
pluginConfigLinuxCapabilities :: [Text]
pluginConfigLinuxCapabilities
  , [PluginDevice]
pluginConfigLinuxDevices :: [PluginDevice]
pluginConfigLinuxDevices :: [PluginDevice]
pluginConfigLinuxDevices
  }

-- ** PluginConfigNetwork
-- | PluginConfigNetwork
-- PluginConfigNetwork plugin config network
data PluginConfigNetwork = PluginConfigNetwork
  { PluginConfigNetwork -> Text
pluginConfigNetworkType :: Text -- ^ /Required/ "Type" - type
  } deriving (Int -> PluginConfigNetwork -> ShowS
[PluginConfigNetwork] -> ShowS
PluginConfigNetwork -> String
(Int -> PluginConfigNetwork -> ShowS)
-> (PluginConfigNetwork -> String)
-> ([PluginConfigNetwork] -> ShowS)
-> Show PluginConfigNetwork
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginConfigNetwork] -> ShowS
$cshowList :: [PluginConfigNetwork] -> ShowS
show :: PluginConfigNetwork -> String
$cshow :: PluginConfigNetwork -> String
showsPrec :: Int -> PluginConfigNetwork -> ShowS
$cshowsPrec :: Int -> PluginConfigNetwork -> ShowS
P.Show, PluginConfigNetwork -> PluginConfigNetwork -> Bool
(PluginConfigNetwork -> PluginConfigNetwork -> Bool)
-> (PluginConfigNetwork -> PluginConfigNetwork -> Bool)
-> Eq PluginConfigNetwork
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginConfigNetwork -> PluginConfigNetwork -> Bool
$c/= :: PluginConfigNetwork -> PluginConfigNetwork -> Bool
== :: PluginConfigNetwork -> PluginConfigNetwork -> Bool
$c== :: PluginConfigNetwork -> PluginConfigNetwork -> Bool
P.Eq, P.Typeable)

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

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


-- | Construct a value of type 'PluginConfigNetwork' (by applying it's required fields, if any)
mkPluginConfigNetwork
  :: Text -- ^ 'pluginConfigNetworkType': type
  -> PluginConfigNetwork
mkPluginConfigNetwork :: Text -> PluginConfigNetwork
mkPluginConfigNetwork Text
pluginConfigNetworkType =
  PluginConfigNetwork :: Text -> PluginConfigNetwork
PluginConfigNetwork
  { Text
pluginConfigNetworkType :: Text
pluginConfigNetworkType :: Text
pluginConfigNetworkType
  }

-- ** PluginConfigRootfs
-- | PluginConfigRootfs
-- PluginConfigRootfs plugin config rootfs
data PluginConfigRootfs = PluginConfigRootfs
  { PluginConfigRootfs -> Maybe [Text]
pluginConfigRootfsDiffIds :: Maybe [Text] -- ^ "diff_ids" - diff ids
  , PluginConfigRootfs -> Maybe Text
pluginConfigRootfsType :: Maybe Text -- ^ "type" - type
  } deriving (Int -> PluginConfigRootfs -> ShowS
[PluginConfigRootfs] -> ShowS
PluginConfigRootfs -> String
(Int -> PluginConfigRootfs -> ShowS)
-> (PluginConfigRootfs -> String)
-> ([PluginConfigRootfs] -> ShowS)
-> Show PluginConfigRootfs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginConfigRootfs] -> ShowS
$cshowList :: [PluginConfigRootfs] -> ShowS
show :: PluginConfigRootfs -> String
$cshow :: PluginConfigRootfs -> String
showsPrec :: Int -> PluginConfigRootfs -> ShowS
$cshowsPrec :: Int -> PluginConfigRootfs -> ShowS
P.Show, PluginConfigRootfs -> PluginConfigRootfs -> Bool
(PluginConfigRootfs -> PluginConfigRootfs -> Bool)
-> (PluginConfigRootfs -> PluginConfigRootfs -> Bool)
-> Eq PluginConfigRootfs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginConfigRootfs -> PluginConfigRootfs -> Bool
$c/= :: PluginConfigRootfs -> PluginConfigRootfs -> Bool
== :: PluginConfigRootfs -> PluginConfigRootfs -> Bool
$c== :: PluginConfigRootfs -> PluginConfigRootfs -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON PluginConfigRootfs
instance A.ToJSON PluginConfigRootfs where
  toJSON :: PluginConfigRootfs -> Value
toJSON PluginConfigRootfs {Maybe [Text]
Maybe Text
pluginConfigRootfsType :: Maybe Text
pluginConfigRootfsDiffIds :: Maybe [Text]
pluginConfigRootfsType :: PluginConfigRootfs -> Maybe Text
pluginConfigRootfsDiffIds :: PluginConfigRootfs -> Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"diff_ids" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
pluginConfigRootfsDiffIds
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
pluginConfigRootfsType
      ]


-- | Construct a value of type 'PluginConfigRootfs' (by applying it's required fields, if any)
mkPluginConfigRootfs
  :: PluginConfigRootfs
mkPluginConfigRootfs :: PluginConfigRootfs
mkPluginConfigRootfs =
  PluginConfigRootfs :: Maybe [Text] -> Maybe Text -> PluginConfigRootfs
PluginConfigRootfs
  { pluginConfigRootfsDiffIds :: Maybe [Text]
pluginConfigRootfsDiffIds = Maybe [Text]
forall a. Maybe a
Nothing
  , pluginConfigRootfsType :: Maybe Text
pluginConfigRootfsType = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** PluginConfigUser
-- | PluginConfigUser
-- PluginConfigUser plugin config user
data PluginConfigUser = PluginConfigUser
  { PluginConfigUser -> Maybe Int
pluginConfigUserGid :: Maybe Int -- ^ "GID" - g ID
  , PluginConfigUser -> Maybe Int
pluginConfigUserUid :: Maybe Int -- ^ "UID" - UID
  } deriving (Int -> PluginConfigUser -> ShowS
[PluginConfigUser] -> ShowS
PluginConfigUser -> String
(Int -> PluginConfigUser -> ShowS)
-> (PluginConfigUser -> String)
-> ([PluginConfigUser] -> ShowS)
-> Show PluginConfigUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginConfigUser] -> ShowS
$cshowList :: [PluginConfigUser] -> ShowS
show :: PluginConfigUser -> String
$cshow :: PluginConfigUser -> String
showsPrec :: Int -> PluginConfigUser -> ShowS
$cshowsPrec :: Int -> PluginConfigUser -> ShowS
P.Show, PluginConfigUser -> PluginConfigUser -> Bool
(PluginConfigUser -> PluginConfigUser -> Bool)
-> (PluginConfigUser -> PluginConfigUser -> Bool)
-> Eq PluginConfigUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginConfigUser -> PluginConfigUser -> Bool
$c/= :: PluginConfigUser -> PluginConfigUser -> Bool
== :: PluginConfigUser -> PluginConfigUser -> Bool
$c== :: PluginConfigUser -> PluginConfigUser -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON PluginConfigUser
instance A.ToJSON PluginConfigUser where
  toJSON :: PluginConfigUser -> Value
toJSON PluginConfigUser {Maybe Int
pluginConfigUserUid :: Maybe Int
pluginConfigUserGid :: Maybe Int
pluginConfigUserUid :: PluginConfigUser -> Maybe Int
pluginConfigUserGid :: PluginConfigUser -> Maybe Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"GID" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
pluginConfigUserGid
      , Key
"UID" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
pluginConfigUserUid
      ]


-- | Construct a value of type 'PluginConfigUser' (by applying it's required fields, if any)
mkPluginConfigUser
  :: PluginConfigUser
mkPluginConfigUser :: PluginConfigUser
mkPluginConfigUser =
  PluginConfigUser :: Maybe Int -> Maybe Int -> PluginConfigUser
PluginConfigUser
  { pluginConfigUserGid :: Maybe Int
pluginConfigUserGid = Maybe Int
forall a. Maybe a
Nothing
  , pluginConfigUserUid :: Maybe Int
pluginConfigUserUid = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** PluginDevice
-- | PluginDevice
-- PluginDevice plugin device
data PluginDevice = PluginDevice
  { PluginDevice -> Text
pluginDeviceDescription :: Text -- ^ /Required/ "Description" - description
  , PluginDevice -> Text
pluginDeviceName :: Text -- ^ /Required/ "Name" - name
  , PluginDevice -> Text
pluginDevicePath :: Text -- ^ /Required/ "Path" - path
  , PluginDevice -> [Text]
pluginDeviceSettable :: [Text] -- ^ /Required/ "Settable" - settable
  } deriving (Int -> PluginDevice -> ShowS
[PluginDevice] -> ShowS
PluginDevice -> String
(Int -> PluginDevice -> ShowS)
-> (PluginDevice -> String)
-> ([PluginDevice] -> ShowS)
-> Show PluginDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginDevice] -> ShowS
$cshowList :: [PluginDevice] -> ShowS
show :: PluginDevice -> String
$cshow :: PluginDevice -> String
showsPrec :: Int -> PluginDevice -> ShowS
$cshowsPrec :: Int -> PluginDevice -> ShowS
P.Show, PluginDevice -> PluginDevice -> Bool
(PluginDevice -> PluginDevice -> Bool)
-> (PluginDevice -> PluginDevice -> Bool) -> Eq PluginDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginDevice -> PluginDevice -> Bool
$c/= :: PluginDevice -> PluginDevice -> Bool
== :: PluginDevice -> PluginDevice -> Bool
$c== :: PluginDevice -> PluginDevice -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginDevice
instance A.FromJSON PluginDevice where
  parseJSON :: Value -> Parser PluginDevice
parseJSON = String
-> (Object -> Parser PluginDevice) -> Value -> Parser PluginDevice
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginDevice" ((Object -> Parser PluginDevice) -> Value -> Parser PluginDevice)
-> (Object -> Parser PluginDevice) -> Value -> Parser PluginDevice
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Text -> [Text] -> PluginDevice
PluginDevice
      (Text -> Text -> Text -> [Text] -> PluginDevice)
-> Parser Text -> Parser (Text -> Text -> [Text] -> PluginDevice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Description")
      Parser (Text -> Text -> [Text] -> PluginDevice)
-> Parser Text -> Parser (Text -> [Text] -> PluginDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Name")
      Parser (Text -> [Text] -> PluginDevice)
-> Parser Text -> Parser ([Text] -> PluginDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Path")
      Parser ([Text] -> PluginDevice)
-> Parser [Text] -> Parser PluginDevice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Settable")

-- | ToJSON PluginDevice
instance A.ToJSON PluginDevice where
  toJSON :: PluginDevice -> Value
toJSON PluginDevice {[Text]
Text
pluginDeviceSettable :: [Text]
pluginDevicePath :: Text
pluginDeviceName :: Text
pluginDeviceDescription :: Text
pluginDeviceSettable :: PluginDevice -> [Text]
pluginDevicePath :: PluginDevice -> Text
pluginDeviceName :: PluginDevice -> Text
pluginDeviceDescription :: PluginDevice -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Description" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginDeviceDescription
      , Key
"Name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginDeviceName
      , Key
"Path" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginDevicePath
      , Key
"Settable" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginDeviceSettable
      ]


-- | Construct a value of type 'PluginDevice' (by applying it's required fields, if any)
mkPluginDevice
  :: Text -- ^ 'pluginDeviceDescription': description
  -> Text -- ^ 'pluginDeviceName': name
  -> Text -- ^ 'pluginDevicePath': path
  -> [Text] -- ^ 'pluginDeviceSettable': settable
  -> PluginDevice
mkPluginDevice :: Text -> Text -> Text -> [Text] -> PluginDevice
mkPluginDevice Text
pluginDeviceDescription Text
pluginDeviceName Text
pluginDevicePath [Text]
pluginDeviceSettable =
  PluginDevice :: Text -> Text -> Text -> [Text] -> PluginDevice
PluginDevice
  { Text
pluginDeviceDescription :: Text
pluginDeviceDescription :: Text
pluginDeviceDescription
  , Text
pluginDeviceName :: Text
pluginDeviceName :: Text
pluginDeviceName
  , Text
pluginDevicePath :: Text
pluginDevicePath :: Text
pluginDevicePath
  , [Text]
pluginDeviceSettable :: [Text]
pluginDeviceSettable :: [Text]
pluginDeviceSettable
  }

-- ** PluginEnv
-- | PluginEnv
-- PluginEnv plugin env
data PluginEnv = PluginEnv
  { PluginEnv -> Text
pluginEnvDescription :: Text -- ^ /Required/ "Description" - description
  , PluginEnv -> Text
pluginEnvName :: Text -- ^ /Required/ "Name" - name
  , PluginEnv -> [Text]
pluginEnvSettable :: [Text] -- ^ /Required/ "Settable" - settable
  , PluginEnv -> Text
pluginEnvValue :: Text -- ^ /Required/ "Value" - value
  } deriving (Int -> PluginEnv -> ShowS
[PluginEnv] -> ShowS
PluginEnv -> String
(Int -> PluginEnv -> ShowS)
-> (PluginEnv -> String)
-> ([PluginEnv] -> ShowS)
-> Show PluginEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginEnv] -> ShowS
$cshowList :: [PluginEnv] -> ShowS
show :: PluginEnv -> String
$cshow :: PluginEnv -> String
showsPrec :: Int -> PluginEnv -> ShowS
$cshowsPrec :: Int -> PluginEnv -> ShowS
P.Show, PluginEnv -> PluginEnv -> Bool
(PluginEnv -> PluginEnv -> Bool)
-> (PluginEnv -> PluginEnv -> Bool) -> Eq PluginEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginEnv -> PluginEnv -> Bool
$c/= :: PluginEnv -> PluginEnv -> Bool
== :: PluginEnv -> PluginEnv -> Bool
$c== :: PluginEnv -> PluginEnv -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginEnv
instance A.FromJSON PluginEnv where
  parseJSON :: Value -> Parser PluginEnv
parseJSON = String -> (Object -> Parser PluginEnv) -> Value -> Parser PluginEnv
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginEnv" ((Object -> Parser PluginEnv) -> Value -> Parser PluginEnv)
-> (Object -> Parser PluginEnv) -> Value -> Parser PluginEnv
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> [Text] -> Text -> PluginEnv
PluginEnv
      (Text -> Text -> [Text] -> Text -> PluginEnv)
-> Parser Text -> Parser (Text -> [Text] -> Text -> PluginEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Description")
      Parser (Text -> [Text] -> Text -> PluginEnv)
-> Parser Text -> Parser ([Text] -> Text -> PluginEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Name")
      Parser ([Text] -> Text -> PluginEnv)
-> Parser [Text] -> Parser (Text -> PluginEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Settable")
      Parser (Text -> PluginEnv) -> Parser Text -> Parser PluginEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Value")

-- | ToJSON PluginEnv
instance A.ToJSON PluginEnv where
  toJSON :: PluginEnv -> Value
toJSON PluginEnv {[Text]
Text
pluginEnvValue :: Text
pluginEnvSettable :: [Text]
pluginEnvName :: Text
pluginEnvDescription :: Text
pluginEnvValue :: PluginEnv -> Text
pluginEnvSettable :: PluginEnv -> [Text]
pluginEnvName :: PluginEnv -> Text
pluginEnvDescription :: PluginEnv -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Description" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginEnvDescription
      , Key
"Name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginEnvName
      , Key
"Settable" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginEnvSettable
      , Key
"Value" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginEnvValue
      ]


-- | Construct a value of type 'PluginEnv' (by applying it's required fields, if any)
mkPluginEnv
  :: Text -- ^ 'pluginEnvDescription': description
  -> Text -- ^ 'pluginEnvName': name
  -> [Text] -- ^ 'pluginEnvSettable': settable
  -> Text -- ^ 'pluginEnvValue': value
  -> PluginEnv
mkPluginEnv :: Text -> Text -> [Text] -> Text -> PluginEnv
mkPluginEnv Text
pluginEnvDescription Text
pluginEnvName [Text]
pluginEnvSettable Text
pluginEnvValue =
  PluginEnv :: Text -> Text -> [Text] -> Text -> PluginEnv
PluginEnv
  { Text
pluginEnvDescription :: Text
pluginEnvDescription :: Text
pluginEnvDescription
  , Text
pluginEnvName :: Text
pluginEnvName :: Text
pluginEnvName
  , [Text]
pluginEnvSettable :: [Text]
pluginEnvSettable :: [Text]
pluginEnvSettable
  , Text
pluginEnvValue :: Text
pluginEnvValue :: Text
pluginEnvValue
  }

-- ** PluginInterfaceType
-- | PluginInterfaceType
-- PluginInterfaceType plugin interface type
data PluginInterfaceType = PluginInterfaceType
  { PluginInterfaceType -> Text
pluginInterfaceTypeCapability :: Text -- ^ /Required/ "Capability" - capability
  , PluginInterfaceType -> Text
pluginInterfaceTypePrefix :: Text -- ^ /Required/ "Prefix" - prefix
  , PluginInterfaceType -> Text
pluginInterfaceTypeVersion :: Text -- ^ /Required/ "Version" - version
  } deriving (Int -> PluginInterfaceType -> ShowS
[PluginInterfaceType] -> ShowS
PluginInterfaceType -> String
(Int -> PluginInterfaceType -> ShowS)
-> (PluginInterfaceType -> String)
-> ([PluginInterfaceType] -> ShowS)
-> Show PluginInterfaceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginInterfaceType] -> ShowS
$cshowList :: [PluginInterfaceType] -> ShowS
show :: PluginInterfaceType -> String
$cshow :: PluginInterfaceType -> String
showsPrec :: Int -> PluginInterfaceType -> ShowS
$cshowsPrec :: Int -> PluginInterfaceType -> ShowS
P.Show, PluginInterfaceType -> PluginInterfaceType -> Bool
(PluginInterfaceType -> PluginInterfaceType -> Bool)
-> (PluginInterfaceType -> PluginInterfaceType -> Bool)
-> Eq PluginInterfaceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginInterfaceType -> PluginInterfaceType -> Bool
$c/= :: PluginInterfaceType -> PluginInterfaceType -> Bool
== :: PluginInterfaceType -> PluginInterfaceType -> Bool
$c== :: PluginInterfaceType -> PluginInterfaceType -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON PluginInterfaceType
instance A.ToJSON PluginInterfaceType where
  toJSON :: PluginInterfaceType -> Value
toJSON PluginInterfaceType {Text
pluginInterfaceTypeVersion :: Text
pluginInterfaceTypePrefix :: Text
pluginInterfaceTypeCapability :: Text
pluginInterfaceTypeVersion :: PluginInterfaceType -> Text
pluginInterfaceTypePrefix :: PluginInterfaceType -> Text
pluginInterfaceTypeCapability :: PluginInterfaceType -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Capability" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginInterfaceTypeCapability
      , Key
"Prefix" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginInterfaceTypePrefix
      , Key
"Version" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginInterfaceTypeVersion
      ]


-- | Construct a value of type 'PluginInterfaceType' (by applying it's required fields, if any)
mkPluginInterfaceType
  :: Text -- ^ 'pluginInterfaceTypeCapability': capability
  -> Text -- ^ 'pluginInterfaceTypePrefix': prefix
  -> Text -- ^ 'pluginInterfaceTypeVersion': version
  -> PluginInterfaceType
mkPluginInterfaceType :: Text -> Text -> Text -> PluginInterfaceType
mkPluginInterfaceType Text
pluginInterfaceTypeCapability Text
pluginInterfaceTypePrefix Text
pluginInterfaceTypeVersion =
  PluginInterfaceType :: Text -> Text -> Text -> PluginInterfaceType
PluginInterfaceType
  { Text
pluginInterfaceTypeCapability :: Text
pluginInterfaceTypeCapability :: Text
pluginInterfaceTypeCapability
  , Text
pluginInterfaceTypePrefix :: Text
pluginInterfaceTypePrefix :: Text
pluginInterfaceTypePrefix
  , Text
pluginInterfaceTypeVersion :: Text
pluginInterfaceTypeVersion :: Text
pluginInterfaceTypeVersion
  }

-- ** PluginMount
-- | PluginMount
-- PluginMount plugin mount
data PluginMount = PluginMount
  { PluginMount -> Text
pluginMountDescription :: Text -- ^ /Required/ "Description" - description
  , PluginMount -> Text
pluginMountDestination :: Text -- ^ /Required/ "Destination" - destination
  , PluginMount -> Text
pluginMountName :: Text -- ^ /Required/ "Name" - name
  , PluginMount -> [Text]
pluginMountOptions :: [Text] -- ^ /Required/ "Options" - options
  , PluginMount -> [Text]
pluginMountSettable :: [Text] -- ^ /Required/ "Settable" - settable
  , PluginMount -> Text
pluginMountSource :: Text -- ^ /Required/ "Source" - source
  , PluginMount -> Text
pluginMountType :: Text -- ^ /Required/ "Type" - type
  } deriving (Int -> PluginMount -> ShowS
[PluginMount] -> ShowS
PluginMount -> String
(Int -> PluginMount -> ShowS)
-> (PluginMount -> String)
-> ([PluginMount] -> ShowS)
-> Show PluginMount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginMount] -> ShowS
$cshowList :: [PluginMount] -> ShowS
show :: PluginMount -> String
$cshow :: PluginMount -> String
showsPrec :: Int -> PluginMount -> ShowS
$cshowsPrec :: Int -> PluginMount -> ShowS
P.Show, PluginMount -> PluginMount -> Bool
(PluginMount -> PluginMount -> Bool)
-> (PluginMount -> PluginMount -> Bool) -> Eq PluginMount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginMount -> PluginMount -> Bool
$c/= :: PluginMount -> PluginMount -> Bool
== :: PluginMount -> PluginMount -> Bool
$c== :: PluginMount -> PluginMount -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginMount
instance A.FromJSON PluginMount where
  parseJSON :: Value -> Parser PluginMount
parseJSON = String
-> (Object -> Parser PluginMount) -> Value -> Parser PluginMount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginMount" ((Object -> Parser PluginMount) -> Value -> Parser PluginMount)
-> (Object -> Parser PluginMount) -> Value -> Parser PluginMount
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text -> Text -> [Text] -> [Text] -> Text -> Text -> PluginMount
PluginMount
      (Text
 -> Text -> Text -> [Text] -> [Text] -> Text -> Text -> PluginMount)
-> Parser Text
-> Parser
     (Text -> Text -> [Text] -> [Text] -> Text -> Text -> PluginMount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Description")
      Parser
  (Text -> Text -> [Text] -> [Text] -> Text -> Text -> PluginMount)
-> Parser Text
-> Parser (Text -> [Text] -> [Text] -> Text -> Text -> PluginMount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Destination")
      Parser (Text -> [Text] -> [Text] -> Text -> Text -> PluginMount)
-> Parser Text
-> Parser ([Text] -> [Text] -> Text -> Text -> PluginMount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Name")
      Parser ([Text] -> [Text] -> Text -> Text -> PluginMount)
-> Parser [Text] -> Parser ([Text] -> Text -> Text -> PluginMount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Options")
      Parser ([Text] -> Text -> Text -> PluginMount)
-> Parser [Text] -> Parser (Text -> Text -> PluginMount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Settable")
      Parser (Text -> Text -> PluginMount)
-> Parser Text -> Parser (Text -> PluginMount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Source")
      Parser (Text -> PluginMount) -> Parser Text -> Parser PluginMount
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Type")

-- | ToJSON PluginMount
instance A.ToJSON PluginMount where
  toJSON :: PluginMount -> Value
toJSON PluginMount {[Text]
Text
pluginMountType :: Text
pluginMountSource :: Text
pluginMountSettable :: [Text]
pluginMountOptions :: [Text]
pluginMountName :: Text
pluginMountDestination :: Text
pluginMountDescription :: Text
pluginMountType :: PluginMount -> Text
pluginMountSource :: PluginMount -> Text
pluginMountSettable :: PluginMount -> [Text]
pluginMountOptions :: PluginMount -> [Text]
pluginMountName :: PluginMount -> Text
pluginMountDestination :: PluginMount -> Text
pluginMountDescription :: PluginMount -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Description" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginMountDescription
      , Key
"Destination" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginMountDestination
      , Key
"Name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginMountName
      , Key
"Options" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginMountOptions
      , Key
"Settable" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginMountSettable
      , Key
"Source" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginMountSource
      , Key
"Type" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pluginMountType
      ]


-- | Construct a value of type 'PluginMount' (by applying it's required fields, if any)
mkPluginMount
  :: Text -- ^ 'pluginMountDescription': description
  -> Text -- ^ 'pluginMountDestination': destination
  -> Text -- ^ 'pluginMountName': name
  -> [Text] -- ^ 'pluginMountOptions': options
  -> [Text] -- ^ 'pluginMountSettable': settable
  -> Text -- ^ 'pluginMountSource': source
  -> Text -- ^ 'pluginMountType': type
  -> PluginMount
mkPluginMount :: Text
-> Text -> Text -> [Text] -> [Text] -> Text -> Text -> PluginMount
mkPluginMount Text
pluginMountDescription Text
pluginMountDestination Text
pluginMountName [Text]
pluginMountOptions [Text]
pluginMountSettable Text
pluginMountSource Text
pluginMountType =
  PluginMount :: Text
-> Text -> Text -> [Text] -> [Text] -> Text -> Text -> PluginMount
PluginMount
  { Text
pluginMountDescription :: Text
pluginMountDescription :: Text
pluginMountDescription
  , Text
pluginMountDestination :: Text
pluginMountDestination :: Text
pluginMountDestination
  , Text
pluginMountName :: Text
pluginMountName :: Text
pluginMountName
  , [Text]
pluginMountOptions :: [Text]
pluginMountOptions :: [Text]
pluginMountOptions
  , [Text]
pluginMountSettable :: [Text]
pluginMountSettable :: [Text]
pluginMountSettable
  , Text
pluginMountSource :: Text
pluginMountSource :: Text
pluginMountSource
  , Text
pluginMountType :: Text
pluginMountType :: Text
pluginMountType
  }

-- ** PluginSettings
-- | PluginSettings
-- PluginSettings Settings that can be modified by users.
-- 
data PluginSettings = PluginSettings
  { PluginSettings -> [Text]
pluginSettingsArgs :: [Text] -- ^ /Required/ "Args" - args
  , PluginSettings -> [PluginDevice]
pluginSettingsDevices :: [PluginDevice] -- ^ /Required/ "Devices" - devices
  , PluginSettings -> [Text]
pluginSettingsEnv :: [Text] -- ^ /Required/ "Env" - env
  , PluginSettings -> [PluginMount]
pluginSettingsMounts :: [PluginMount] -- ^ /Required/ "Mounts" - mounts
  } deriving (Int -> PluginSettings -> ShowS
[PluginSettings] -> ShowS
PluginSettings -> String
(Int -> PluginSettings -> ShowS)
-> (PluginSettings -> String)
-> ([PluginSettings] -> ShowS)
-> Show PluginSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginSettings] -> ShowS
$cshowList :: [PluginSettings] -> ShowS
show :: PluginSettings -> String
$cshow :: PluginSettings -> String
showsPrec :: Int -> PluginSettings -> ShowS
$cshowsPrec :: Int -> PluginSettings -> ShowS
P.Show, PluginSettings -> PluginSettings -> Bool
(PluginSettings -> PluginSettings -> Bool)
-> (PluginSettings -> PluginSettings -> Bool) -> Eq PluginSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginSettings -> PluginSettings -> Bool
$c/= :: PluginSettings -> PluginSettings -> Bool
== :: PluginSettings -> PluginSettings -> Bool
$c== :: PluginSettings -> PluginSettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON PluginSettings
instance A.FromJSON PluginSettings where
  parseJSON :: Value -> Parser PluginSettings
parseJSON = String
-> (Object -> Parser PluginSettings)
-> Value
-> Parser PluginSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginSettings" ((Object -> Parser PluginSettings)
 -> Value -> Parser PluginSettings)
-> (Object -> Parser PluginSettings)
-> Value
-> Parser PluginSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text]
-> [PluginDevice] -> [Text] -> [PluginMount] -> PluginSettings
PluginSettings
      ([Text]
 -> [PluginDevice] -> [Text] -> [PluginMount] -> PluginSettings)
-> Parser [Text]
-> Parser
     ([PluginDevice] -> [Text] -> [PluginMount] -> PluginSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Args")
      Parser
  ([PluginDevice] -> [Text] -> [PluginMount] -> PluginSettings)
-> Parser [PluginDevice]
-> Parser ([Text] -> [PluginMount] -> PluginSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [PluginDevice]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Devices")
      Parser ([Text] -> [PluginMount] -> PluginSettings)
-> Parser [Text] -> Parser ([PluginMount] -> PluginSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Env")
      Parser ([PluginMount] -> PluginSettings)
-> Parser [PluginMount] -> Parser PluginSettings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [PluginMount]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Mounts")

-- | ToJSON PluginSettings
instance A.ToJSON PluginSettings where
  toJSON :: PluginSettings -> Value
toJSON PluginSettings {[Text]
[PluginMount]
[PluginDevice]
pluginSettingsMounts :: [PluginMount]
pluginSettingsEnv :: [Text]
pluginSettingsDevices :: [PluginDevice]
pluginSettingsArgs :: [Text]
pluginSettingsMounts :: PluginSettings -> [PluginMount]
pluginSettingsEnv :: PluginSettings -> [Text]
pluginSettingsDevices :: PluginSettings -> [PluginDevice]
pluginSettingsArgs :: PluginSettings -> [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Args" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginSettingsArgs
      , Key
"Devices" Key -> [PluginDevice] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PluginDevice]
pluginSettingsDevices
      , Key
"Env" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pluginSettingsEnv
      , Key
"Mounts" Key -> [PluginMount] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [PluginMount]
pluginSettingsMounts
      ]


-- | Construct a value of type 'PluginSettings' (by applying it's required fields, if any)
mkPluginSettings
  :: [Text] -- ^ 'pluginSettingsArgs': args
  -> [PluginDevice] -- ^ 'pluginSettingsDevices': devices
  -> [Text] -- ^ 'pluginSettingsEnv': env
  -> [PluginMount] -- ^ 'pluginSettingsMounts': mounts
  -> PluginSettings
mkPluginSettings :: [Text]
-> [PluginDevice] -> [Text] -> [PluginMount] -> PluginSettings
mkPluginSettings [Text]
pluginSettingsArgs [PluginDevice]
pluginSettingsDevices [Text]
pluginSettingsEnv [PluginMount]
pluginSettingsMounts =
  PluginSettings :: [Text]
-> [PluginDevice] -> [Text] -> [PluginMount] -> PluginSettings
PluginSettings
  { [Text]
pluginSettingsArgs :: [Text]
pluginSettingsArgs :: [Text]
pluginSettingsArgs
  , [PluginDevice]
pluginSettingsDevices :: [PluginDevice]
pluginSettingsDevices :: [PluginDevice]
pluginSettingsDevices
  , [Text]
pluginSettingsEnv :: [Text]
pluginSettingsEnv :: [Text]
pluginSettingsEnv
  , [PluginMount]
pluginSettingsMounts :: [PluginMount]
pluginSettingsMounts :: [PluginMount]
pluginSettingsMounts
  }

-- ** PreviousConsentSession
-- | PreviousConsentSession
-- The response used to return used consent requests same as HandledLoginRequest, just with consent_request exposed as json
data PreviousConsentSession = PreviousConsentSession
  { PreviousConsentSession -> Maybe ConsentRequest
previousConsentSessionConsentRequest :: Maybe ConsentRequest -- ^ "consent_request"
  , PreviousConsentSession -> Maybe [Text]
previousConsentSessionGrantAccessTokenAudience :: Maybe [Text] -- ^ "grant_access_token_audience"
  , PreviousConsentSession -> Maybe [Text]
previousConsentSessionGrantScope :: Maybe [Text] -- ^ "grant_scope"
  , PreviousConsentSession -> Maybe DateTime
previousConsentSessionHandledAt :: Maybe DateTime -- ^ "handled_at"
  , PreviousConsentSession -> Maybe Bool
previousConsentSessionRemember :: 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.
  , PreviousConsentSession -> Maybe Integer
previousConsentSessionRememberFor :: 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.
  , PreviousConsentSession -> Maybe ConsentRequestSession
previousConsentSessionSession :: Maybe ConsentRequestSession -- ^ "session"
  } deriving (Int -> PreviousConsentSession -> ShowS
[PreviousConsentSession] -> ShowS
PreviousConsentSession -> String
(Int -> PreviousConsentSession -> ShowS)
-> (PreviousConsentSession -> String)
-> ([PreviousConsentSession] -> ShowS)
-> Show PreviousConsentSession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreviousConsentSession] -> ShowS
$cshowList :: [PreviousConsentSession] -> ShowS
show :: PreviousConsentSession -> String
$cshow :: PreviousConsentSession -> String
showsPrec :: Int -> PreviousConsentSession -> ShowS
$cshowsPrec :: Int -> PreviousConsentSession -> ShowS
P.Show, PreviousConsentSession -> PreviousConsentSession -> Bool
(PreviousConsentSession -> PreviousConsentSession -> Bool)
-> (PreviousConsentSession -> PreviousConsentSession -> Bool)
-> Eq PreviousConsentSession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreviousConsentSession -> PreviousConsentSession -> Bool
$c/= :: PreviousConsentSession -> PreviousConsentSession -> Bool
== :: PreviousConsentSession -> PreviousConsentSession -> Bool
$c== :: PreviousConsentSession -> PreviousConsentSession -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON PreviousConsentSession
instance A.ToJSON PreviousConsentSession where
  toJSON :: PreviousConsentSession -> Value
toJSON PreviousConsentSession {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe DateTime
Maybe ConsentRequestSession
Maybe ConsentRequest
previousConsentSessionSession :: Maybe ConsentRequestSession
previousConsentSessionRememberFor :: Maybe Integer
previousConsentSessionRemember :: Maybe Bool
previousConsentSessionHandledAt :: Maybe DateTime
previousConsentSessionGrantScope :: Maybe [Text]
previousConsentSessionGrantAccessTokenAudience :: Maybe [Text]
previousConsentSessionConsentRequest :: Maybe ConsentRequest
previousConsentSessionSession :: PreviousConsentSession -> Maybe ConsentRequestSession
previousConsentSessionRememberFor :: PreviousConsentSession -> Maybe Integer
previousConsentSessionRemember :: PreviousConsentSession -> Maybe Bool
previousConsentSessionHandledAt :: PreviousConsentSession -> Maybe DateTime
previousConsentSessionGrantScope :: PreviousConsentSession -> Maybe [Text]
previousConsentSessionGrantAccessTokenAudience :: PreviousConsentSession -> Maybe [Text]
previousConsentSessionConsentRequest :: PreviousConsentSession -> Maybe ConsentRequest
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"consent_request" Key -> Maybe ConsentRequest -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ConsentRequest
previousConsentSessionConsentRequest
      , Key
"grant_access_token_audience" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
previousConsentSessionGrantAccessTokenAudience
      , Key
"grant_scope" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
previousConsentSessionGrantScope
      , Key
"handled_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
previousConsentSessionHandledAt
      , Key
"remember" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
previousConsentSessionRemember
      , Key
"remember_for" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
previousConsentSessionRememberFor
      , Key
"session" Key -> Maybe ConsentRequestSession -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ConsentRequestSession
previousConsentSessionSession
      ]


-- | Construct a value of type 'PreviousConsentSession' (by applying it's required fields, if any)
mkPreviousConsentSession
  :: PreviousConsentSession
mkPreviousConsentSession :: PreviousConsentSession
mkPreviousConsentSession =
  PreviousConsentSession :: Maybe ConsentRequest
-> Maybe [Text]
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Bool
-> Maybe Integer
-> Maybe ConsentRequestSession
-> PreviousConsentSession
PreviousConsentSession
  { previousConsentSessionConsentRequest :: Maybe ConsentRequest
previousConsentSessionConsentRequest = Maybe ConsentRequest
forall a. Maybe a
Nothing
  , previousConsentSessionGrantAccessTokenAudience :: Maybe [Text]
previousConsentSessionGrantAccessTokenAudience = Maybe [Text]
forall a. Maybe a
Nothing
  , previousConsentSessionGrantScope :: Maybe [Text]
previousConsentSessionGrantScope = Maybe [Text]
forall a. Maybe a
Nothing
  , previousConsentSessionHandledAt :: Maybe DateTime
previousConsentSessionHandledAt = Maybe DateTime
forall a. Maybe a
Nothing
  , previousConsentSessionRemember :: Maybe Bool
previousConsentSessionRemember = Maybe Bool
forall a. Maybe a
Nothing
  , previousConsentSessionRememberFor :: Maybe Integer
previousConsentSessionRememberFor = Maybe Integer
forall a. Maybe a
Nothing
  , previousConsentSessionSession :: Maybe ConsentRequestSession
previousConsentSessionSession = Maybe ConsentRequestSession
forall a. Maybe a
Nothing
  }

-- ** RejectRequest
-- | RejectRequest
-- The request payload used to accept a login or consent request.
-- 
data RejectRequest = RejectRequest
  { RejectRequest -> Maybe Text
rejectRequestError :: 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;.
  , RejectRequest -> Maybe Text
rejectRequestErrorDebug :: 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.
  , RejectRequest -> Maybe Text
rejectRequestErrorDescription :: Maybe Text -- ^ "error_description" - Description of the error in a human readable format.
  , RejectRequest -> Maybe Text
rejectRequestErrorHint :: Maybe Text -- ^ "error_hint" - Hint to help resolve the error.
  , RejectRequest -> Maybe Integer
rejectRequestStatusCode :: Maybe Integer -- ^ "status_code" - Represents the HTTP status code of the error (e.g. 401 or 403)  Defaults to 400
  } deriving (Int -> RejectRequest -> ShowS
[RejectRequest] -> ShowS
RejectRequest -> String
(Int -> RejectRequest -> ShowS)
-> (RejectRequest -> String)
-> ([RejectRequest] -> ShowS)
-> Show RejectRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RejectRequest] -> ShowS
$cshowList :: [RejectRequest] -> ShowS
show :: RejectRequest -> String
$cshow :: RejectRequest -> String
showsPrec :: Int -> RejectRequest -> ShowS
$cshowsPrec :: Int -> RejectRequest -> ShowS
P.Show, RejectRequest -> RejectRequest -> Bool
(RejectRequest -> RejectRequest -> Bool)
-> (RejectRequest -> RejectRequest -> Bool) -> Eq RejectRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RejectRequest -> RejectRequest -> Bool
$c/= :: RejectRequest -> RejectRequest -> Bool
== :: RejectRequest -> RejectRequest -> Bool
$c== :: RejectRequest -> RejectRequest -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON RejectRequest
instance A.ToJSON RejectRequest where
  toJSON :: RejectRequest -> Value
toJSON RejectRequest {Maybe Integer
Maybe Text
rejectRequestStatusCode :: Maybe Integer
rejectRequestErrorHint :: Maybe Text
rejectRequestErrorDescription :: Maybe Text
rejectRequestErrorDebug :: Maybe Text
rejectRequestError :: Maybe Text
rejectRequestStatusCode :: RejectRequest -> Maybe Integer
rejectRequestErrorHint :: RejectRequest -> Maybe Text
rejectRequestErrorDescription :: RejectRequest -> Maybe Text
rejectRequestErrorDebug :: RejectRequest -> Maybe Text
rejectRequestError :: RejectRequest -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"error" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectRequestError
      , Key
"error_debug" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectRequestErrorDebug
      , Key
"error_description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectRequestErrorDescription
      , Key
"error_hint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
rejectRequestErrorHint
      , Key
"status_code" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
rejectRequestStatusCode
      ]

-- | FromForm RejectRequest
instance WH.FromForm RejectRequest where
  fromForm :: Form -> Either Text RejectRequest
fromForm Form
f =
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> RejectRequest
RejectRequest
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> RejectRequest)
-> Either Text (Maybe Text)
-> Either
     Text
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Integer -> RejectRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Form -> Either Text (Maybe Text)
forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
WH.parseMaybe Text
"error" Form
f)
      Either
  Text
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Integer -> RejectRequest)
-> Either Text (Maybe Text)
-> Either
     Text (Maybe Text -> Maybe Text -> Maybe Integer -> RejectRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Form -> Either Text (Maybe Text)
forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
WH.parseMaybe Text
"error_debug" Form
f)
      Either
  Text (Maybe Text -> Maybe Text -> Maybe Integer -> RejectRequest)
-> Either Text (Maybe Text)
-> Either Text (Maybe Text -> Maybe Integer -> RejectRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Form -> Either Text (Maybe Text)
forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
WH.parseMaybe Text
"error_description" Form
f)
      Either Text (Maybe Text -> Maybe Integer -> RejectRequest)
-> Either Text (Maybe Text)
-> Either Text (Maybe Integer -> RejectRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Form -> Either Text (Maybe Text)
forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
WH.parseMaybe Text
"error_hint" Form
f)
      Either Text (Maybe Integer -> RejectRequest)
-> Either Text (Maybe Integer) -> Either Text RejectRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Form -> Either Text (Maybe Integer)
forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
WH.parseMaybe Text
"status_code" Form
f)

-- | ToForm RejectRequest
instance WH.ToForm RejectRequest where
  toForm :: RejectRequest -> Form
toForm RejectRequest {Maybe Integer
Maybe Text
rejectRequestStatusCode :: Maybe Integer
rejectRequestErrorHint :: Maybe Text
rejectRequestErrorDescription :: Maybe Text
rejectRequestErrorDebug :: Maybe Text
rejectRequestError :: Maybe Text
rejectRequestStatusCode :: RejectRequest -> Maybe Integer
rejectRequestErrorHint :: RejectRequest -> Maybe Text
rejectRequestErrorDescription :: RejectRequest -> Maybe Text
rejectRequestErrorDebug :: RejectRequest -> Maybe Text
rejectRequestError :: RejectRequest -> Maybe Text
..} =
    HashMap Text [Text] -> Form
WH.Form (HashMap Text [Text] -> Form) -> HashMap Text [Text] -> Form
forall a b. (a -> b) -> a -> b
$ [(Text, [Text])] -> HashMap Text [Text]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, [Text])] -> HashMap Text [Text])
-> [(Text, [Text])] -> HashMap Text [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, [Text])] -> [(Text, [Text])]
forall a. [Maybe a] -> [a]
P.catMaybes ([Maybe (Text, [Text])] -> [(Text, [Text])])
-> [Maybe (Text, [Text])] -> [(Text, [Text])]
forall a b. (a -> b) -> a -> b
$
      [ Text -> Maybe Text -> Maybe (Text, [Text])
forall a (f :: * -> *) t.
(ToHttpApiData a, Functor f) =>
t -> f a -> f (t, [Text])
_toFormItem Text
"error" (Maybe Text
rejectRequestError)
      , Text -> Maybe Text -> Maybe (Text, [Text])
forall a (f :: * -> *) t.
(ToHttpApiData a, Functor f) =>
t -> f a -> f (t, [Text])
_toFormItem Text
"error_debug" (Maybe Text
rejectRequestErrorDebug)
      , Text -> Maybe Text -> Maybe (Text, [Text])
forall a (f :: * -> *) t.
(ToHttpApiData a, Functor f) =>
t -> f a -> f (t, [Text])
_toFormItem Text
"error_description" (Maybe Text
rejectRequestErrorDescription)
      , Text -> Maybe Text -> Maybe (Text, [Text])
forall a (f :: * -> *) t.
(ToHttpApiData a, Functor f) =>
t -> f a -> f (t, [Text])
_toFormItem Text
"error_hint" (Maybe Text
rejectRequestErrorHint)
      , Text -> Maybe Integer -> Maybe (Text, [Text])
forall a (f :: * -> *) t.
(ToHttpApiData a, Functor f) =>
t -> f a -> f (t, [Text])
_toFormItem Text
"status_code" (Maybe Integer
rejectRequestStatusCode)
      ]

-- | Construct a value of type 'RejectRequest' (by applying it's required fields, if any)
mkRejectRequest
  :: RejectRequest
mkRejectRequest :: RejectRequest
mkRejectRequest =
  RejectRequest :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> RejectRequest
RejectRequest
  { rejectRequestError :: Maybe Text
rejectRequestError = Maybe Text
forall a. Maybe a
Nothing
  , rejectRequestErrorDebug :: Maybe Text
rejectRequestErrorDebug = Maybe Text
forall a. Maybe a
Nothing
  , rejectRequestErrorDescription :: Maybe Text
rejectRequestErrorDescription = Maybe Text
forall a. Maybe a
Nothing
  , rejectRequestErrorHint :: Maybe Text
rejectRequestErrorHint = Maybe Text
forall a. Maybe a
Nothing
  , rejectRequestStatusCode :: Maybe Integer
rejectRequestStatusCode = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** UserinfoResponse
-- | UserinfoResponse
-- The userinfo response
data UserinfoResponse = UserinfoResponse
  { UserinfoResponse -> Maybe Text
userinfoResponseBirthdate :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseEmail :: 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.
  , UserinfoResponse -> Maybe Bool
userinfoResponseEmailVerified :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseFamilyName :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseGender :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseGivenName :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseLocale :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseMiddleName :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseName :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseNickname :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponsePhoneNumber :: 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.
  , UserinfoResponse -> Maybe Bool
userinfoResponsePhoneNumberVerified :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponsePicture :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponsePreferredUsername :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseProfile :: Maybe Text -- ^ "profile" - URL of the End-User&#39;s profile page. The contents of this Web page SHOULD be about the End-User.
  , UserinfoResponse -> Maybe Text
userinfoResponseSub :: Maybe Text -- ^ "sub" - Subject - Identifier for the End-User at the IssuerURL.
  , UserinfoResponse -> Maybe Integer
userinfoResponseUpdatedAt :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseWebsite :: 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.
  , UserinfoResponse -> Maybe Text
userinfoResponseZoneinfo :: 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 -> UserinfoResponse -> ShowS
[UserinfoResponse] -> ShowS
UserinfoResponse -> String
(Int -> UserinfoResponse -> ShowS)
-> (UserinfoResponse -> String)
-> ([UserinfoResponse] -> ShowS)
-> Show UserinfoResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserinfoResponse] -> ShowS
$cshowList :: [UserinfoResponse] -> ShowS
show :: UserinfoResponse -> String
$cshow :: UserinfoResponse -> String
showsPrec :: Int -> UserinfoResponse -> ShowS
$cshowsPrec :: Int -> UserinfoResponse -> ShowS
P.Show, UserinfoResponse -> UserinfoResponse -> Bool
(UserinfoResponse -> UserinfoResponse -> Bool)
-> (UserinfoResponse -> UserinfoResponse -> Bool)
-> Eq UserinfoResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserinfoResponse -> UserinfoResponse -> Bool
$c/= :: UserinfoResponse -> UserinfoResponse -> Bool
== :: UserinfoResponse -> UserinfoResponse -> Bool
$c== :: UserinfoResponse -> UserinfoResponse -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON UserinfoResponse
instance A.ToJSON UserinfoResponse where
  toJSON :: UserinfoResponse -> Value
toJSON UserinfoResponse {Maybe Bool
Maybe Integer
Maybe Text
userinfoResponseZoneinfo :: Maybe Text
userinfoResponseWebsite :: Maybe Text
userinfoResponseUpdatedAt :: Maybe Integer
userinfoResponseSub :: Maybe Text
userinfoResponseProfile :: Maybe Text
userinfoResponsePreferredUsername :: Maybe Text
userinfoResponsePicture :: Maybe Text
userinfoResponsePhoneNumberVerified :: Maybe Bool
userinfoResponsePhoneNumber :: Maybe Text
userinfoResponseNickname :: Maybe Text
userinfoResponseName :: Maybe Text
userinfoResponseMiddleName :: Maybe Text
userinfoResponseLocale :: Maybe Text
userinfoResponseGivenName :: Maybe Text
userinfoResponseGender :: Maybe Text
userinfoResponseFamilyName :: Maybe Text
userinfoResponseEmailVerified :: Maybe Bool
userinfoResponseEmail :: Maybe Text
userinfoResponseBirthdate :: Maybe Text
userinfoResponseZoneinfo :: UserinfoResponse -> Maybe Text
userinfoResponseWebsite :: UserinfoResponse -> Maybe Text
userinfoResponseUpdatedAt :: UserinfoResponse -> Maybe Integer
userinfoResponseSub :: UserinfoResponse -> Maybe Text
userinfoResponseProfile :: UserinfoResponse -> Maybe Text
userinfoResponsePreferredUsername :: UserinfoResponse -> Maybe Text
userinfoResponsePicture :: UserinfoResponse -> Maybe Text
userinfoResponsePhoneNumberVerified :: UserinfoResponse -> Maybe Bool
userinfoResponsePhoneNumber :: UserinfoResponse -> Maybe Text
userinfoResponseNickname :: UserinfoResponse -> Maybe Text
userinfoResponseName :: UserinfoResponse -> Maybe Text
userinfoResponseMiddleName :: UserinfoResponse -> Maybe Text
userinfoResponseLocale :: UserinfoResponse -> Maybe Text
userinfoResponseGivenName :: UserinfoResponse -> Maybe Text
userinfoResponseGender :: UserinfoResponse -> Maybe Text
userinfoResponseFamilyName :: UserinfoResponse -> Maybe Text
userinfoResponseEmailVerified :: UserinfoResponse -> Maybe Bool
userinfoResponseEmail :: UserinfoResponse -> Maybe Text
userinfoResponseBirthdate :: UserinfoResponse -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"birthdate" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseBirthdate
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseEmail
      , Key
"email_verified" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
userinfoResponseEmailVerified
      , Key
"family_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseFamilyName
      , Key
"gender" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseGender
      , Key
"given_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseGivenName
      , Key
"locale" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseLocale
      , Key
"middle_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseMiddleName
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseName
      , Key
"nickname" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseNickname
      , Key
"phone_number" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponsePhoneNumber
      , Key
"phone_number_verified" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
userinfoResponsePhoneNumberVerified
      , Key
"picture" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponsePicture
      , Key
"preferred_username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponsePreferredUsername
      , Key
"profile" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseProfile
      , Key
"sub" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseSub
      , Key
"updated_at" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
userinfoResponseUpdatedAt
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseWebsite
      , Key
"zoneinfo" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
userinfoResponseZoneinfo
      ]


-- | Construct a value of type 'UserinfoResponse' (by applying it's required fields, if any)
mkUserinfoResponse
  :: UserinfoResponse
mkUserinfoResponse :: UserinfoResponse
mkUserinfoResponse =
  UserinfoResponse :: 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
-> UserinfoResponse
UserinfoResponse
  { userinfoResponseBirthdate :: Maybe Text
userinfoResponseBirthdate = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseEmail :: Maybe Text
userinfoResponseEmail = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseEmailVerified :: Maybe Bool
userinfoResponseEmailVerified = Maybe Bool
forall a. Maybe a
Nothing
  , userinfoResponseFamilyName :: Maybe Text
userinfoResponseFamilyName = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseGender :: Maybe Text
userinfoResponseGender = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseGivenName :: Maybe Text
userinfoResponseGivenName = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseLocale :: Maybe Text
userinfoResponseLocale = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseMiddleName :: Maybe Text
userinfoResponseMiddleName = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseName :: Maybe Text
userinfoResponseName = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseNickname :: Maybe Text
userinfoResponseNickname = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponsePhoneNumber :: Maybe Text
userinfoResponsePhoneNumber = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponsePhoneNumberVerified :: Maybe Bool
userinfoResponsePhoneNumberVerified = Maybe Bool
forall a. Maybe a
Nothing
  , userinfoResponsePicture :: Maybe Text
userinfoResponsePicture = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponsePreferredUsername :: Maybe Text
userinfoResponsePreferredUsername = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseProfile :: Maybe Text
userinfoResponseProfile = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseSub :: Maybe Text
userinfoResponseSub = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseUpdatedAt :: Maybe Integer
userinfoResponseUpdatedAt = Maybe Integer
forall a. Maybe a
Nothing
  , userinfoResponseWebsite :: Maybe Text
userinfoResponseWebsite = Maybe Text
forall a. Maybe a
Nothing
  , userinfoResponseZoneinfo :: Maybe Text
userinfoResponseZoneinfo = Maybe Text
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
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
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
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
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 = String -> (Object -> Parser Version) -> Value -> Parser Version
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Version" ((Object -> Parser Version) -> Value -> Parser Version)
-> (Object -> Parser Version) -> Value -> Parser Version
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Version
Version
      (Maybe Text -> Version) -> Parser (Maybe Text) -> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
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" Key -> Maybe Text -> (Key, Value)
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 :: Maybe Text -> Version
Version
  { versionVersion :: Maybe Text
versionVersion = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Volume
-- | Volume
-- Volume volume
data Volume = Volume
  { Volume -> Maybe Text
volumeCreatedAt :: Maybe Text -- ^ "CreatedAt" - Date/Time the volume was created.
  , Volume -> Text
volumeDriver :: Text -- ^ /Required/ "Driver" - Name of the volume driver used by the volume.
  , Volume -> Map String Text
volumeLabels :: (Map.Map String Text) -- ^ /Required/ "Labels" - User-defined key/value metadata.
  , Volume -> Text
volumeMountpoint :: Text -- ^ /Required/ "Mountpoint" - Mount path of the volume on the host.
  , Volume -> Text
volumeName :: Text -- ^ /Required/ "Name" - Name of the volume.
  , Volume -> Map String Text
volumeOptions :: (Map.Map String Text) -- ^ /Required/ "Options" - The driver specific options used when creating the volume.
  , Volume -> Text
volumeScope :: Text -- ^ /Required/ "Scope" - The level at which the volume exists. Either &#x60;global&#x60; for cluster-wide, or &#x60;local&#x60; for machine level.
  , Volume -> Maybe Value
volumeStatus :: Maybe A.Value -- ^ "Status" - Low-level details about the volume, provided by the volume driver. Details are returned as a map with key/value pairs: &#x60;{\&quot;key\&quot;:\&quot;value\&quot;,\&quot;key2\&quot;:\&quot;value2\&quot;}&#x60;.  The &#x60;Status&#x60; field is optional, and is omitted if the volume driver does not support this feature.
  , Volume -> Maybe VolumeUsageData
volumeUsageData :: Maybe VolumeUsageData -- ^ "UsageData"
  } deriving (Int -> Volume -> ShowS
[Volume] -> ShowS
Volume -> String
(Int -> Volume -> ShowS)
-> (Volume -> String) -> ([Volume] -> ShowS) -> Show Volume
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Volume] -> ShowS
$cshowList :: [Volume] -> ShowS
show :: Volume -> String
$cshow :: Volume -> String
showsPrec :: Int -> Volume -> ShowS
$cshowsPrec :: Int -> Volume -> ShowS
P.Show, Volume -> Volume -> Bool
(Volume -> Volume -> Bool)
-> (Volume -> Volume -> Bool) -> Eq Volume
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Volume -> Volume -> Bool
$c/= :: Volume -> Volume -> Bool
== :: Volume -> Volume -> Bool
$c== :: Volume -> Volume -> Bool
P.Eq, P.Typeable)

-- | FromJSON Volume
instance A.FromJSON Volume where
  parseJSON :: Value -> Parser Volume
parseJSON = String -> (Object -> Parser Volume) -> Value -> Parser Volume
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Volume" ((Object -> Parser Volume) -> Value -> Parser Volume)
-> (Object -> Parser Volume) -> Value -> Parser Volume
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Text
-> Map String Text
-> Text
-> Text
-> Map String Text
-> Text
-> Maybe Value
-> Maybe VolumeUsageData
-> Volume
Volume
      (Maybe Text
 -> Text
 -> Map String Text
 -> Text
 -> Text
 -> Map String Text
 -> Text
 -> Maybe Value
 -> Maybe VolumeUsageData
 -> Volume)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Map String Text
      -> Text
      -> Text
      -> Map String Text
      -> Text
      -> Maybe Value
      -> Maybe VolumeUsageData
      -> Volume)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"CreatedAt")
      Parser
  (Text
   -> Map String Text
   -> Text
   -> Text
   -> Map String Text
   -> Text
   -> Maybe Value
   -> Maybe VolumeUsageData
   -> Volume)
-> Parser Text
-> Parser
     (Map String Text
      -> Text
      -> Text
      -> Map String Text
      -> Text
      -> Maybe Value
      -> Maybe VolumeUsageData
      -> Volume)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Driver")
      Parser
  (Map String Text
   -> Text
   -> Text
   -> Map String Text
   -> Text
   -> Maybe Value
   -> Maybe VolumeUsageData
   -> Volume)
-> Parser (Map String Text)
-> Parser
     (Text
      -> Text
      -> Map String Text
      -> Text
      -> Maybe Value
      -> Maybe VolumeUsageData
      -> Volume)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map String Text)
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Labels")
      Parser
  (Text
   -> Text
   -> Map String Text
   -> Text
   -> Maybe Value
   -> Maybe VolumeUsageData
   -> Volume)
-> Parser Text
-> Parser
     (Text
      -> Map String Text
      -> Text
      -> Maybe Value
      -> Maybe VolumeUsageData
      -> Volume)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Mountpoint")
      Parser
  (Text
   -> Map String Text
   -> Text
   -> Maybe Value
   -> Maybe VolumeUsageData
   -> Volume)
-> Parser Text
-> Parser
     (Map String Text
      -> Text -> Maybe Value -> Maybe VolumeUsageData -> Volume)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Name")
      Parser
  (Map String Text
   -> Text -> Maybe Value -> Maybe VolumeUsageData -> Volume)
-> Parser (Map String Text)
-> Parser (Text -> Maybe Value -> Maybe VolumeUsageData -> Volume)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map String Text)
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Options")
      Parser (Text -> Maybe Value -> Maybe VolumeUsageData -> Volume)
-> Parser Text
-> Parser (Maybe Value -> Maybe VolumeUsageData -> Volume)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Scope")
      Parser (Maybe Value -> Maybe VolumeUsageData -> Volume)
-> Parser (Maybe Value) -> Parser (Maybe VolumeUsageData -> Volume)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Status")
      Parser (Maybe VolumeUsageData -> Volume)
-> Parser (Maybe VolumeUsageData) -> Parser Volume
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe VolumeUsageData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"UsageData")

-- | ToJSON Volume
instance A.ToJSON Volume where
  toJSON :: Volume -> Value
toJSON Volume {Maybe Text
Maybe Value
Maybe VolumeUsageData
Text
Map String Text
volumeUsageData :: Maybe VolumeUsageData
volumeStatus :: Maybe Value
volumeScope :: Text
volumeOptions :: Map String Text
volumeName :: Text
volumeMountpoint :: Text
volumeLabels :: Map String Text
volumeDriver :: Text
volumeCreatedAt :: Maybe Text
volumeUsageData :: Volume -> Maybe VolumeUsageData
volumeStatus :: Volume -> Maybe Value
volumeScope :: Volume -> Text
volumeOptions :: Volume -> Map String Text
volumeName :: Volume -> Text
volumeMountpoint :: Volume -> Text
volumeLabels :: Volume -> Map String Text
volumeDriver :: Volume -> Text
volumeCreatedAt :: Volume -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"CreatedAt" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
volumeCreatedAt
      , Key
"Driver" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
volumeDriver
      , Key
"Labels" Key -> Map String Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String Text
volumeLabels
      , Key
"Mountpoint" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
volumeMountpoint
      , Key
"Name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
volumeName
      , Key
"Options" Key -> Map String Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String Text
volumeOptions
      , Key
"Scope" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
volumeScope
      , Key
"Status" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
volumeStatus
      , Key
"UsageData" Key -> Maybe VolumeUsageData -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe VolumeUsageData
volumeUsageData
      ]


-- | Construct a value of type 'Volume' (by applying it's required fields, if any)
mkVolume
  :: Text -- ^ 'volumeDriver': Name of the volume driver used by the volume.
  -> (Map.Map String Text) -- ^ 'volumeLabels': User-defined key/value metadata.
  -> Text -- ^ 'volumeMountpoint': Mount path of the volume on the host.
  -> Text -- ^ 'volumeName': Name of the volume.
  -> (Map.Map String Text) -- ^ 'volumeOptions': The driver specific options used when creating the volume.
  -> Text -- ^ 'volumeScope': The level at which the volume exists. Either `global` for cluster-wide, or `local` for machine level.
  -> Volume
mkVolume :: Text
-> Map String Text
-> Text
-> Text
-> Map String Text
-> Text
-> Volume
mkVolume Text
volumeDriver Map String Text
volumeLabels Text
volumeMountpoint Text
volumeName Map String Text
volumeOptions Text
volumeScope =
  Volume :: Maybe Text
-> Text
-> Map String Text
-> Text
-> Text
-> Map String Text
-> Text
-> Maybe Value
-> Maybe VolumeUsageData
-> Volume
Volume
  { volumeCreatedAt :: Maybe Text
volumeCreatedAt = Maybe Text
forall a. Maybe a
Nothing
  , Text
volumeDriver :: Text
volumeDriver :: Text
volumeDriver
  , Map String Text
volumeLabels :: Map String Text
volumeLabels :: Map String Text
volumeLabels
  , Text
volumeMountpoint :: Text
volumeMountpoint :: Text
volumeMountpoint
  , Text
volumeName :: Text
volumeName :: Text
volumeName
  , Map String Text
volumeOptions :: Map String Text
volumeOptions :: Map String Text
volumeOptions
  , Text
volumeScope :: Text
volumeScope :: Text
volumeScope
  , volumeStatus :: Maybe Value
volumeStatus = Maybe Value
forall a. Maybe a
Nothing
  , volumeUsageData :: Maybe VolumeUsageData
volumeUsageData = Maybe VolumeUsageData
forall a. Maybe a
Nothing
  }

-- ** VolumeUsageData
-- | VolumeUsageData
-- VolumeUsageData Usage details about the volume. This information is used by the `GET /system/df` endpoint, and omitted in other endpoints.
data VolumeUsageData = VolumeUsageData
  { VolumeUsageData -> Integer
volumeUsageDataRefCount :: Integer -- ^ /Required/ "RefCount" - The number of containers referencing this volume. This field is set to &#x60;-1&#x60; if the reference-count is not available.
  , VolumeUsageData -> Integer
volumeUsageDataSize :: Integer -- ^ /Required/ "Size" - Amount of disk space used by the volume (in bytes). This information is only available for volumes created with the &#x60;\&quot;local\&quot;&#x60; volume driver. For volumes created with other volume drivers, this field is set to &#x60;-1&#x60; (\&quot;not available\&quot;)
  } deriving (Int -> VolumeUsageData -> ShowS
[VolumeUsageData] -> ShowS
VolumeUsageData -> String
(Int -> VolumeUsageData -> ShowS)
-> (VolumeUsageData -> String)
-> ([VolumeUsageData] -> ShowS)
-> Show VolumeUsageData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VolumeUsageData] -> ShowS
$cshowList :: [VolumeUsageData] -> ShowS
show :: VolumeUsageData -> String
$cshow :: VolumeUsageData -> String
showsPrec :: Int -> VolumeUsageData -> ShowS
$cshowsPrec :: Int -> VolumeUsageData -> ShowS
P.Show, VolumeUsageData -> VolumeUsageData -> Bool
(VolumeUsageData -> VolumeUsageData -> Bool)
-> (VolumeUsageData -> VolumeUsageData -> Bool)
-> Eq VolumeUsageData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VolumeUsageData -> VolumeUsageData -> Bool
$c/= :: VolumeUsageData -> VolumeUsageData -> Bool
== :: VolumeUsageData -> VolumeUsageData -> Bool
$c== :: VolumeUsageData -> VolumeUsageData -> Bool
P.Eq, P.Typeable)

-- | FromJSON VolumeUsageData
instance A.FromJSON VolumeUsageData where
  parseJSON :: Value -> Parser VolumeUsageData
parseJSON = String
-> (Object -> Parser VolumeUsageData)
-> Value
-> Parser VolumeUsageData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"VolumeUsageData" ((Object -> Parser VolumeUsageData)
 -> Value -> Parser VolumeUsageData)
-> (Object -> Parser VolumeUsageData)
-> Value
-> Parser VolumeUsageData
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Integer -> Integer -> VolumeUsageData
VolumeUsageData
      (Integer -> Integer -> VolumeUsageData)
-> Parser Integer -> Parser (Integer -> VolumeUsageData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"RefCount")
      Parser (Integer -> VolumeUsageData)
-> Parser Integer -> Parser VolumeUsageData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Size")

-- | ToJSON VolumeUsageData
instance A.ToJSON VolumeUsageData where
  toJSON :: VolumeUsageData -> Value
toJSON VolumeUsageData {Integer
volumeUsageDataSize :: Integer
volumeUsageDataRefCount :: Integer
volumeUsageDataSize :: VolumeUsageData -> Integer
volumeUsageDataRefCount :: VolumeUsageData -> Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"RefCount" Key -> Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
volumeUsageDataRefCount
      , Key
"Size" Key -> Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
volumeUsageDataSize
      ]


-- | Construct a value of type 'VolumeUsageData' (by applying it's required fields, if any)
mkVolumeUsageData
  :: Integer -- ^ 'volumeUsageDataRefCount': The number of containers referencing this volume. This field is set to `-1` if the reference-count is not available.
  -> Integer -- ^ 'volumeUsageDataSize': Amount of disk space used by the volume (in bytes). This information is only available for volumes created with the `\"local\"` volume driver. For volumes created with other volume drivers, this field is set to `-1` (\"not available\")
  -> VolumeUsageData
mkVolumeUsageData :: Integer -> Integer -> VolumeUsageData
mkVolumeUsageData Integer
volumeUsageDataRefCount Integer
volumeUsageDataSize =
  VolumeUsageData :: Integer -> Integer -> VolumeUsageData
VolumeUsageData
  { Integer
volumeUsageDataRefCount :: Integer
volumeUsageDataRefCount :: Integer
volumeUsageDataRefCount
  , Integer
volumeUsageDataSize :: Integer
volumeUsageDataSize :: Integer
volumeUsageDataSize
  }

-- ** WellKnown
-- | WellKnown
-- WellKnown represents important OpenID Connect discovery metadata
-- 
-- It includes links to several endpoints (e.g. /oauth2/token) and exposes information on supported signature algorithms among others.
data WellKnown = WellKnown
  { WellKnown -> Text
wellKnownAuthorizationEndpoint :: Text -- ^ /Required/ "authorization_endpoint" - URL of the OP&#39;s OAuth 2.0 Authorization Endpoint.
  , WellKnown -> Maybe Bool
wellKnownBackchannelLogoutSessionSupported :: Maybe Bool -- ^ "backchannel_logout_session_supported" - 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
  , WellKnown -> Maybe Bool
wellKnownBackchannelLogoutSupported :: Maybe Bool -- ^ "backchannel_logout_supported" - Boolean value specifying whether the OP supports back-channel logout, with true indicating support.
  , WellKnown -> Maybe Bool
wellKnownClaimsParameterSupported :: Maybe Bool -- ^ "claims_parameter_supported" - Boolean value specifying whether the OP supports use of the claims parameter, with true indicating support.
  , WellKnown -> Maybe [Text]
wellKnownClaimsSupported :: Maybe [Text] -- ^ "claims_supported" - 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.
  , WellKnown -> Maybe Text
wellKnownEndSessionEndpoint :: Maybe Text -- ^ "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.
  , WellKnown -> Maybe Bool
wellKnownFrontchannelLogoutSessionSupported :: Maybe Bool -- ^ "frontchannel_logout_session_supported" - 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.
  , WellKnown -> Maybe Bool
wellKnownFrontchannelLogoutSupported :: Maybe Bool -- ^ "frontchannel_logout_supported" - Boolean value specifying whether the OP supports HTTP-based logout, with true indicating support.
  , WellKnown -> Maybe [Text]
wellKnownGrantTypesSupported :: Maybe [Text] -- ^ "grant_types_supported" - JSON array containing a list of the OAuth 2.0 Grant Type values that this OP supports.
  , WellKnown -> [Text]
wellKnownIdTokenSigningAlgValuesSupported :: [Text] -- ^ /Required/ "id_token_signing_alg_values_supported" - 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.
  , WellKnown -> Text
wellKnownIssuer :: Text -- ^ /Required/ "issuer" - 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.
  , WellKnown -> Text
wellKnownJwksUri :: Text -- ^ /Required/ "jwks_uri" - 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.
  , WellKnown -> Maybe Text
wellKnownRegistrationEndpoint :: Maybe Text -- ^ "registration_endpoint" - URL of the OP&#39;s Dynamic Client Registration Endpoint.
  , WellKnown -> Maybe [Text]
wellKnownRequestObjectSigningAlgValuesSupported :: Maybe [Text] -- ^ "request_object_signing_alg_values_supported" - 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).
  , WellKnown -> Maybe Bool
wellKnownRequestParameterSupported :: Maybe Bool -- ^ "request_parameter_supported" - Boolean value specifying whether the OP supports use of the request parameter, with true indicating support.
  , WellKnown -> Maybe Bool
wellKnownRequestUriParameterSupported :: Maybe Bool -- ^ "request_uri_parameter_supported" - Boolean value specifying whether the OP supports use of the request_uri parameter, with true indicating support.
  , WellKnown -> Maybe Bool
wellKnownRequireRequestUriRegistration :: Maybe Bool -- ^ "require_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.
  , WellKnown -> Maybe [Text]
wellKnownResponseModesSupported :: Maybe [Text] -- ^ "response_modes_supported" - JSON array containing a list of the OAuth 2.0 response_mode values that this OP supports.
  , WellKnown -> [Text]
wellKnownResponseTypesSupported :: [Text] -- ^ /Required/ "response_types_supported" - 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.
  , WellKnown -> Maybe Text
wellKnownRevocationEndpoint :: Maybe Text -- ^ "revocation_endpoint" - URL of the authorization server&#39;s OAuth 2.0 revocation endpoint.
  , WellKnown -> Maybe [Text]
wellKnownScopesSupported :: Maybe [Text] -- ^ "scopes_supported" - SON 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
  , WellKnown -> [Text]
wellKnownSubjectTypesSupported :: [Text] -- ^ /Required/ "subject_types_supported" - JSON array containing a list of the Subject Identifier types that this OP supports. Valid types include pairwise and public.
  , WellKnown -> Text
wellKnownTokenEndpoint :: Text -- ^ /Required/ "token_endpoint" - URL of the OP&#39;s OAuth 2.0 Token Endpoint
  , WellKnown -> Maybe [Text]
wellKnownTokenEndpointAuthMethodsSupported :: Maybe [Text] -- ^ "token_endpoint_auth_methods_supported" - 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
  , WellKnown -> Maybe Text
wellKnownUserinfoEndpoint :: Maybe Text -- ^ "userinfo_endpoint" - URL of the OP&#39;s UserInfo Endpoint.
  , WellKnown -> Maybe [Text]
wellKnownUserinfoSigningAlgValuesSupported :: Maybe [Text] -- ^ "userinfo_signing_alg_values_supported" - 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 -> WellKnown -> ShowS
[WellKnown] -> ShowS
WellKnown -> String
(Int -> WellKnown -> ShowS)
-> (WellKnown -> String)
-> ([WellKnown] -> ShowS)
-> Show WellKnown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WellKnown] -> ShowS
$cshowList :: [WellKnown] -> ShowS
show :: WellKnown -> String
$cshow :: WellKnown -> String
showsPrec :: Int -> WellKnown -> ShowS
$cshowsPrec :: Int -> WellKnown -> ShowS
P.Show, WellKnown -> WellKnown -> Bool
(WellKnown -> WellKnown -> Bool)
-> (WellKnown -> WellKnown -> Bool) -> Eq WellKnown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WellKnown -> WellKnown -> Bool
$c/= :: WellKnown -> WellKnown -> Bool
== :: WellKnown -> WellKnown -> Bool
$c== :: WellKnown -> WellKnown -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON WellKnown
instance A.ToJSON WellKnown where
  toJSON :: WellKnown -> Value
toJSON WellKnown {[Text]
Maybe Bool
Maybe [Text]
Maybe Text
Text
wellKnownUserinfoSigningAlgValuesSupported :: Maybe [Text]
wellKnownUserinfoEndpoint :: Maybe Text
wellKnownTokenEndpointAuthMethodsSupported :: Maybe [Text]
wellKnownTokenEndpoint :: Text
wellKnownSubjectTypesSupported :: [Text]
wellKnownScopesSupported :: Maybe [Text]
wellKnownRevocationEndpoint :: Maybe Text
wellKnownResponseTypesSupported :: [Text]
wellKnownResponseModesSupported :: Maybe [Text]
wellKnownRequireRequestUriRegistration :: Maybe Bool
wellKnownRequestUriParameterSupported :: Maybe Bool
wellKnownRequestParameterSupported :: Maybe Bool
wellKnownRequestObjectSigningAlgValuesSupported :: Maybe [Text]
wellKnownRegistrationEndpoint :: Maybe Text
wellKnownJwksUri :: Text
wellKnownIssuer :: Text
wellKnownIdTokenSigningAlgValuesSupported :: [Text]
wellKnownGrantTypesSupported :: Maybe [Text]
wellKnownFrontchannelLogoutSupported :: Maybe Bool
wellKnownFrontchannelLogoutSessionSupported :: Maybe Bool
wellKnownEndSessionEndpoint :: Maybe Text
wellKnownClaimsSupported :: Maybe [Text]
wellKnownClaimsParameterSupported :: Maybe Bool
wellKnownBackchannelLogoutSupported :: Maybe Bool
wellKnownBackchannelLogoutSessionSupported :: Maybe Bool
wellKnownAuthorizationEndpoint :: Text
wellKnownUserinfoSigningAlgValuesSupported :: WellKnown -> Maybe [Text]
wellKnownUserinfoEndpoint :: WellKnown -> Maybe Text
wellKnownTokenEndpointAuthMethodsSupported :: WellKnown -> Maybe [Text]
wellKnownTokenEndpoint :: WellKnown -> Text
wellKnownSubjectTypesSupported :: WellKnown -> [Text]
wellKnownScopesSupported :: WellKnown -> Maybe [Text]
wellKnownRevocationEndpoint :: WellKnown -> Maybe Text
wellKnownResponseTypesSupported :: WellKnown -> [Text]
wellKnownResponseModesSupported :: WellKnown -> Maybe [Text]
wellKnownRequireRequestUriRegistration :: WellKnown -> Maybe Bool
wellKnownRequestUriParameterSupported :: WellKnown -> Maybe Bool
wellKnownRequestParameterSupported :: WellKnown -> Maybe Bool
wellKnownRequestObjectSigningAlgValuesSupported :: WellKnown -> Maybe [Text]
wellKnownRegistrationEndpoint :: WellKnown -> Maybe Text
wellKnownJwksUri :: WellKnown -> Text
wellKnownIssuer :: WellKnown -> Text
wellKnownIdTokenSigningAlgValuesSupported :: WellKnown -> [Text]
wellKnownGrantTypesSupported :: WellKnown -> Maybe [Text]
wellKnownFrontchannelLogoutSupported :: WellKnown -> Maybe Bool
wellKnownFrontchannelLogoutSessionSupported :: WellKnown -> Maybe Bool
wellKnownEndSessionEndpoint :: WellKnown -> Maybe Text
wellKnownClaimsSupported :: WellKnown -> Maybe [Text]
wellKnownClaimsParameterSupported :: WellKnown -> Maybe Bool
wellKnownBackchannelLogoutSupported :: WellKnown -> Maybe Bool
wellKnownBackchannelLogoutSessionSupported :: WellKnown -> Maybe Bool
wellKnownAuthorizationEndpoint :: WellKnown -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"authorization_endpoint" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
wellKnownAuthorizationEndpoint
      , Key
"backchannel_logout_session_supported" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownBackchannelLogoutSessionSupported
      , Key
"backchannel_logout_supported" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownBackchannelLogoutSupported
      , Key
"claims_parameter_supported" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownClaimsParameterSupported
      , Key
"claims_supported" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
wellKnownClaimsSupported
      , Key
"end_session_endpoint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
wellKnownEndSessionEndpoint
      , Key
"frontchannel_logout_session_supported" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownFrontchannelLogoutSessionSupported
      , Key
"frontchannel_logout_supported" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownFrontchannelLogoutSupported
      , Key
"grant_types_supported" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
wellKnownGrantTypesSupported
      , Key
"id_token_signing_alg_values_supported" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
wellKnownIdTokenSigningAlgValuesSupported
      , Key
"issuer" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
wellKnownIssuer
      , Key
"jwks_uri" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
wellKnownJwksUri
      , Key
"registration_endpoint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
wellKnownRegistrationEndpoint
      , Key
"request_object_signing_alg_values_supported" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
wellKnownRequestObjectSigningAlgValuesSupported
      , Key
"request_parameter_supported" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownRequestParameterSupported
      , Key
"request_uri_parameter_supported" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownRequestUriParameterSupported
      , Key
"require_request_uri_registration" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
wellKnownRequireRequestUriRegistration
      , Key
"response_modes_supported" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
wellKnownResponseModesSupported
      , Key
"response_types_supported" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
wellKnownResponseTypesSupported
      , Key
"revocation_endpoint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
wellKnownRevocationEndpoint
      , Key
"scopes_supported" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
wellKnownScopesSupported
      , Key
"subject_types_supported" Key -> [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
wellKnownSubjectTypesSupported
      , Key
"token_endpoint" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
wellKnownTokenEndpoint
      , Key
"token_endpoint_auth_methods_supported" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
wellKnownTokenEndpointAuthMethodsSupported
      , Key
"userinfo_endpoint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
wellKnownUserinfoEndpoint
      , Key
"userinfo_signing_alg_values_supported" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
wellKnownUserinfoSigningAlgValuesSupported
      ]


-- | Construct a value of type 'WellKnown' (by applying it's required fields, if any)
mkWellKnown
  :: Text -- ^ 'wellKnownAuthorizationEndpoint': URL of the OP's OAuth 2.0 Authorization Endpoint.
  -> [Text] -- ^ 'wellKnownIdTokenSigningAlgValuesSupported': 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 -- ^ 'wellKnownIssuer': 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 -- ^ 'wellKnownJwksUri': 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] -- ^ 'wellKnownResponseTypesSupported': 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] -- ^ 'wellKnownSubjectTypesSupported': JSON array containing a list of the Subject Identifier types that this OP supports. Valid types include pairwise and public.
  -> Text -- ^ 'wellKnownTokenEndpoint': URL of the OP's OAuth 2.0 Token Endpoint
  -> WellKnown
mkWellKnown :: Text
-> [Text] -> Text -> Text -> [Text] -> [Text] -> Text -> WellKnown
mkWellKnown Text
wellKnownAuthorizationEndpoint [Text]
wellKnownIdTokenSigningAlgValuesSupported Text
wellKnownIssuer Text
wellKnownJwksUri [Text]
wellKnownResponseTypesSupported [Text]
wellKnownSubjectTypesSupported Text
wellKnownTokenEndpoint =
  WellKnown :: Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe [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
-> Maybe [Text]
-> WellKnown
WellKnown
  { Text
wellKnownAuthorizationEndpoint :: Text
wellKnownAuthorizationEndpoint :: Text
wellKnownAuthorizationEndpoint
  , wellKnownBackchannelLogoutSessionSupported :: Maybe Bool
wellKnownBackchannelLogoutSessionSupported = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownBackchannelLogoutSupported :: Maybe Bool
wellKnownBackchannelLogoutSupported = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownClaimsParameterSupported :: Maybe Bool
wellKnownClaimsParameterSupported = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownClaimsSupported :: Maybe [Text]
wellKnownClaimsSupported = Maybe [Text]
forall a. Maybe a
Nothing
  , wellKnownEndSessionEndpoint :: Maybe Text
wellKnownEndSessionEndpoint = Maybe Text
forall a. Maybe a
Nothing
  , wellKnownFrontchannelLogoutSessionSupported :: Maybe Bool
wellKnownFrontchannelLogoutSessionSupported = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownFrontchannelLogoutSupported :: Maybe Bool
wellKnownFrontchannelLogoutSupported = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownGrantTypesSupported :: Maybe [Text]
wellKnownGrantTypesSupported = Maybe [Text]
forall a. Maybe a
Nothing
  , [Text]
wellKnownIdTokenSigningAlgValuesSupported :: [Text]
wellKnownIdTokenSigningAlgValuesSupported :: [Text]
wellKnownIdTokenSigningAlgValuesSupported
  , Text
wellKnownIssuer :: Text
wellKnownIssuer :: Text
wellKnownIssuer
  , Text
wellKnownJwksUri :: Text
wellKnownJwksUri :: Text
wellKnownJwksUri
  , wellKnownRegistrationEndpoint :: Maybe Text
wellKnownRegistrationEndpoint = Maybe Text
forall a. Maybe a
Nothing
  , wellKnownRequestObjectSigningAlgValuesSupported :: Maybe [Text]
wellKnownRequestObjectSigningAlgValuesSupported = Maybe [Text]
forall a. Maybe a
Nothing
  , wellKnownRequestParameterSupported :: Maybe Bool
wellKnownRequestParameterSupported = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownRequestUriParameterSupported :: Maybe Bool
wellKnownRequestUriParameterSupported = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownRequireRequestUriRegistration :: Maybe Bool
wellKnownRequireRequestUriRegistration = Maybe Bool
forall a. Maybe a
Nothing
  , wellKnownResponseModesSupported :: Maybe [Text]
wellKnownResponseModesSupported = Maybe [Text]
forall a. Maybe a
Nothing
  , [Text]
wellKnownResponseTypesSupported :: [Text]
wellKnownResponseTypesSupported :: [Text]
wellKnownResponseTypesSupported
  , wellKnownRevocationEndpoint :: Maybe Text
wellKnownRevocationEndpoint = Maybe Text
forall a. Maybe a
Nothing
  , wellKnownScopesSupported :: Maybe [Text]
wellKnownScopesSupported = Maybe [Text]
forall a. Maybe a
Nothing
  , [Text]
wellKnownSubjectTypesSupported :: [Text]
wellKnownSubjectTypesSupported :: [Text]
wellKnownSubjectTypesSupported
  , Text
wellKnownTokenEndpoint :: Text
wellKnownTokenEndpoint :: Text
wellKnownTokenEndpoint
  , wellKnownTokenEndpointAuthMethodsSupported :: Maybe [Text]
wellKnownTokenEndpointAuthMethodsSupported = Maybe [Text]
forall a. Maybe a
Nothing
  , wellKnownUserinfoEndpoint :: Maybe Text
wellKnownUserinfoEndpoint = Maybe Text
forall a. Maybe a
Nothing
  , wellKnownUserinfoSigningAlgValuesSupported :: Maybe [Text]
wellKnownUserinfoSigningAlgValuesSupported = Maybe [Text]
forall a. Maybe a
Nothing
  }




-- * Auth Methods

-- ** AuthBasicBasic
data AuthBasicBasic =
  AuthBasicBasic B.ByteString B.ByteString -- ^ username password
  deriving (AuthBasicBasic -> AuthBasicBasic -> Bool
(AuthBasicBasic -> AuthBasicBasic -> Bool)
-> (AuthBasicBasic -> AuthBasicBasic -> Bool) -> Eq AuthBasicBasic
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
(Int -> AuthBasicBasic -> ShowS)
-> (AuthBasicBasic -> String)
-> ([AuthBasicBasic] -> ShowS)
-> Show AuthBasicBasic
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 :: 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 =
    ORYHydraRequest req contentType res accept
-> IO (ORYHydraRequest req contentType res accept)
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (ORYHydraRequest req contentType res accept
 -> IO (ORYHydraRequest req contentType res accept))
-> ORYHydraRequest req contentType res accept
-> IO (ORYHydraRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthBasicBasic -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBasic
a TypeRep -> [TypeRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` ORYHydraRequest req contentType res accept -> [TypeRep]
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 ORYHydraRequest req contentType res accept
-> [Header] -> ORYHydraRequest req contentType res accept
forall req contentType res accept.
ORYHydraRequest req contentType res accept
-> [Header] -> ORYHydraRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", ByteString -> Text
T.decodeUtf8 ByteString
cred)
           ORYHydraRequest req contentType res accept
-> (ORYHydraRequest req contentType res accept
    -> ORYHydraRequest req contentType res accept)
-> ORYHydraRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (ORYHydraRequest req contentType res accept)
  (ORYHydraRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> ORYHydraRequest req contentType res accept
-> ORYHydraRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (ORYHydraRequest req contentType res accept)
  (ORYHydraRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept.
Lens_' (ORYHydraRequest req contentType res accept) [TypeRep]
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthBasicBasic -> TypeRep
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 (ByteString -> ByteString) -> ByteString -> ByteString
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
(AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool)
-> (AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool)
-> Eq AuthOAuthOauth2
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
(Int -> AuthOAuthOauth2 -> ShowS)
-> (AuthOAuthOauth2 -> String)
-> ([AuthOAuthOauth2] -> ShowS)
-> Show AuthOAuthOauth2
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 :: 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 =
    ORYHydraRequest req contentType res accept
-> IO (ORYHydraRequest req contentType res accept)
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (ORYHydraRequest req contentType res accept
 -> IO (ORYHydraRequest req contentType res accept))
-> ORYHydraRequest req contentType res accept
-> IO (ORYHydraRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthOAuthOauth2 -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthOAuthOauth2
a TypeRep -> [TypeRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` ORYHydraRequest req contentType res accept -> [TypeRep]
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 ORYHydraRequest req contentType res accept
-> [Header] -> ORYHydraRequest req contentType res accept
forall req contentType res accept.
ORYHydraRequest req contentType res accept
-> [Header] -> ORYHydraRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", Text
"Bearer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
secret)
           ORYHydraRequest req contentType res accept
-> (ORYHydraRequest req contentType res accept
    -> ORYHydraRequest req contentType res accept)
-> ORYHydraRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (ORYHydraRequest req contentType res accept)
  (ORYHydraRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> ORYHydraRequest req contentType res accept
-> ORYHydraRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (ORYHydraRequest req contentType res accept)
  (ORYHydraRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept.
Lens_' (ORYHydraRequest req contentType res accept) [TypeRep]
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthOAuthOauth2 -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthOAuthOauth2
a))
      else ORYHydraRequest req contentType res accept
req