{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.User.Client.DPoPAccessToken where

import Data.Aeson (FromJSON, ToJSON)
import Data.ByteString (fromStrict)
import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString', toByteString')
import Data.OpenApi qualified as S
import Data.OpenApi.ParamSchema (ToParamSchema (..))
import Data.SOP
import Data.Schema
import Data.Text as T
import Data.Text.Encoding
import Data.Text.Encoding.Error
import Imports
import Servant (FromHttpApiData (..), ToHttpApiData (..))

newtype Proof = Proof {Proof -> ByteString
unProof :: ByteString}
  deriving (Proof -> Proof -> Bool
(Proof -> Proof -> Bool) -> (Proof -> Proof -> Bool) -> Eq Proof
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Proof -> Proof -> Bool
== :: Proof -> Proof -> Bool
$c/= :: Proof -> Proof -> Bool
/= :: Proof -> Proof -> Bool
Eq, Int -> Proof -> ShowS
[Proof] -> ShowS
Proof -> String
(Int -> Proof -> ShowS)
-> (Proof -> String) -> ([Proof] -> ShowS) -> Show Proof
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Proof -> ShowS
showsPrec :: Int -> Proof -> ShowS
$cshow :: Proof -> String
show :: Proof -> String
$cshowList :: [Proof] -> ShowS
showList :: [Proof] -> ShowS
Show, (forall x. Proof -> Rep Proof x)
-> (forall x. Rep Proof x -> Proof) -> Generic Proof
forall x. Rep Proof x -> Proof
forall x. Proof -> Rep Proof x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Proof -> Rep Proof x
from :: forall x. Proof -> Rep Proof x
$cto :: forall x. Rep Proof x -> Proof
to :: forall x. Rep Proof x -> Proof
Generic)
  deriving newtype (Parser Proof
Parser Proof -> FromByteString Proof
forall a. Parser a -> FromByteString a
$cparser :: Parser Proof
parser :: Parser Proof
FromByteString, Proof -> Builder
(Proof -> Builder) -> ToByteString Proof
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: Proof -> Builder
builder :: Proof -> Builder
ToByteString)

instance ToHttpApiData Proof where
  toQueryParam :: Proof -> Text
toQueryParam = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> (Proof -> ByteString) -> Proof -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance FromHttpApiData Proof where
  parseQueryParam :: Text -> Either Text Proof
parseQueryParam =
    Either Text Proof
-> (Proof -> Either Text Proof) -> Maybe Proof -> Either Text Proof
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Proof
forall a b. a -> Either a b
Left Text
"Invalid Proof") Proof -> Either Text Proof
forall a b. b -> Either a b
Right
      (Maybe Proof -> Either Text Proof)
-> (Text -> Maybe Proof) -> Text -> Either Text Proof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Proof
forall a. FromByteString a => ByteString -> Maybe a
fromByteString'
      (ByteString -> Maybe Proof)
-> (Text -> ByteString) -> Text -> Maybe Proof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
      (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance ToParamSchema Proof where
  toParamSchema :: Proxy Proof -> Schema
toParamSchema Proxy Proof
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

newtype DPoPAccessToken = DPoPAccessToken {DPoPAccessToken -> ByteString
unDPoPAccessToken :: ByteString}
  deriving (DPoPAccessToken -> DPoPAccessToken -> Bool
(DPoPAccessToken -> DPoPAccessToken -> Bool)
-> (DPoPAccessToken -> DPoPAccessToken -> Bool)
-> Eq DPoPAccessToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DPoPAccessToken -> DPoPAccessToken -> Bool
== :: DPoPAccessToken -> DPoPAccessToken -> Bool
$c/= :: DPoPAccessToken -> DPoPAccessToken -> Bool
/= :: DPoPAccessToken -> DPoPAccessToken -> Bool
Eq, Int -> DPoPAccessToken -> ShowS
[DPoPAccessToken] -> ShowS
DPoPAccessToken -> String
(Int -> DPoPAccessToken -> ShowS)
-> (DPoPAccessToken -> String)
-> ([DPoPAccessToken] -> ShowS)
-> Show DPoPAccessToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DPoPAccessToken -> ShowS
showsPrec :: Int -> DPoPAccessToken -> ShowS
$cshow :: DPoPAccessToken -> String
show :: DPoPAccessToken -> String
$cshowList :: [DPoPAccessToken] -> ShowS
showList :: [DPoPAccessToken] -> ShowS
Show, (forall x. DPoPAccessToken -> Rep DPoPAccessToken x)
-> (forall x. Rep DPoPAccessToken x -> DPoPAccessToken)
-> Generic DPoPAccessToken
forall x. Rep DPoPAccessToken x -> DPoPAccessToken
forall x. DPoPAccessToken -> Rep DPoPAccessToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DPoPAccessToken -> Rep DPoPAccessToken x
from :: forall x. DPoPAccessToken -> Rep DPoPAccessToken x
$cto :: forall x. Rep DPoPAccessToken x -> DPoPAccessToken
to :: forall x. Rep DPoPAccessToken x -> DPoPAccessToken
Generic)
  deriving newtype (Parser DPoPAccessToken
Parser DPoPAccessToken -> FromByteString DPoPAccessToken
forall a. Parser a -> FromByteString a
$cparser :: Parser DPoPAccessToken
parser :: Parser DPoPAccessToken
FromByteString, DPoPAccessToken -> Builder
(DPoPAccessToken -> Builder) -> ToByteString DPoPAccessToken
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: DPoPAccessToken -> Builder
builder :: DPoPAccessToken -> Builder
ToByteString)
  deriving (Value -> Parser [DPoPAccessToken]
Value -> Parser DPoPAccessToken
(Value -> Parser DPoPAccessToken)
-> (Value -> Parser [DPoPAccessToken]) -> FromJSON DPoPAccessToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DPoPAccessToken
parseJSON :: Value -> Parser DPoPAccessToken
$cparseJSONList :: Value -> Parser [DPoPAccessToken]
parseJSONList :: Value -> Parser [DPoPAccessToken]
FromJSON, [DPoPAccessToken] -> Value
[DPoPAccessToken] -> Encoding
DPoPAccessToken -> Value
DPoPAccessToken -> Encoding
(DPoPAccessToken -> Value)
-> (DPoPAccessToken -> Encoding)
-> ([DPoPAccessToken] -> Value)
-> ([DPoPAccessToken] -> Encoding)
-> ToJSON DPoPAccessToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DPoPAccessToken -> Value
toJSON :: DPoPAccessToken -> Value
$ctoEncoding :: DPoPAccessToken -> Encoding
toEncoding :: DPoPAccessToken -> Encoding
$ctoJSONList :: [DPoPAccessToken] -> Value
toJSONList :: [DPoPAccessToken] -> Value
$ctoEncodingList :: [DPoPAccessToken] -> Encoding
toEncodingList :: [DPoPAccessToken] -> Encoding
ToJSON, Typeable DPoPAccessToken
Typeable DPoPAccessToken =>
(Proxy DPoPAccessToken -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DPoPAccessToken
Proxy DPoPAccessToken -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy DPoPAccessToken -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DPoPAccessToken -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema DPoPAccessToken)

instance ToSchema DPoPAccessToken where
  schema :: ValueSchema NamedSwaggerDoc DPoPAccessToken
schema = (ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (DPoPAccessToken -> ByteString) -> DPoPAccessToken -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPoPAccessToken -> ByteString
unDPoPAccessToken) (DPoPAccessToken -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text DPoPAccessToken
-> ValueSchema NamedSwaggerDoc DPoPAccessToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Text -> DPoPAccessToken)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value Text DPoPAccessToken
forall a b.
(a -> b)
-> SchemaP NamedSwaggerDoc Value Value Text a
-> SchemaP NamedSwaggerDoc Value Value Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> DPoPAccessToken
DPoPAccessToken (ByteString -> DPoPAccessToken)
-> (Text -> ByteString) -> Text -> DPoPAccessToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) (Text -> SchemaP NamedSwaggerDoc Value Value Text Text
text Text
"DPoPAccessToken")

instance ToParamSchema DPoPAccessToken where
  toParamSchema :: Proxy DPoPAccessToken -> Schema
toParamSchema Proxy DPoPAccessToken
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance ToHttpApiData DPoPAccessToken where
  toQueryParam :: DPoPAccessToken -> Text
toQueryParam = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (DPoPAccessToken -> ByteString) -> DPoPAccessToken -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPoPAccessToken -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance FromHttpApiData DPoPAccessToken where
  parseQueryParam :: Text -> Either Text DPoPAccessToken
parseQueryParam =
    Either Text DPoPAccessToken
-> (DPoPAccessToken -> Either Text DPoPAccessToken)
-> Maybe DPoPAccessToken
-> Either Text DPoPAccessToken
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text DPoPAccessToken
forall a b. a -> Either a b
Left Text
"Invalid DPoPAccessToken") DPoPAccessToken -> Either Text DPoPAccessToken
forall a b. b -> Either a b
Right
      (Maybe DPoPAccessToken -> Either Text DPoPAccessToken)
-> (Text -> Maybe DPoPAccessToken)
-> Text
-> Either Text DPoPAccessToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe DPoPAccessToken
forall a. FromByteString a => ByteString -> Maybe a
fromByteString'
      (ByteString -> Maybe DPoPAccessToken)
-> (Text -> ByteString) -> Text -> Maybe DPoPAccessToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
      (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

data AccessTokenType = DPoP
  deriving (AccessTokenType -> AccessTokenType -> Bool
(AccessTokenType -> AccessTokenType -> Bool)
-> (AccessTokenType -> AccessTokenType -> Bool)
-> Eq AccessTokenType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessTokenType -> AccessTokenType -> Bool
== :: AccessTokenType -> AccessTokenType -> Bool
$c/= :: AccessTokenType -> AccessTokenType -> Bool
/= :: AccessTokenType -> AccessTokenType -> Bool
Eq, Int -> AccessTokenType -> ShowS
[AccessTokenType] -> ShowS
AccessTokenType -> String
(Int -> AccessTokenType -> ShowS)
-> (AccessTokenType -> String)
-> ([AccessTokenType] -> ShowS)
-> Show AccessTokenType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessTokenType -> ShowS
showsPrec :: Int -> AccessTokenType -> ShowS
$cshow :: AccessTokenType -> String
show :: AccessTokenType -> String
$cshowList :: [AccessTokenType] -> ShowS
showList :: [AccessTokenType] -> ShowS
Show, (forall x. AccessTokenType -> Rep AccessTokenType x)
-> (forall x. Rep AccessTokenType x -> AccessTokenType)
-> Generic AccessTokenType
forall x. Rep AccessTokenType x -> AccessTokenType
forall x. AccessTokenType -> Rep AccessTokenType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccessTokenType -> Rep AccessTokenType x
from :: forall x. AccessTokenType -> Rep AccessTokenType x
$cto :: forall x. Rep AccessTokenType x -> AccessTokenType
to :: forall x. Rep AccessTokenType x -> AccessTokenType
Generic)
  deriving (Value -> Parser [AccessTokenType]
Value -> Parser AccessTokenType
(Value -> Parser AccessTokenType)
-> (Value -> Parser [AccessTokenType]) -> FromJSON AccessTokenType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AccessTokenType
parseJSON :: Value -> Parser AccessTokenType
$cparseJSONList :: Value -> Parser [AccessTokenType]
parseJSONList :: Value -> Parser [AccessTokenType]
FromJSON, [AccessTokenType] -> Value
[AccessTokenType] -> Encoding
AccessTokenType -> Value
AccessTokenType -> Encoding
(AccessTokenType -> Value)
-> (AccessTokenType -> Encoding)
-> ([AccessTokenType] -> Value)
-> ([AccessTokenType] -> Encoding)
-> ToJSON AccessTokenType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AccessTokenType -> Value
toJSON :: AccessTokenType -> Value
$ctoEncoding :: AccessTokenType -> Encoding
toEncoding :: AccessTokenType -> Encoding
$ctoJSONList :: [AccessTokenType] -> Value
toJSONList :: [AccessTokenType] -> Value
$ctoEncodingList :: [AccessTokenType] -> Encoding
toEncodingList :: [AccessTokenType] -> Encoding
ToJSON, Typeable AccessTokenType
Typeable AccessTokenType =>
(Proxy AccessTokenType -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AccessTokenType
Proxy AccessTokenType -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AccessTokenType -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AccessTokenType -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema AccessTokenType)

instance ToSchema AccessTokenType where
  schema :: ValueSchema NamedSwaggerDoc AccessTokenType
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"AccessTokenType" (SchemaP
   [Value] Text (Alt Maybe Text) AccessTokenType AccessTokenType
 -> ValueSchema NamedSwaggerDoc AccessTokenType)
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessTokenType AccessTokenType
-> ValueSchema NamedSwaggerDoc AccessTokenType
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value] Text (Alt Maybe Text) AccessTokenType AccessTokenType]
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessTokenType AccessTokenType
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> AccessTokenType
-> SchemaP
     [Value] Text (Alt Maybe Text) AccessTokenType AccessTokenType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"DPoP" AccessTokenType
DPoP
        ]

data DPoPAccessTokenResponse = DPoPAccessTokenResponse
  { DPoPAccessTokenResponse -> DPoPAccessToken
datrToken :: DPoPAccessToken,
    DPoPAccessTokenResponse -> AccessTokenType
datrType :: AccessTokenType,
    DPoPAccessTokenResponse -> Word64
datrExpiresIn :: Word64
  }
  deriving (DPoPAccessTokenResponse -> DPoPAccessTokenResponse -> Bool
(DPoPAccessTokenResponse -> DPoPAccessTokenResponse -> Bool)
-> (DPoPAccessTokenResponse -> DPoPAccessTokenResponse -> Bool)
-> Eq DPoPAccessTokenResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DPoPAccessTokenResponse -> DPoPAccessTokenResponse -> Bool
== :: DPoPAccessTokenResponse -> DPoPAccessTokenResponse -> Bool
$c/= :: DPoPAccessTokenResponse -> DPoPAccessTokenResponse -> Bool
/= :: DPoPAccessTokenResponse -> DPoPAccessTokenResponse -> Bool
Eq, Int -> DPoPAccessTokenResponse -> ShowS
[DPoPAccessTokenResponse] -> ShowS
DPoPAccessTokenResponse -> String
(Int -> DPoPAccessTokenResponse -> ShowS)
-> (DPoPAccessTokenResponse -> String)
-> ([DPoPAccessTokenResponse] -> ShowS)
-> Show DPoPAccessTokenResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DPoPAccessTokenResponse -> ShowS
showsPrec :: Int -> DPoPAccessTokenResponse -> ShowS
$cshow :: DPoPAccessTokenResponse -> String
show :: DPoPAccessTokenResponse -> String
$cshowList :: [DPoPAccessTokenResponse] -> ShowS
showList :: [DPoPAccessTokenResponse] -> ShowS
Show, (forall x.
 DPoPAccessTokenResponse -> Rep DPoPAccessTokenResponse x)
-> (forall x.
    Rep DPoPAccessTokenResponse x -> DPoPAccessTokenResponse)
-> Generic DPoPAccessTokenResponse
forall x. Rep DPoPAccessTokenResponse x -> DPoPAccessTokenResponse
forall x. DPoPAccessTokenResponse -> Rep DPoPAccessTokenResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DPoPAccessTokenResponse -> Rep DPoPAccessTokenResponse x
from :: forall x. DPoPAccessTokenResponse -> Rep DPoPAccessTokenResponse x
$cto :: forall x. Rep DPoPAccessTokenResponse x -> DPoPAccessTokenResponse
to :: forall x. Rep DPoPAccessTokenResponse x -> DPoPAccessTokenResponse
Generic)
  deriving (Value -> Parser [DPoPAccessTokenResponse]
Value -> Parser DPoPAccessTokenResponse
(Value -> Parser DPoPAccessTokenResponse)
-> (Value -> Parser [DPoPAccessTokenResponse])
-> FromJSON DPoPAccessTokenResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DPoPAccessTokenResponse
parseJSON :: Value -> Parser DPoPAccessTokenResponse
$cparseJSONList :: Value -> Parser [DPoPAccessTokenResponse]
parseJSONList :: Value -> Parser [DPoPAccessTokenResponse]
FromJSON, [DPoPAccessTokenResponse] -> Value
[DPoPAccessTokenResponse] -> Encoding
DPoPAccessTokenResponse -> Value
DPoPAccessTokenResponse -> Encoding
(DPoPAccessTokenResponse -> Value)
-> (DPoPAccessTokenResponse -> Encoding)
-> ([DPoPAccessTokenResponse] -> Value)
-> ([DPoPAccessTokenResponse] -> Encoding)
-> ToJSON DPoPAccessTokenResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DPoPAccessTokenResponse -> Value
toJSON :: DPoPAccessTokenResponse -> Value
$ctoEncoding :: DPoPAccessTokenResponse -> Encoding
toEncoding :: DPoPAccessTokenResponse -> Encoding
$ctoJSONList :: [DPoPAccessTokenResponse] -> Value
toJSONList :: [DPoPAccessTokenResponse] -> Value
$ctoEncodingList :: [DPoPAccessTokenResponse] -> Encoding
toEncodingList :: [DPoPAccessTokenResponse] -> Encoding
ToJSON, Typeable DPoPAccessTokenResponse
Typeable DPoPAccessTokenResponse =>
(Proxy DPoPAccessTokenResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DPoPAccessTokenResponse
Proxy DPoPAccessTokenResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy DPoPAccessTokenResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DPoPAccessTokenResponse
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema DPoPAccessTokenResponse)

instance ToSchema DPoPAccessTokenResponse where
  schema :: ValueSchema NamedSwaggerDoc DPoPAccessTokenResponse
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DPoPAccessTokenResponse
     DPoPAccessTokenResponse
-> ValueSchema NamedSwaggerDoc DPoPAccessTokenResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"DPoPAccessTokenResponse" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   DPoPAccessTokenResponse
   DPoPAccessTokenResponse
 -> ValueSchema NamedSwaggerDoc DPoPAccessTokenResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DPoPAccessTokenResponse
     DPoPAccessTokenResponse
-> ValueSchema NamedSwaggerDoc DPoPAccessTokenResponse
forall a b. (a -> b) -> a -> b
$
      DPoPAccessToken
-> AccessTokenType -> Word64 -> DPoPAccessTokenResponse
DPoPAccessTokenResponse
        (DPoPAccessToken
 -> AccessTokenType -> Word64 -> DPoPAccessTokenResponse)
-> SchemaP
     SwaggerDoc Object [Pair] DPoPAccessTokenResponse DPoPAccessToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DPoPAccessTokenResponse
     (AccessTokenType -> Word64 -> DPoPAccessTokenResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DPoPAccessTokenResponse -> DPoPAccessToken
datrToken (DPoPAccessTokenResponse -> DPoPAccessToken)
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessToken DPoPAccessToken
-> SchemaP
     SwaggerDoc Object [Pair] DPoPAccessTokenResponse DPoPAccessToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc DPoPAccessToken
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessToken DPoPAccessToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"token" ValueSchema NamedSwaggerDoc DPoPAccessToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  DPoPAccessTokenResponse
  (AccessTokenType -> Word64 -> DPoPAccessTokenResponse)
-> SchemaP
     SwaggerDoc Object [Pair] DPoPAccessTokenResponse AccessTokenType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DPoPAccessTokenResponse
     (Word64 -> DPoPAccessTokenResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse a
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DPoPAccessTokenResponse -> AccessTokenType
datrType (DPoPAccessTokenResponse -> AccessTokenType)
-> SchemaP SwaggerDoc Object [Pair] AccessTokenType AccessTokenType
-> SchemaP
     SwaggerDoc Object [Pair] DPoPAccessTokenResponse AccessTokenType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc AccessTokenType
-> SchemaP SwaggerDoc Object [Pair] AccessTokenType AccessTokenType
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"type" ValueSchema NamedSwaggerDoc AccessTokenType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  DPoPAccessTokenResponse
  (Word64 -> DPoPAccessTokenResponse)
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse Word64
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DPoPAccessTokenResponse
     DPoPAccessTokenResponse
forall a b.
SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse a
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DPoPAccessTokenResponse -> Word64
datrExpiresIn (DPoPAccessTokenResponse -> Word64)
-> SchemaP SwaggerDoc Object [Pair] Word64 Word64
-> SchemaP SwaggerDoc Object [Pair] DPoPAccessTokenResponse Word64
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Word64 Word64
-> SchemaP SwaggerDoc Object [Pair] Word64 Word64
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"expires_in" SchemaP NamedSwaggerDoc Value Value Word64 Word64
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema