-- 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.OAuth where

import Cassandra hiding (Set)
import Control.Lens (preview, view, (%~), (?~))
import Crypto.Hash as Crypto
import Crypto.JWT hiding (Context, params, uri, verify)
import Data.Aeson.KeyMap qualified as M
import Data.Aeson.Types qualified as A
import Data.ByteArray (convert)
import Data.ByteString.Conversion
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.HashMap.Strict qualified as HM
import Data.Id as Id
import Data.Json.Util
import Data.OpenApi (ToParamSchema (..))
import Data.OpenApi qualified as S
import Data.Range
import Data.Schema
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Text.Ascii
import Data.Text.Encoding qualified as TE
import Data.Text.Encoding.Error as TErr
import Data.Time
import GHC.TypeLits (Nat, symbolVal)
import Imports hiding (exp, head)
import Prelude.Singletons (Show_)
import Servant hiding (Handler, JSON, Tagged, addHeader, respond)
import Servant.OpenApi.Internal.Orphans ()
import Test.QuickCheck (Arbitrary (..))
import URI.ByteString
import URI.ByteString.QQ qualified as URI.QQ
import Web.FormUrlEncoded (Form (..), FromForm (..), ToForm (..), parseUnique)
import Wire.API.Error
import Wire.Arbitrary (GenericUniform (..))

--------------------------------------------------------------------------------
-- Types

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

addParams :: [(ByteString, ByteString)] -> RedirectUrl -> RedirectUrl
addParams :: [(ByteString, ByteString)] -> RedirectUrl -> RedirectUrl
addParams [(ByteString, ByteString)]
ps (RedirectUrl URIRef Absolute
uri) = URIRef Absolute
uri URIRef Absolute
-> (URIRef Absolute -> URIRef Absolute) -> URIRef Absolute
forall a b. a -> (a -> b) -> b
& ((Query -> Identity Query)
-> URIRef Absolute -> Identity (URIRef Absolute)
forall a (f :: * -> *).
Functor f =>
(Query -> f Query) -> URIRef a -> f (URIRef a)
queryL ((Query -> Identity Query)
 -> URIRef Absolute -> Identity (URIRef Absolute))
-> (([(ByteString, ByteString)]
     -> Identity [(ByteString, ByteString)])
    -> Query -> Identity Query)
-> ([(ByteString, ByteString)]
    -> Identity [(ByteString, ByteString)])
-> URIRef Absolute
-> Identity (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ByteString, ByteString)] -> Identity [(ByteString, ByteString)])
-> Query -> Identity Query
Lens' Query [(ByteString, ByteString)]
queryPairsL) (([(ByteString, ByteString)]
  -> Identity [(ByteString, ByteString)])
 -> URIRef Absolute -> Identity (URIRef Absolute))
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> URIRef Absolute
-> URIRef Absolute
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([(ByteString, ByteString)]
ps <>) URIRef Absolute -> (URIRef Absolute -> RedirectUrl) -> RedirectUrl
forall a b. a -> (a -> b) -> b
& URIRef Absolute -> RedirectUrl
RedirectUrl

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

instance ToByteString RedirectUrl where
  builder :: RedirectUrl -> Builder
builder = URIRef Absolute -> Builder
forall a. URIRef a -> Builder
serializeURIRef (URIRef Absolute -> Builder)
-> (RedirectUrl -> URIRef Absolute) -> RedirectUrl -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedirectUrl -> URIRef Absolute
unRedirectUrl

instance FromByteString RedirectUrl where
  parser :: Parser RedirectUrl
parser = URIRef Absolute -> RedirectUrl
RedirectUrl (URIRef Absolute -> RedirectUrl)
-> Parser ByteString (URIRef Absolute) -> Parser RedirectUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URIParserOptions -> Parser ByteString (URIRef Absolute)
uriParser URIParserOptions
strictURIParserOptions

instance ToSchema RedirectUrl where
  schema :: ValueSchema NamedSwaggerDoc RedirectUrl
schema =
    (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (RedirectUrl -> ByteString) -> RedirectUrl -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Absolute -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URIRef Absolute -> ByteString)
-> (RedirectUrl -> URIRef Absolute) -> RedirectUrl -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedirectUrl -> URIRef Absolute
unRedirectUrl)
      (RedirectUrl -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text RedirectUrl
-> ValueSchema NamedSwaggerDoc RedirectUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (URIRef Absolute -> RedirectUrl
RedirectUrl (URIRef Absolute -> RedirectUrl)
-> SchemaP NamedSwaggerDoc Value Value Text (URIRef Absolute)
-> SchemaP NamedSwaggerDoc Value Value Text RedirectUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either String (URIRef Absolute))
-> SchemaP NamedSwaggerDoc Value Value Text (URIRef Absolute)
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"RedirectUrl" (Parser ByteString (URIRef Absolute)
-> ByteString -> Either String (URIRef Absolute)
forall a. Parser a -> ByteString -> Either String a
runParser (URIParserOptions -> Parser ByteString (URIRef Absolute)
uriParser URIParserOptions
strictURIParserOptions) (ByteString -> Either String (URIRef Absolute))
-> (Text -> ByteString) -> Text -> Either String (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8))

instance ToHttpApiData RedirectUrl where
  toUrlPiece :: RedirectUrl -> Text
toUrlPiece = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TErr.lenientDecode (ByteString -> Text)
-> (RedirectUrl -> ByteString) -> RedirectUrl -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedirectUrl -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader
  toHeader :: RedirectUrl -> ByteString
toHeader = URIRef Absolute -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URIRef Absolute -> ByteString)
-> (RedirectUrl -> URIRef Absolute) -> RedirectUrl -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedirectUrl -> URIRef Absolute
unRedirectUrl

instance FromHttpApiData RedirectUrl where
  parseUrlPiece :: Text -> Either Text RedirectUrl
parseUrlPiece = ByteString -> Either Text RedirectUrl
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text RedirectUrl)
-> (Text -> ByteString) -> Text -> Either Text RedirectUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
  parseHeader :: ByteString -> Either Text RedirectUrl
parseHeader = (URIParseError -> Text)
-> (URIRef Absolute -> RedirectUrl)
-> Either URIParseError (URIRef Absolute)
-> Either Text RedirectUrl
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Text
T.pack (String -> Text)
-> (URIParseError -> String) -> URIParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParseError -> String
forall a. Show a => a -> String
show) URIRef Absolute -> RedirectUrl
RedirectUrl (Either URIParseError (URIRef Absolute) -> Either Text RedirectUrl)
-> (ByteString -> Either URIParseError (URIRef Absolute))
-> ByteString
-> Either Text RedirectUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions

instance Arbitrary RedirectUrl where
  arbitrary :: Gen RedirectUrl
arbitrary = RedirectUrl -> Gen RedirectUrl
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RedirectUrl -> Gen RedirectUrl) -> RedirectUrl -> Gen RedirectUrl
forall a b. (a -> b) -> a -> b
$ URIRef Absolute -> RedirectUrl
RedirectUrl [URI.QQ.uri|https://example.com|]

type OAuthApplicationNameMinLength = (6 :: Nat)

type OAuthApplicationNameMaxLength = (256 :: Nat)

newtype OAuthApplicationName = OAuthApplicationName {OAuthApplicationName
-> Range
     OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
unOAuthApplicationName :: Range OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text}
  deriving (OAuthApplicationName -> OAuthApplicationName -> Bool
(OAuthApplicationName -> OAuthApplicationName -> Bool)
-> (OAuthApplicationName -> OAuthApplicationName -> Bool)
-> Eq OAuthApplicationName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthApplicationName -> OAuthApplicationName -> Bool
== :: OAuthApplicationName -> OAuthApplicationName -> Bool
$c/= :: OAuthApplicationName -> OAuthApplicationName -> Bool
/= :: OAuthApplicationName -> OAuthApplicationName -> Bool
Eq, Int -> OAuthApplicationName -> ShowS
[OAuthApplicationName] -> ShowS
OAuthApplicationName -> String
(Int -> OAuthApplicationName -> ShowS)
-> (OAuthApplicationName -> String)
-> ([OAuthApplicationName] -> ShowS)
-> Show OAuthApplicationName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthApplicationName -> ShowS
showsPrec :: Int -> OAuthApplicationName -> ShowS
$cshow :: OAuthApplicationName -> String
show :: OAuthApplicationName -> String
$cshowList :: [OAuthApplicationName] -> ShowS
showList :: [OAuthApplicationName] -> ShowS
Show, (forall x. OAuthApplicationName -> Rep OAuthApplicationName x)
-> (forall x. Rep OAuthApplicationName x -> OAuthApplicationName)
-> Generic OAuthApplicationName
forall x. Rep OAuthApplicationName x -> OAuthApplicationName
forall x. OAuthApplicationName -> Rep OAuthApplicationName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthApplicationName -> Rep OAuthApplicationName x
from :: forall x. OAuthApplicationName -> Rep OAuthApplicationName x
$cto :: forall x. Rep OAuthApplicationName x -> OAuthApplicationName
to :: forall x. Rep OAuthApplicationName x -> OAuthApplicationName
Generic, Eq OAuthApplicationName
Eq OAuthApplicationName =>
(OAuthApplicationName -> OAuthApplicationName -> Ordering)
-> (OAuthApplicationName -> OAuthApplicationName -> Bool)
-> (OAuthApplicationName -> OAuthApplicationName -> Bool)
-> (OAuthApplicationName -> OAuthApplicationName -> Bool)
-> (OAuthApplicationName -> OAuthApplicationName -> Bool)
-> (OAuthApplicationName
    -> OAuthApplicationName -> OAuthApplicationName)
-> (OAuthApplicationName
    -> OAuthApplicationName -> OAuthApplicationName)
-> Ord OAuthApplicationName
OAuthApplicationName -> OAuthApplicationName -> Bool
OAuthApplicationName -> OAuthApplicationName -> Ordering
OAuthApplicationName
-> OAuthApplicationName -> OAuthApplicationName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OAuthApplicationName -> OAuthApplicationName -> Ordering
compare :: OAuthApplicationName -> OAuthApplicationName -> Ordering
$c< :: OAuthApplicationName -> OAuthApplicationName -> Bool
< :: OAuthApplicationName -> OAuthApplicationName -> Bool
$c<= :: OAuthApplicationName -> OAuthApplicationName -> Bool
<= :: OAuthApplicationName -> OAuthApplicationName -> Bool
$c> :: OAuthApplicationName -> OAuthApplicationName -> Bool
> :: OAuthApplicationName -> OAuthApplicationName -> Bool
$c>= :: OAuthApplicationName -> OAuthApplicationName -> Bool
>= :: OAuthApplicationName -> OAuthApplicationName -> Bool
$cmax :: OAuthApplicationName
-> OAuthApplicationName -> OAuthApplicationName
max :: OAuthApplicationName
-> OAuthApplicationName -> OAuthApplicationName
$cmin :: OAuthApplicationName
-> OAuthApplicationName -> OAuthApplicationName
min :: OAuthApplicationName
-> OAuthApplicationName -> OAuthApplicationName
Ord, Gen OAuthApplicationName
Gen OAuthApplicationName
-> (OAuthApplicationName -> [OAuthApplicationName])
-> Arbitrary OAuthApplicationName
OAuthApplicationName -> [OAuthApplicationName]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthApplicationName
arbitrary :: Gen OAuthApplicationName
$cshrink :: OAuthApplicationName -> [OAuthApplicationName]
shrink :: OAuthApplicationName -> [OAuthApplicationName]
Arbitrary)
  deriving ([OAuthApplicationName] -> Value
[OAuthApplicationName] -> Encoding
OAuthApplicationName -> Value
OAuthApplicationName -> Encoding
(OAuthApplicationName -> Value)
-> (OAuthApplicationName -> Encoding)
-> ([OAuthApplicationName] -> Value)
-> ([OAuthApplicationName] -> Encoding)
-> ToJSON OAuthApplicationName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthApplicationName -> Value
toJSON :: OAuthApplicationName -> Value
$ctoEncoding :: OAuthApplicationName -> Encoding
toEncoding :: OAuthApplicationName -> Encoding
$ctoJSONList :: [OAuthApplicationName] -> Value
toJSONList :: [OAuthApplicationName] -> Value
$ctoEncodingList :: [OAuthApplicationName] -> Encoding
toEncodingList :: [OAuthApplicationName] -> Encoding
A.ToJSON, Value -> Parser [OAuthApplicationName]
Value -> Parser OAuthApplicationName
(Value -> Parser OAuthApplicationName)
-> (Value -> Parser [OAuthApplicationName])
-> FromJSON OAuthApplicationName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthApplicationName
parseJSON :: Value -> Parser OAuthApplicationName
$cparseJSONList :: Value -> Parser [OAuthApplicationName]
parseJSONList :: Value -> Parser [OAuthApplicationName]
A.FromJSON, Typeable OAuthApplicationName
Typeable OAuthApplicationName =>
(Proxy OAuthApplicationName
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthApplicationName
Proxy OAuthApplicationName
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthApplicationName
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthApplicationName
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthApplicationName)

instance ToSchema OAuthApplicationName where
  schema :: ValueSchema NamedSwaggerDoc OAuthApplicationName
schema = Range
  OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
-> OAuthApplicationName
OAuthApplicationName (Range
   OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
 -> OAuthApplicationName)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     OAuthApplicationName
     (Range
        OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
-> ValueSchema NamedSwaggerDoc OAuthApplicationName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OAuthApplicationName
-> Range
     OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
unOAuthApplicationName (OAuthApplicationName
 -> Range
      OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (Range
        OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
     (Range
        OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     OAuthApplicationName
     (Range
        OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  NamedSwaggerDoc
  Value
  Value
  (Range
     OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
  (Range
     OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data OAuthClientConfig = OAuthClientConfig
  { OAuthClientConfig -> OAuthApplicationName
applicationName :: OAuthApplicationName,
    OAuthClientConfig -> RedirectUrl
redirectUrl :: RedirectUrl
  }
  deriving (OAuthClientConfig -> OAuthClientConfig -> Bool
(OAuthClientConfig -> OAuthClientConfig -> Bool)
-> (OAuthClientConfig -> OAuthClientConfig -> Bool)
-> Eq OAuthClientConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthClientConfig -> OAuthClientConfig -> Bool
== :: OAuthClientConfig -> OAuthClientConfig -> Bool
$c/= :: OAuthClientConfig -> OAuthClientConfig -> Bool
/= :: OAuthClientConfig -> OAuthClientConfig -> Bool
Eq, Int -> OAuthClientConfig -> ShowS
[OAuthClientConfig] -> ShowS
OAuthClientConfig -> String
(Int -> OAuthClientConfig -> ShowS)
-> (OAuthClientConfig -> String)
-> ([OAuthClientConfig] -> ShowS)
-> Show OAuthClientConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthClientConfig -> ShowS
showsPrec :: Int -> OAuthClientConfig -> ShowS
$cshow :: OAuthClientConfig -> String
show :: OAuthClientConfig -> String
$cshowList :: [OAuthClientConfig] -> ShowS
showList :: [OAuthClientConfig] -> ShowS
Show, (forall x. OAuthClientConfig -> Rep OAuthClientConfig x)
-> (forall x. Rep OAuthClientConfig x -> OAuthClientConfig)
-> Generic OAuthClientConfig
forall x. Rep OAuthClientConfig x -> OAuthClientConfig
forall x. OAuthClientConfig -> Rep OAuthClientConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthClientConfig -> Rep OAuthClientConfig x
from :: forall x. OAuthClientConfig -> Rep OAuthClientConfig x
$cto :: forall x. Rep OAuthClientConfig x -> OAuthClientConfig
to :: forall x. Rep OAuthClientConfig x -> OAuthClientConfig
Generic)
  deriving (Gen OAuthClientConfig
Gen OAuthClientConfig
-> (OAuthClientConfig -> [OAuthClientConfig])
-> Arbitrary OAuthClientConfig
OAuthClientConfig -> [OAuthClientConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthClientConfig
arbitrary :: Gen OAuthClientConfig
$cshrink :: OAuthClientConfig -> [OAuthClientConfig]
shrink :: OAuthClientConfig -> [OAuthClientConfig]
Arbitrary) via (GenericUniform OAuthClientConfig)
  deriving ([OAuthClientConfig] -> Value
[OAuthClientConfig] -> Encoding
OAuthClientConfig -> Value
OAuthClientConfig -> Encoding
(OAuthClientConfig -> Value)
-> (OAuthClientConfig -> Encoding)
-> ([OAuthClientConfig] -> Value)
-> ([OAuthClientConfig] -> Encoding)
-> ToJSON OAuthClientConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthClientConfig -> Value
toJSON :: OAuthClientConfig -> Value
$ctoEncoding :: OAuthClientConfig -> Encoding
toEncoding :: OAuthClientConfig -> Encoding
$ctoJSONList :: [OAuthClientConfig] -> Value
toJSONList :: [OAuthClientConfig] -> Value
$ctoEncodingList :: [OAuthClientConfig] -> Encoding
toEncodingList :: [OAuthClientConfig] -> Encoding
A.ToJSON, Value -> Parser [OAuthClientConfig]
Value -> Parser OAuthClientConfig
(Value -> Parser OAuthClientConfig)
-> (Value -> Parser [OAuthClientConfig])
-> FromJSON OAuthClientConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthClientConfig
parseJSON :: Value -> Parser OAuthClientConfig
$cparseJSONList :: Value -> Parser [OAuthClientConfig]
parseJSONList :: Value -> Parser [OAuthClientConfig]
A.FromJSON, Typeable OAuthClientConfig
Typeable OAuthClientConfig =>
(Proxy OAuthClientConfig
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthClientConfig
Proxy OAuthClientConfig -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthClientConfig -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthClientConfig -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthClientConfig)

instance ToSchema OAuthClientConfig where
  schema :: ValueSchema NamedSwaggerDoc OAuthClientConfig
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClientConfig OAuthClientConfig
-> ValueSchema NamedSwaggerDoc OAuthClientConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthClientConfig" (SchemaP
   SwaggerDoc Object [Pair] OAuthClientConfig OAuthClientConfig
 -> ValueSchema NamedSwaggerDoc OAuthClientConfig)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClientConfig OAuthClientConfig
-> ValueSchema NamedSwaggerDoc OAuthClientConfig
forall a b. (a -> b) -> a -> b
$
      OAuthApplicationName -> RedirectUrl -> OAuthClientConfig
OAuthClientConfig
        (OAuthApplicationName -> RedirectUrl -> OAuthClientConfig)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClientConfig OAuthApplicationName
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientConfig
     (RedirectUrl -> OAuthClientConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OAuthClientConfig -> OAuthApplicationName
applicationName
          (OAuthClientConfig -> OAuthApplicationName)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplicationName OAuthApplicationName
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClientConfig OAuthApplicationName
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthApplicationName
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplicationName OAuthApplicationName
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"application_name" NamedSwaggerDoc -> NamedSwaggerDoc
applicationNameDescription ValueSchema NamedSwaggerDoc OAuthApplicationName
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthClientConfig
  (RedirectUrl -> OAuthClientConfig)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientConfig RedirectUrl
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClientConfig OAuthClientConfig
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthClientConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientConfig a
-> SchemaP SwaggerDoc Object [Pair] OAuthClientConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.redirectUrl)
          (OAuthClientConfig -> RedirectUrl)
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
-> SchemaP SwaggerDoc Object [Pair] OAuthClientConfig RedirectUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc RedirectUrl
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"redirect_url" NamedSwaggerDoc -> NamedSwaggerDoc
redirectUrlDescription ValueSchema NamedSwaggerDoc RedirectUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      applicationNameDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
applicationNameDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The name of the application. This will be shown to the user when they are asked to authorize the application. The name must be between " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
minL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
maxL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" characters long."
      redirectUrlDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
redirectUrlDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The URL to redirect to after the user has authorized the application."
      minL :: Text
minL = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy "6" -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy "6" -> String) -> Proxy "6" -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(Show_ OAuthApplicationNameMinLength)
      maxL :: Text
maxL = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy "256" -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy "256" -> String) -> Proxy "256" -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(Show_ OAuthApplicationNameMaxLength)

newtype OAuthClientPlainTextSecret = OAuthClientPlainTextSecret {OAuthClientPlainTextSecret -> AsciiBase16
unOAuthClientPlainTextSecret :: AsciiBase16}
  deriving (OAuthClientPlainTextSecret -> OAuthClientPlainTextSecret -> Bool
(OAuthClientPlainTextSecret -> OAuthClientPlainTextSecret -> Bool)
-> (OAuthClientPlainTextSecret
    -> OAuthClientPlainTextSecret -> Bool)
-> Eq OAuthClientPlainTextSecret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthClientPlainTextSecret -> OAuthClientPlainTextSecret -> Bool
== :: OAuthClientPlainTextSecret -> OAuthClientPlainTextSecret -> Bool
$c/= :: OAuthClientPlainTextSecret -> OAuthClientPlainTextSecret -> Bool
/= :: OAuthClientPlainTextSecret -> OAuthClientPlainTextSecret -> Bool
Eq, (forall x.
 OAuthClientPlainTextSecret -> Rep OAuthClientPlainTextSecret x)
-> (forall x.
    Rep OAuthClientPlainTextSecret x -> OAuthClientPlainTextSecret)
-> Generic OAuthClientPlainTextSecret
forall x.
Rep OAuthClientPlainTextSecret x -> OAuthClientPlainTextSecret
forall x.
OAuthClientPlainTextSecret -> Rep OAuthClientPlainTextSecret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OAuthClientPlainTextSecret -> Rep OAuthClientPlainTextSecret x
from :: forall x.
OAuthClientPlainTextSecret -> Rep OAuthClientPlainTextSecret x
$cto :: forall x.
Rep OAuthClientPlainTextSecret x -> OAuthClientPlainTextSecret
to :: forall x.
Rep OAuthClientPlainTextSecret x -> OAuthClientPlainTextSecret
Generic, Gen OAuthClientPlainTextSecret
Gen OAuthClientPlainTextSecret
-> (OAuthClientPlainTextSecret -> [OAuthClientPlainTextSecret])
-> Arbitrary OAuthClientPlainTextSecret
OAuthClientPlainTextSecret -> [OAuthClientPlainTextSecret]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthClientPlainTextSecret
arbitrary :: Gen OAuthClientPlainTextSecret
$cshrink :: OAuthClientPlainTextSecret -> [OAuthClientPlainTextSecret]
shrink :: OAuthClientPlainTextSecret -> [OAuthClientPlainTextSecret]
Arbitrary)
  deriving ([OAuthClientPlainTextSecret] -> Value
[OAuthClientPlainTextSecret] -> Encoding
OAuthClientPlainTextSecret -> Value
OAuthClientPlainTextSecret -> Encoding
(OAuthClientPlainTextSecret -> Value)
-> (OAuthClientPlainTextSecret -> Encoding)
-> ([OAuthClientPlainTextSecret] -> Value)
-> ([OAuthClientPlainTextSecret] -> Encoding)
-> ToJSON OAuthClientPlainTextSecret
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthClientPlainTextSecret -> Value
toJSON :: OAuthClientPlainTextSecret -> Value
$ctoEncoding :: OAuthClientPlainTextSecret -> Encoding
toEncoding :: OAuthClientPlainTextSecret -> Encoding
$ctoJSONList :: [OAuthClientPlainTextSecret] -> Value
toJSONList :: [OAuthClientPlainTextSecret] -> Value
$ctoEncodingList :: [OAuthClientPlainTextSecret] -> Encoding
toEncodingList :: [OAuthClientPlainTextSecret] -> Encoding
A.ToJSON, Value -> Parser [OAuthClientPlainTextSecret]
Value -> Parser OAuthClientPlainTextSecret
(Value -> Parser OAuthClientPlainTextSecret)
-> (Value -> Parser [OAuthClientPlainTextSecret])
-> FromJSON OAuthClientPlainTextSecret
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthClientPlainTextSecret
parseJSON :: Value -> Parser OAuthClientPlainTextSecret
$cparseJSONList :: Value -> Parser [OAuthClientPlainTextSecret]
parseJSONList :: Value -> Parser [OAuthClientPlainTextSecret]
A.FromJSON, Typeable OAuthClientPlainTextSecret
Typeable OAuthClientPlainTextSecret =>
(Proxy OAuthClientPlainTextSecret
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthClientPlainTextSecret
Proxy OAuthClientPlainTextSecret
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthClientPlainTextSecret
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthClientPlainTextSecret
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthClientPlainTextSecret)

instance Show OAuthClientPlainTextSecret where
  show :: OAuthClientPlainTextSecret -> String
show OAuthClientPlainTextSecret
_ = String
"<OAuthClientPlainTextSecret>"

instance ToSchema OAuthClientPlainTextSecret where
  schema :: ValueSchema NamedSwaggerDoc OAuthClientPlainTextSecret
  schema :: ValueSchema NamedSwaggerDoc OAuthClientPlainTextSecret
schema = (AsciiBase16 -> Text
forall {k} (c :: k). AsciiText c -> Text
toText (AsciiBase16 -> Text)
-> (OAuthClientPlainTextSecret -> AsciiBase16)
-> OAuthClientPlainTextSecret
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthClientPlainTextSecret -> AsciiBase16
unOAuthClientPlainTextSecret) (OAuthClientPlainTextSecret -> Text)
-> SchemaP
     NamedSwaggerDoc Value Value Text OAuthClientPlainTextSecret
-> ValueSchema NamedSwaggerDoc OAuthClientPlainTextSecret
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String OAuthClientPlainTextSecret)
-> SchemaP
     NamedSwaggerDoc Value Value Text OAuthClientPlainTextSecret
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"OAuthClientPlainTextSecret" ((AsciiBase16 -> OAuthClientPlainTextSecret)
-> Either String AsciiBase16
-> Either String OAuthClientPlainTextSecret
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AsciiBase16 -> OAuthClientPlainTextSecret
OAuthClientPlainTextSecret (Either String AsciiBase16
 -> Either String OAuthClientPlainTextSecret)
-> (Text -> Either String AsciiBase16)
-> Text
-> Either String OAuthClientPlainTextSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String AsciiBase16
validateBase16)

instance FromHttpApiData OAuthClientPlainTextSecret where
  parseQueryParam :: Text -> Either Text OAuthClientPlainTextSecret
parseQueryParam = (String -> Text)
-> (AsciiBase16 -> OAuthClientPlainTextSecret)
-> Either String AsciiBase16
-> Either Text OAuthClientPlainTextSecret
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack AsciiBase16 -> OAuthClientPlainTextSecret
OAuthClientPlainTextSecret (Either String AsciiBase16
 -> Either Text OAuthClientPlainTextSecret)
-> (Text -> Either String AsciiBase16)
-> Text
-> Either Text OAuthClientPlainTextSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String AsciiBase16
validateBase16

instance ToHttpApiData OAuthClientPlainTextSecret where
  toQueryParam :: OAuthClientPlainTextSecret -> Text
toQueryParam = AsciiBase16 -> Text
forall {k} (c :: k). AsciiText c -> Text
toText (AsciiBase16 -> Text)
-> (OAuthClientPlainTextSecret -> AsciiBase16)
-> OAuthClientPlainTextSecret
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthClientPlainTextSecret -> AsciiBase16
unOAuthClientPlainTextSecret

data OAuthClientCredentials = OAuthClientCredentials
  { OAuthClientCredentials -> OAuthClientId
clientId :: OAuthClientId,
    OAuthClientCredentials -> OAuthClientPlainTextSecret
clientSecret :: OAuthClientPlainTextSecret
  }
  deriving (OAuthClientCredentials -> OAuthClientCredentials -> Bool
(OAuthClientCredentials -> OAuthClientCredentials -> Bool)
-> (OAuthClientCredentials -> OAuthClientCredentials -> Bool)
-> Eq OAuthClientCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthClientCredentials -> OAuthClientCredentials -> Bool
== :: OAuthClientCredentials -> OAuthClientCredentials -> Bool
$c/= :: OAuthClientCredentials -> OAuthClientCredentials -> Bool
/= :: OAuthClientCredentials -> OAuthClientCredentials -> Bool
Eq, Int -> OAuthClientCredentials -> ShowS
[OAuthClientCredentials] -> ShowS
OAuthClientCredentials -> String
(Int -> OAuthClientCredentials -> ShowS)
-> (OAuthClientCredentials -> String)
-> ([OAuthClientCredentials] -> ShowS)
-> Show OAuthClientCredentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthClientCredentials -> ShowS
showsPrec :: Int -> OAuthClientCredentials -> ShowS
$cshow :: OAuthClientCredentials -> String
show :: OAuthClientCredentials -> String
$cshowList :: [OAuthClientCredentials] -> ShowS
showList :: [OAuthClientCredentials] -> ShowS
Show, (forall x. OAuthClientCredentials -> Rep OAuthClientCredentials x)
-> (forall x.
    Rep OAuthClientCredentials x -> OAuthClientCredentials)
-> Generic OAuthClientCredentials
forall x. Rep OAuthClientCredentials x -> OAuthClientCredentials
forall x. OAuthClientCredentials -> Rep OAuthClientCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthClientCredentials -> Rep OAuthClientCredentials x
from :: forall x. OAuthClientCredentials -> Rep OAuthClientCredentials x
$cto :: forall x. Rep OAuthClientCredentials x -> OAuthClientCredentials
to :: forall x. Rep OAuthClientCredentials x -> OAuthClientCredentials
Generic)
  deriving (Gen OAuthClientCredentials
Gen OAuthClientCredentials
-> (OAuthClientCredentials -> [OAuthClientCredentials])
-> Arbitrary OAuthClientCredentials
OAuthClientCredentials -> [OAuthClientCredentials]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthClientCredentials
arbitrary :: Gen OAuthClientCredentials
$cshrink :: OAuthClientCredentials -> [OAuthClientCredentials]
shrink :: OAuthClientCredentials -> [OAuthClientCredentials]
Arbitrary) via (GenericUniform OAuthClientCredentials)
  deriving ([OAuthClientCredentials] -> Value
[OAuthClientCredentials] -> Encoding
OAuthClientCredentials -> Value
OAuthClientCredentials -> Encoding
(OAuthClientCredentials -> Value)
-> (OAuthClientCredentials -> Encoding)
-> ([OAuthClientCredentials] -> Value)
-> ([OAuthClientCredentials] -> Encoding)
-> ToJSON OAuthClientCredentials
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthClientCredentials -> Value
toJSON :: OAuthClientCredentials -> Value
$ctoEncoding :: OAuthClientCredentials -> Encoding
toEncoding :: OAuthClientCredentials -> Encoding
$ctoJSONList :: [OAuthClientCredentials] -> Value
toJSONList :: [OAuthClientCredentials] -> Value
$ctoEncodingList :: [OAuthClientCredentials] -> Encoding
toEncodingList :: [OAuthClientCredentials] -> Encoding
A.ToJSON, Value -> Parser [OAuthClientCredentials]
Value -> Parser OAuthClientCredentials
(Value -> Parser OAuthClientCredentials)
-> (Value -> Parser [OAuthClientCredentials])
-> FromJSON OAuthClientCredentials
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthClientCredentials
parseJSON :: Value -> Parser OAuthClientCredentials
$cparseJSONList :: Value -> Parser [OAuthClientCredentials]
parseJSONList :: Value -> Parser [OAuthClientCredentials]
A.FromJSON, Typeable OAuthClientCredentials
Typeable OAuthClientCredentials =>
(Proxy OAuthClientCredentials
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthClientCredentials
Proxy OAuthClientCredentials
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthClientCredentials
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthClientCredentials
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthClientCredentials)

instance ToSchema OAuthClientCredentials where
  schema :: ValueSchema NamedSwaggerDoc OAuthClientCredentials
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientCredentials
     OAuthClientCredentials
-> ValueSchema NamedSwaggerDoc OAuthClientCredentials
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthClientCredentials" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   OAuthClientCredentials
   OAuthClientCredentials
 -> ValueSchema NamedSwaggerDoc OAuthClientCredentials)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientCredentials
     OAuthClientCredentials
-> ValueSchema NamedSwaggerDoc OAuthClientCredentials
forall a b. (a -> b) -> a -> b
$
      OAuthClientId
-> OAuthClientPlainTextSecret -> OAuthClientCredentials
OAuthClientCredentials
        (OAuthClientId
 -> OAuthClientPlainTextSecret -> OAuthClientCredentials)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClientCredentials OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientCredentials
     (OAuthClientPlainTextSecret -> OAuthClientCredentials)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.clientId)
          (OAuthClientCredentials -> OAuthClientId)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClientCredentials OAuthClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"client_id" NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthClientCredentials
  (OAuthClientPlainTextSecret -> OAuthClientCredentials)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientCredentials
     OAuthClientPlainTextSecret
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientCredentials
     OAuthClientCredentials
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthClientCredentials (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientCredentials a
-> SchemaP SwaggerDoc Object [Pair] OAuthClientCredentials b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.clientSecret)
          (OAuthClientCredentials -> OAuthClientPlainTextSecret)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientPlainTextSecret
     OAuthClientPlainTextSecret
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientCredentials
     OAuthClientPlainTextSecret
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthClientPlainTextSecret
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClientPlainTextSecret
     OAuthClientPlainTextSecret
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"client_secret" NamedSwaggerDoc -> NamedSwaggerDoc
clientSecretDescription ValueSchema NamedSwaggerDoc OAuthClientPlainTextSecret
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      clientIdDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The ID of the application."
      clientSecretDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
clientSecretDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The secret of the application."

data OAuthClient = OAuthClient
  { OAuthClient -> OAuthClientId
clientId :: OAuthClientId,
    OAuthClient -> OAuthApplicationName
name :: OAuthApplicationName,
    OAuthClient -> RedirectUrl
redirectUrl :: RedirectUrl
  }
  deriving (OAuthClient -> OAuthClient -> Bool
(OAuthClient -> OAuthClient -> Bool)
-> (OAuthClient -> OAuthClient -> Bool) -> Eq OAuthClient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthClient -> OAuthClient -> Bool
== :: OAuthClient -> OAuthClient -> Bool
$c/= :: OAuthClient -> OAuthClient -> Bool
/= :: OAuthClient -> OAuthClient -> Bool
Eq, Int -> OAuthClient -> ShowS
[OAuthClient] -> ShowS
OAuthClient -> String
(Int -> OAuthClient -> ShowS)
-> (OAuthClient -> String)
-> ([OAuthClient] -> ShowS)
-> Show OAuthClient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthClient -> ShowS
showsPrec :: Int -> OAuthClient -> ShowS
$cshow :: OAuthClient -> String
show :: OAuthClient -> String
$cshowList :: [OAuthClient] -> ShowS
showList :: [OAuthClient] -> ShowS
Show, (forall x. OAuthClient -> Rep OAuthClient x)
-> (forall x. Rep OAuthClient x -> OAuthClient)
-> Generic OAuthClient
forall x. Rep OAuthClient x -> OAuthClient
forall x. OAuthClient -> Rep OAuthClient x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthClient -> Rep OAuthClient x
from :: forall x. OAuthClient -> Rep OAuthClient x
$cto :: forall x. Rep OAuthClient x -> OAuthClient
to :: forall x. Rep OAuthClient x -> OAuthClient
Generic)
  deriving (Gen OAuthClient
Gen OAuthClient
-> (OAuthClient -> [OAuthClient]) -> Arbitrary OAuthClient
OAuthClient -> [OAuthClient]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthClient
arbitrary :: Gen OAuthClient
$cshrink :: OAuthClient -> [OAuthClient]
shrink :: OAuthClient -> [OAuthClient]
Arbitrary) via (GenericUniform OAuthClient)
  deriving ([OAuthClient] -> Value
[OAuthClient] -> Encoding
OAuthClient -> Value
OAuthClient -> Encoding
(OAuthClient -> Value)
-> (OAuthClient -> Encoding)
-> ([OAuthClient] -> Value)
-> ([OAuthClient] -> Encoding)
-> ToJSON OAuthClient
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthClient -> Value
toJSON :: OAuthClient -> Value
$ctoEncoding :: OAuthClient -> Encoding
toEncoding :: OAuthClient -> Encoding
$ctoJSONList :: [OAuthClient] -> Value
toJSONList :: [OAuthClient] -> Value
$ctoEncodingList :: [OAuthClient] -> Encoding
toEncodingList :: [OAuthClient] -> Encoding
A.ToJSON, Value -> Parser [OAuthClient]
Value -> Parser OAuthClient
(Value -> Parser OAuthClient)
-> (Value -> Parser [OAuthClient]) -> FromJSON OAuthClient
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthClient
parseJSON :: Value -> Parser OAuthClient
$cparseJSONList :: Value -> Parser [OAuthClient]
parseJSONList :: Value -> Parser [OAuthClient]
A.FromJSON, Typeable OAuthClient
Typeable OAuthClient =>
(Proxy OAuthClient -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthClient
Proxy OAuthClient -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthClient -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthClient -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthClient)

instance ToSchema OAuthClient where
  schema :: ValueSchema NamedSwaggerDoc OAuthClient
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] OAuthClient OAuthClient
-> ValueSchema NamedSwaggerDoc OAuthClient
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthClient" (SchemaP SwaggerDoc Object [Pair] OAuthClient OAuthClient
 -> ValueSchema NamedSwaggerDoc OAuthClient)
-> SchemaP SwaggerDoc Object [Pair] OAuthClient OAuthClient
-> ValueSchema NamedSwaggerDoc OAuthClient
forall a b. (a -> b) -> a -> b
$
      OAuthClientId -> OAuthApplicationName -> RedirectUrl -> OAuthClient
OAuthClient
        (OAuthClientId
 -> OAuthApplicationName -> RedirectUrl -> OAuthClient)
-> SchemaP SwaggerDoc Object [Pair] OAuthClient OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthClient
     (OAuthApplicationName -> RedirectUrl -> OAuthClient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.clientId)
          (OAuthClient -> OAuthClientId)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClient OAuthClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"client_id" SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthClient
  (OAuthApplicationName -> RedirectUrl -> OAuthClient)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClient OAuthApplicationName
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClient (RedirectUrl -> OAuthClient)
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthClient (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthClient a
-> SchemaP SwaggerDoc Object [Pair] OAuthClient b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.name)
          (OAuthClient -> OAuthApplicationName)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplicationName OAuthApplicationName
-> SchemaP
     SwaggerDoc Object [Pair] OAuthClient OAuthApplicationName
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc OAuthApplicationName
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplicationName OAuthApplicationName
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"application_name" ValueSchema NamedSwaggerDoc OAuthApplicationName
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] OAuthClient (RedirectUrl -> OAuthClient)
-> SchemaP SwaggerDoc Object [Pair] OAuthClient RedirectUrl
-> SchemaP SwaggerDoc Object [Pair] OAuthClient OAuthClient
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthClient (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthClient a
-> SchemaP SwaggerDoc Object [Pair] OAuthClient b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.redirectUrl)
          (OAuthClient -> RedirectUrl)
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
-> SchemaP SwaggerDoc Object [Pair] OAuthClient RedirectUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc RedirectUrl
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"redirect_url" ValueSchema NamedSwaggerDoc RedirectUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

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

instance ToSchema OAuthResponseType where
  schema :: ValueSchema NamedSwaggerDoc OAuthResponseType
  schema :: ValueSchema NamedSwaggerDoc OAuthResponseType
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
"OAuthResponseType" (SchemaP
   [Value] Text (Alt Maybe Text) OAuthResponseType OAuthResponseType
 -> ValueSchema NamedSwaggerDoc OAuthResponseType)
-> SchemaP
     [Value] Text (Alt Maybe Text) OAuthResponseType OAuthResponseType
-> ValueSchema NamedSwaggerDoc OAuthResponseType
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value] Text (Alt Maybe Text) OAuthResponseType OAuthResponseType]
-> SchemaP
     [Value] Text (Alt Maybe Text) OAuthResponseType OAuthResponseType
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> OAuthResponseType
-> SchemaP
     [Value] Text (Alt Maybe Text) OAuthResponseType OAuthResponseType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"code" OAuthResponseType
OAuthResponseTypeCode
        ]

-- | The OAuth scopes that are supported by the backend.
-- This type is a bit redundant and unfortunately has to be kept in sync
-- with the supported scopes defined in the nginx configs.
-- However, having this typed makes it easier to handle scopes in the backend,
-- and e.g. provide more meaningful error messages when the scope is invalid.
data OAuthScope
  = ReadFeatureConfigs
  | ReadSelf
  | WriteConversations
  | WriteConversationsCode
  deriving (OAuthScope -> OAuthScope -> Bool
(OAuthScope -> OAuthScope -> Bool)
-> (OAuthScope -> OAuthScope -> Bool) -> Eq OAuthScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthScope -> OAuthScope -> Bool
== :: OAuthScope -> OAuthScope -> Bool
$c/= :: OAuthScope -> OAuthScope -> Bool
/= :: OAuthScope -> OAuthScope -> Bool
Eq, Int -> OAuthScope -> ShowS
[OAuthScope] -> ShowS
OAuthScope -> String
(Int -> OAuthScope -> ShowS)
-> (OAuthScope -> String)
-> ([OAuthScope] -> ShowS)
-> Show OAuthScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthScope -> ShowS
showsPrec :: Int -> OAuthScope -> ShowS
$cshow :: OAuthScope -> String
show :: OAuthScope -> String
$cshowList :: [OAuthScope] -> ShowS
showList :: [OAuthScope] -> ShowS
Show, (forall x. OAuthScope -> Rep OAuthScope x)
-> (forall x. Rep OAuthScope x -> OAuthScope) -> Generic OAuthScope
forall x. Rep OAuthScope x -> OAuthScope
forall x. OAuthScope -> Rep OAuthScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthScope -> Rep OAuthScope x
from :: forall x. OAuthScope -> Rep OAuthScope x
$cto :: forall x. Rep OAuthScope x -> OAuthScope
to :: forall x. Rep OAuthScope x -> OAuthScope
Generic, Eq OAuthScope
Eq OAuthScope =>
(OAuthScope -> OAuthScope -> Ordering)
-> (OAuthScope -> OAuthScope -> Bool)
-> (OAuthScope -> OAuthScope -> Bool)
-> (OAuthScope -> OAuthScope -> Bool)
-> (OAuthScope -> OAuthScope -> Bool)
-> (OAuthScope -> OAuthScope -> OAuthScope)
-> (OAuthScope -> OAuthScope -> OAuthScope)
-> Ord OAuthScope
OAuthScope -> OAuthScope -> Bool
OAuthScope -> OAuthScope -> Ordering
OAuthScope -> OAuthScope -> OAuthScope
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OAuthScope -> OAuthScope -> Ordering
compare :: OAuthScope -> OAuthScope -> Ordering
$c< :: OAuthScope -> OAuthScope -> Bool
< :: OAuthScope -> OAuthScope -> Bool
$c<= :: OAuthScope -> OAuthScope -> Bool
<= :: OAuthScope -> OAuthScope -> Bool
$c> :: OAuthScope -> OAuthScope -> Bool
> :: OAuthScope -> OAuthScope -> Bool
$c>= :: OAuthScope -> OAuthScope -> Bool
>= :: OAuthScope -> OAuthScope -> Bool
$cmax :: OAuthScope -> OAuthScope -> OAuthScope
max :: OAuthScope -> OAuthScope -> OAuthScope
$cmin :: OAuthScope -> OAuthScope -> OAuthScope
min :: OAuthScope -> OAuthScope -> OAuthScope
Ord)
  deriving (Gen OAuthScope
Gen OAuthScope
-> (OAuthScope -> [OAuthScope]) -> Arbitrary OAuthScope
OAuthScope -> [OAuthScope]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthScope
arbitrary :: Gen OAuthScope
$cshrink :: OAuthScope -> [OAuthScope]
shrink :: OAuthScope -> [OAuthScope]
Arbitrary) via (GenericUniform OAuthScope)

class IsOAuthScope scope where
  toOAuthScope :: OAuthScope

instance IsOAuthScope 'WriteConversations where
  toOAuthScope :: OAuthScope
toOAuthScope = OAuthScope
WriteConversations

instance IsOAuthScope 'WriteConversationsCode where
  toOAuthScope :: OAuthScope
toOAuthScope = OAuthScope
WriteConversationsCode

instance IsOAuthScope 'ReadSelf where
  toOAuthScope :: OAuthScope
toOAuthScope = OAuthScope
ReadSelf

instance IsOAuthScope 'ReadFeatureConfigs where
  toOAuthScope :: OAuthScope
toOAuthScope = OAuthScope
ReadFeatureConfigs

instance ToByteString OAuthScope where
  builder :: OAuthScope -> Builder
builder = \case
    OAuthScope
WriteConversations -> Builder
"write:conversations"
    OAuthScope
WriteConversationsCode -> Builder
"write:conversations_code"
    OAuthScope
ReadSelf -> Builder
"read:self"
    OAuthScope
ReadFeatureConfigs -> Builder
"read:feature_configs"

instance FromByteString OAuthScope where
  parser :: Parser OAuthScope
parser = do
    Text
s <- Parser Text
forall a. FromByteString a => Parser a
parser
    case Text -> Text
T.toLower Text
s of
      Text
"write:conversations" -> OAuthScope -> Parser OAuthScope
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OAuthScope
WriteConversations
      Text
"write:conversations_code" -> OAuthScope -> Parser OAuthScope
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OAuthScope
WriteConversationsCode
      Text
"read:self" -> OAuthScope -> Parser OAuthScope
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OAuthScope
ReadSelf
      Text
"read:feature_configs" -> OAuthScope -> Parser OAuthScope
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OAuthScope
ReadFeatureConfigs
      Text
_ -> String -> Parser OAuthScope
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid scope"

newtype OAuthScopes = OAuthScopes {OAuthScopes -> Set OAuthScope
unOAuthScopes :: Set OAuthScope}
  deriving (OAuthScopes -> OAuthScopes -> Bool
(OAuthScopes -> OAuthScopes -> Bool)
-> (OAuthScopes -> OAuthScopes -> Bool) -> Eq OAuthScopes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthScopes -> OAuthScopes -> Bool
== :: OAuthScopes -> OAuthScopes -> Bool
$c/= :: OAuthScopes -> OAuthScopes -> Bool
/= :: OAuthScopes -> OAuthScopes -> Bool
Eq, Int -> OAuthScopes -> ShowS
[OAuthScopes] -> ShowS
OAuthScopes -> String
(Int -> OAuthScopes -> ShowS)
-> (OAuthScopes -> String)
-> ([OAuthScopes] -> ShowS)
-> Show OAuthScopes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthScopes -> ShowS
showsPrec :: Int -> OAuthScopes -> ShowS
$cshow :: OAuthScopes -> String
show :: OAuthScopes -> String
$cshowList :: [OAuthScopes] -> ShowS
showList :: [OAuthScopes] -> ShowS
Show, (forall x. OAuthScopes -> Rep OAuthScopes x)
-> (forall x. Rep OAuthScopes x -> OAuthScopes)
-> Generic OAuthScopes
forall x. Rep OAuthScopes x -> OAuthScopes
forall x. OAuthScopes -> Rep OAuthScopes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthScopes -> Rep OAuthScopes x
from :: forall x. OAuthScopes -> Rep OAuthScopes x
$cto :: forall x. Rep OAuthScopes x -> OAuthScopes
to :: forall x. Rep OAuthScopes x -> OAuthScopes
Generic, Semigroup OAuthScopes
OAuthScopes
Semigroup OAuthScopes =>
OAuthScopes
-> (OAuthScopes -> OAuthScopes -> OAuthScopes)
-> ([OAuthScopes] -> OAuthScopes)
-> Monoid OAuthScopes
[OAuthScopes] -> OAuthScopes
OAuthScopes -> OAuthScopes -> OAuthScopes
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: OAuthScopes
mempty :: OAuthScopes
$cmappend :: OAuthScopes -> OAuthScopes -> OAuthScopes
mappend :: OAuthScopes -> OAuthScopes -> OAuthScopes
$cmconcat :: [OAuthScopes] -> OAuthScopes
mconcat :: [OAuthScopes] -> OAuthScopes
Monoid, NonEmpty OAuthScopes -> OAuthScopes
OAuthScopes -> OAuthScopes -> OAuthScopes
(OAuthScopes -> OAuthScopes -> OAuthScopes)
-> (NonEmpty OAuthScopes -> OAuthScopes)
-> (forall b. Integral b => b -> OAuthScopes -> OAuthScopes)
-> Semigroup OAuthScopes
forall b. Integral b => b -> OAuthScopes -> OAuthScopes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: OAuthScopes -> OAuthScopes -> OAuthScopes
<> :: OAuthScopes -> OAuthScopes -> OAuthScopes
$csconcat :: NonEmpty OAuthScopes -> OAuthScopes
sconcat :: NonEmpty OAuthScopes -> OAuthScopes
$cstimes :: forall b. Integral b => b -> OAuthScopes -> OAuthScopes
stimes :: forall b. Integral b => b -> OAuthScopes -> OAuthScopes
Semigroup, Gen OAuthScopes
Gen OAuthScopes
-> (OAuthScopes -> [OAuthScopes]) -> Arbitrary OAuthScopes
OAuthScopes -> [OAuthScopes]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthScopes
arbitrary :: Gen OAuthScopes
$cshrink :: OAuthScopes -> [OAuthScopes]
shrink :: OAuthScopes -> [OAuthScopes]
Arbitrary)
  deriving ([OAuthScopes] -> Value
[OAuthScopes] -> Encoding
OAuthScopes -> Value
OAuthScopes -> Encoding
(OAuthScopes -> Value)
-> (OAuthScopes -> Encoding)
-> ([OAuthScopes] -> Value)
-> ([OAuthScopes] -> Encoding)
-> ToJSON OAuthScopes
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthScopes -> Value
toJSON :: OAuthScopes -> Value
$ctoEncoding :: OAuthScopes -> Encoding
toEncoding :: OAuthScopes -> Encoding
$ctoJSONList :: [OAuthScopes] -> Value
toJSONList :: [OAuthScopes] -> Value
$ctoEncodingList :: [OAuthScopes] -> Encoding
toEncodingList :: [OAuthScopes] -> Encoding
A.ToJSON, Value -> Parser [OAuthScopes]
Value -> Parser OAuthScopes
(Value -> Parser OAuthScopes)
-> (Value -> Parser [OAuthScopes]) -> FromJSON OAuthScopes
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthScopes
parseJSON :: Value -> Parser OAuthScopes
$cparseJSONList :: Value -> Parser [OAuthScopes]
parseJSONList :: Value -> Parser [OAuthScopes]
A.FromJSON, Typeable OAuthScopes
Typeable OAuthScopes =>
(Proxy OAuthScopes -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthScopes
Proxy OAuthScopes -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthScopes -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthScopes -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthScopes)

instance ToSchema OAuthScopes where
  schema :: ValueSchema NamedSwaggerDoc OAuthScopes
schema = Set OAuthScope -> OAuthScopes
OAuthScopes (Set OAuthScope -> OAuthScopes)
-> SchemaP NamedSwaggerDoc Value Value OAuthScopes (Set OAuthScope)
-> ValueSchema NamedSwaggerDoc OAuthScopes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set OAuthScope -> Text
oauthScopesToText (Set OAuthScope -> Text)
-> (OAuthScopes -> Set OAuthScope) -> OAuthScopes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthScopes -> Set OAuthScope
unOAuthScopes) (OAuthScopes -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text (Set OAuthScope)
-> SchemaP NamedSwaggerDoc Value Value OAuthScopes (Set OAuthScope)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value Text Text
-> (Text -> Parser (Set OAuthScope))
-> SchemaP NamedSwaggerDoc Value Value Text (Set OAuthScope)
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema Text -> Parser (Set OAuthScope)
oauthScopeParser
    where
      oauthScopesToText :: Set OAuthScope -> Text
      oauthScopesToText :: Set OAuthScope -> Text
oauthScopesToText =
        Text -> [Text] -> Text
T.intercalate Text
" "
          ([Text] -> Text)
-> (Set OAuthScope -> [Text]) -> Set OAuthScope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OAuthScope -> Text) -> [OAuthScope] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (OAuthScope -> ByteString) -> OAuthScope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthScope -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString')
          ([OAuthScope] -> [Text])
-> (Set OAuthScope -> [OAuthScope]) -> Set OAuthScope -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set OAuthScope -> [OAuthScope]
forall a. Set a -> [a]
Set.toList

      oauthScopeParser :: Text -> A.Parser (Set OAuthScope)
      oauthScopeParser :: Text -> Parser (Set OAuthScope)
oauthScopeParser Text
scope =
        Set OAuthScope -> Parser (Set OAuthScope)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set OAuthScope -> Parser (Set OAuthScope))
-> Set OAuthScope -> Parser (Set OAuthScope)
forall a b. (a -> b) -> a -> b
$
          (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
            (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
`filter` HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
" " Text
scope
            [Text] -> ([Text] -> Set OAuthScope) -> Set OAuthScope
forall a b. a -> (a -> b) -> b
& Set OAuthScope
-> ([OAuthScope] -> Set OAuthScope)
-> Maybe [OAuthScope]
-> Set OAuthScope
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set OAuthScope
forall a. Set a
Set.empty [OAuthScope] -> Set OAuthScope
forall a. Ord a => [a] -> Set a
Set.fromList
              (Maybe [OAuthScope] -> Set OAuthScope)
-> ([Text] -> Maybe [OAuthScope]) -> [Text] -> Set OAuthScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe OAuthScope) -> [Text] -> Maybe [OAuthScope]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ByteString -> Maybe OAuthScope
forall a. FromByteString a => ByteString -> Maybe a
fromByteString' (ByteString -> Maybe OAuthScope)
-> (Text -> ByteString) -> Text -> Maybe OAuthScope
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
TE.encodeUtf8)

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

instance ToSchema CodeChallengeMethod where
  schema :: ValueSchema NamedSwaggerDoc CodeChallengeMethod
  schema :: ValueSchema NamedSwaggerDoc CodeChallengeMethod
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
"CodeChallengeMethod" (SchemaP
   [Value]
   Text
   (Alt Maybe Text)
   CodeChallengeMethod
   CodeChallengeMethod
 -> ValueSchema NamedSwaggerDoc CodeChallengeMethod)
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     CodeChallengeMethod
     CodeChallengeMethod
-> ValueSchema NamedSwaggerDoc CodeChallengeMethod
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value]
   Text
   (Alt Maybe Text)
   CodeChallengeMethod
   CodeChallengeMethod]
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     CodeChallengeMethod
     CodeChallengeMethod
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> CodeChallengeMethod
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     CodeChallengeMethod
     CodeChallengeMethod
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"S256" CodeChallengeMethod
S256
        ]

newtype OAuthCodeVerifier = OAuthCodeVerifier {OAuthCodeVerifier -> Range 43 128 Text
unOAuthCodeVerifier :: Range 43 128 Text}
  deriving (OAuthCodeVerifier -> OAuthCodeVerifier -> Bool
(OAuthCodeVerifier -> OAuthCodeVerifier -> Bool)
-> (OAuthCodeVerifier -> OAuthCodeVerifier -> Bool)
-> Eq OAuthCodeVerifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthCodeVerifier -> OAuthCodeVerifier -> Bool
== :: OAuthCodeVerifier -> OAuthCodeVerifier -> Bool
$c/= :: OAuthCodeVerifier -> OAuthCodeVerifier -> Bool
/= :: OAuthCodeVerifier -> OAuthCodeVerifier -> Bool
Eq, Int -> OAuthCodeVerifier -> ShowS
[OAuthCodeVerifier] -> ShowS
OAuthCodeVerifier -> String
(Int -> OAuthCodeVerifier -> ShowS)
-> (OAuthCodeVerifier -> String)
-> ([OAuthCodeVerifier] -> ShowS)
-> Show OAuthCodeVerifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthCodeVerifier -> ShowS
showsPrec :: Int -> OAuthCodeVerifier -> ShowS
$cshow :: OAuthCodeVerifier -> String
show :: OAuthCodeVerifier -> String
$cshowList :: [OAuthCodeVerifier] -> ShowS
showList :: [OAuthCodeVerifier] -> ShowS
Show, (forall x. OAuthCodeVerifier -> Rep OAuthCodeVerifier x)
-> (forall x. Rep OAuthCodeVerifier x -> OAuthCodeVerifier)
-> Generic OAuthCodeVerifier
forall x. Rep OAuthCodeVerifier x -> OAuthCodeVerifier
forall x. OAuthCodeVerifier -> Rep OAuthCodeVerifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthCodeVerifier -> Rep OAuthCodeVerifier x
from :: forall x. OAuthCodeVerifier -> Rep OAuthCodeVerifier x
$cto :: forall x. Rep OAuthCodeVerifier x -> OAuthCodeVerifier
to :: forall x. Rep OAuthCodeVerifier x -> OAuthCodeVerifier
Generic)
  deriving (Gen OAuthCodeVerifier
Gen OAuthCodeVerifier
-> (OAuthCodeVerifier -> [OAuthCodeVerifier])
-> Arbitrary OAuthCodeVerifier
OAuthCodeVerifier -> [OAuthCodeVerifier]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthCodeVerifier
arbitrary :: Gen OAuthCodeVerifier
$cshrink :: OAuthCodeVerifier -> [OAuthCodeVerifier]
shrink :: OAuthCodeVerifier -> [OAuthCodeVerifier]
Arbitrary) via (GenericUniform OAuthCodeVerifier)
  deriving ([OAuthCodeVerifier] -> Value
[OAuthCodeVerifier] -> Encoding
OAuthCodeVerifier -> Value
OAuthCodeVerifier -> Encoding
(OAuthCodeVerifier -> Value)
-> (OAuthCodeVerifier -> Encoding)
-> ([OAuthCodeVerifier] -> Value)
-> ([OAuthCodeVerifier] -> Encoding)
-> ToJSON OAuthCodeVerifier
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthCodeVerifier -> Value
toJSON :: OAuthCodeVerifier -> Value
$ctoEncoding :: OAuthCodeVerifier -> Encoding
toEncoding :: OAuthCodeVerifier -> Encoding
$ctoJSONList :: [OAuthCodeVerifier] -> Value
toJSONList :: [OAuthCodeVerifier] -> Value
$ctoEncodingList :: [OAuthCodeVerifier] -> Encoding
toEncodingList :: [OAuthCodeVerifier] -> Encoding
A.ToJSON, Value -> Parser [OAuthCodeVerifier]
Value -> Parser OAuthCodeVerifier
(Value -> Parser OAuthCodeVerifier)
-> (Value -> Parser [OAuthCodeVerifier])
-> FromJSON OAuthCodeVerifier
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthCodeVerifier
parseJSON :: Value -> Parser OAuthCodeVerifier
$cparseJSONList :: Value -> Parser [OAuthCodeVerifier]
parseJSONList :: Value -> Parser [OAuthCodeVerifier]
A.FromJSON, Typeable OAuthCodeVerifier
Typeable OAuthCodeVerifier =>
(Proxy OAuthCodeVerifier
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthCodeVerifier
Proxy OAuthCodeVerifier -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthCodeVerifier -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthCodeVerifier -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthCodeVerifier)

instance ToSchema OAuthCodeVerifier where
  schema :: ValueSchema NamedSwaggerDoc OAuthCodeVerifier
  schema :: ValueSchema NamedSwaggerDoc OAuthCodeVerifier
schema = Range 43 128 Text -> OAuthCodeVerifier
OAuthCodeVerifier (Range 43 128 Text -> OAuthCodeVerifier)
-> SchemaP
     NamedSwaggerDoc Value Value OAuthCodeVerifier (Range 43 128 Text)
-> ValueSchema NamedSwaggerDoc OAuthCodeVerifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OAuthCodeVerifier -> Range 43 128 Text
unOAuthCodeVerifier (OAuthCodeVerifier -> Range 43 128 Text)
-> SchemaP
     NamedSwaggerDoc Value Value (Range 43 128 Text) (Range 43 128 Text)
-> SchemaP
     NamedSwaggerDoc Value Value OAuthCodeVerifier (Range 43 128 Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  NamedSwaggerDoc Value Value (Range 43 128 Text) (Range 43 128 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance FromHttpApiData OAuthCodeVerifier where
  parseQueryParam :: Text -> Either Text OAuthCodeVerifier
parseQueryParam = (Range 43 128 Text -> OAuthCodeVerifier)
-> Either Text (Range 43 128 Text) -> Either Text OAuthCodeVerifier
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range 43 128 Text -> OAuthCodeVerifier
OAuthCodeVerifier (Either Text (Range 43 128 Text) -> Either Text OAuthCodeVerifier)
-> (Text -> Either Text (Range 43 128 Text))
-> Text
-> Either Text OAuthCodeVerifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text)
-> Either String (Range 43 128 Text)
-> Either Text (Range 43 128 Text)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Text
T.pack (Either String (Range 43 128 Text)
 -> Either Text (Range 43 128 Text))
-> (Text -> Either String (Range 43 128 Text))
-> Text
-> Either Text (Range 43 128 Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Range 43 128 Text)
forall a (n :: Nat) (m :: Nat).
(KnownNat n, KnownNat m, Within a n m) =>
a -> Either String (Range n m a)
checkedEither

instance ToHttpApiData OAuthCodeVerifier where
  toQueryParam :: OAuthCodeVerifier -> Text
toQueryParam = Range 43 128 Text -> Text
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 43 128 Text -> Text)
-> (OAuthCodeVerifier -> Range 43 128 Text)
-> OAuthCodeVerifier
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthCodeVerifier -> Range 43 128 Text
unOAuthCodeVerifier

newtype OAuthCodeChallenge = OAuthCodeChallenge {OAuthCodeChallenge -> Text
unOAuthCodeChallenge :: Text}
  deriving (OAuthCodeChallenge -> OAuthCodeChallenge -> Bool
(OAuthCodeChallenge -> OAuthCodeChallenge -> Bool)
-> (OAuthCodeChallenge -> OAuthCodeChallenge -> Bool)
-> Eq OAuthCodeChallenge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthCodeChallenge -> OAuthCodeChallenge -> Bool
== :: OAuthCodeChallenge -> OAuthCodeChallenge -> Bool
$c/= :: OAuthCodeChallenge -> OAuthCodeChallenge -> Bool
/= :: OAuthCodeChallenge -> OAuthCodeChallenge -> Bool
Eq, Int -> OAuthCodeChallenge -> ShowS
[OAuthCodeChallenge] -> ShowS
OAuthCodeChallenge -> String
(Int -> OAuthCodeChallenge -> ShowS)
-> (OAuthCodeChallenge -> String)
-> ([OAuthCodeChallenge] -> ShowS)
-> Show OAuthCodeChallenge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthCodeChallenge -> ShowS
showsPrec :: Int -> OAuthCodeChallenge -> ShowS
$cshow :: OAuthCodeChallenge -> String
show :: OAuthCodeChallenge -> String
$cshowList :: [OAuthCodeChallenge] -> ShowS
showList :: [OAuthCodeChallenge] -> ShowS
Show, (forall x. OAuthCodeChallenge -> Rep OAuthCodeChallenge x)
-> (forall x. Rep OAuthCodeChallenge x -> OAuthCodeChallenge)
-> Generic OAuthCodeChallenge
forall x. Rep OAuthCodeChallenge x -> OAuthCodeChallenge
forall x. OAuthCodeChallenge -> Rep OAuthCodeChallenge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthCodeChallenge -> Rep OAuthCodeChallenge x
from :: forall x. OAuthCodeChallenge -> Rep OAuthCodeChallenge x
$cto :: forall x. Rep OAuthCodeChallenge x -> OAuthCodeChallenge
to :: forall x. Rep OAuthCodeChallenge x -> OAuthCodeChallenge
Generic)
  deriving (Gen OAuthCodeChallenge
Gen OAuthCodeChallenge
-> (OAuthCodeChallenge -> [OAuthCodeChallenge])
-> Arbitrary OAuthCodeChallenge
OAuthCodeChallenge -> [OAuthCodeChallenge]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthCodeChallenge
arbitrary :: Gen OAuthCodeChallenge
$cshrink :: OAuthCodeChallenge -> [OAuthCodeChallenge]
shrink :: OAuthCodeChallenge -> [OAuthCodeChallenge]
Arbitrary) via (GenericUniform OAuthCodeChallenge)
  deriving ([OAuthCodeChallenge] -> Value
[OAuthCodeChallenge] -> Encoding
OAuthCodeChallenge -> Value
OAuthCodeChallenge -> Encoding
(OAuthCodeChallenge -> Value)
-> (OAuthCodeChallenge -> Encoding)
-> ([OAuthCodeChallenge] -> Value)
-> ([OAuthCodeChallenge] -> Encoding)
-> ToJSON OAuthCodeChallenge
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthCodeChallenge -> Value
toJSON :: OAuthCodeChallenge -> Value
$ctoEncoding :: OAuthCodeChallenge -> Encoding
toEncoding :: OAuthCodeChallenge -> Encoding
$ctoJSONList :: [OAuthCodeChallenge] -> Value
toJSONList :: [OAuthCodeChallenge] -> Value
$ctoEncodingList :: [OAuthCodeChallenge] -> Encoding
toEncodingList :: [OAuthCodeChallenge] -> Encoding
A.ToJSON, Value -> Parser [OAuthCodeChallenge]
Value -> Parser OAuthCodeChallenge
(Value -> Parser OAuthCodeChallenge)
-> (Value -> Parser [OAuthCodeChallenge])
-> FromJSON OAuthCodeChallenge
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthCodeChallenge
parseJSON :: Value -> Parser OAuthCodeChallenge
$cparseJSONList :: Value -> Parser [OAuthCodeChallenge]
parseJSONList :: Value -> Parser [OAuthCodeChallenge]
A.FromJSON, Typeable OAuthCodeChallenge
Typeable OAuthCodeChallenge =>
(Proxy OAuthCodeChallenge
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthCodeChallenge
Proxy OAuthCodeChallenge
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthCodeChallenge
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthCodeChallenge
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthCodeChallenge)

instance ToSchema OAuthCodeChallenge where
  schema :: ValueSchema NamedSwaggerDoc OAuthCodeChallenge
schema = Text
-> SchemaP
     SwaggerDoc Value Value OAuthCodeChallenge OAuthCodeChallenge
-> ValueSchema NamedSwaggerDoc OAuthCodeChallenge
forall doc doc' v m a b.
HasObject doc doc' =>
Text -> SchemaP doc v m a b -> SchemaP doc' v m a b
named Text
"OAuthCodeChallenge" (SchemaP
   SwaggerDoc Value Value OAuthCodeChallenge OAuthCodeChallenge
 -> ValueSchema NamedSwaggerDoc OAuthCodeChallenge)
-> SchemaP
     SwaggerDoc Value Value OAuthCodeChallenge OAuthCodeChallenge
-> ValueSchema NamedSwaggerDoc OAuthCodeChallenge
forall a b. (a -> b) -> a -> b
$ OAuthCodeChallenge -> Text
unOAuthCodeChallenge (OAuthCodeChallenge -> Text)
-> SchemaP SwaggerDoc Value Value Text OAuthCodeChallenge
-> SchemaP
     SwaggerDoc Value Value OAuthCodeChallenge OAuthCodeChallenge
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Text -> OAuthCodeChallenge)
-> SchemaP SwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value Text OAuthCodeChallenge
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Value Value Text a
-> SchemaP SwaggerDoc Value Value Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> OAuthCodeChallenge
OAuthCodeChallenge (SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value Text Text
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance ToByteString OAuthCodeChallenge where
  builder :: OAuthCodeChallenge -> Builder
builder = Text -> Builder
forall a. ToByteString a => a -> Builder
builder (Text -> Builder)
-> (OAuthCodeChallenge -> Text) -> OAuthCodeChallenge -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthCodeChallenge -> Text
unOAuthCodeChallenge

instance FromByteString OAuthCodeChallenge where
  parser :: Parser OAuthCodeChallenge
parser = Text -> OAuthCodeChallenge
OAuthCodeChallenge (Text -> OAuthCodeChallenge)
-> Parser Text -> Parser OAuthCodeChallenge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
forall a. FromByteString a => Parser a
parser

verifyCodeChallenge :: OAuthCodeVerifier -> OAuthCodeChallenge -> Bool
verifyCodeChallenge :: OAuthCodeVerifier -> OAuthCodeChallenge -> Bool
verifyCodeChallenge OAuthCodeVerifier
verifier OAuthCodeChallenge
challenge = OAuthCodeChallenge
challenge OAuthCodeChallenge -> OAuthCodeChallenge -> Bool
forall a. Eq a => a -> a -> Bool
== OAuthCodeVerifier -> OAuthCodeChallenge
mkChallenge OAuthCodeVerifier
verifier

mkChallenge :: OAuthCodeVerifier -> OAuthCodeChallenge
mkChallenge :: OAuthCodeVerifier -> OAuthCodeChallenge
mkChallenge =
  Text -> OAuthCodeChallenge
OAuthCodeChallenge
    (Text -> OAuthCodeChallenge)
-> (OAuthCodeVerifier -> Text)
-> OAuthCodeVerifier
-> OAuthCodeChallenge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
toText
    (AsciiText Base64Url -> Text)
-> (OAuthCodeVerifier -> AsciiText Base64Url)
-> OAuthCodeVerifier
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiText Base64Url
encodeBase64UrlUnpadded
    (ByteString -> AsciiText Base64Url)
-> (OAuthCodeVerifier -> ByteString)
-> OAuthCodeVerifier
-> AsciiText Base64Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert
    (Digest SHA256 -> ByteString)
-> (OAuthCodeVerifier -> Digest SHA256)
-> OAuthCodeVerifier
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash @ByteString @Crypto.SHA256
    (ByteString -> Digest SHA256)
-> (OAuthCodeVerifier -> ByteString)
-> OAuthCodeVerifier
-> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
    (Text -> ByteString)
-> (OAuthCodeVerifier -> Text) -> OAuthCodeVerifier -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 43 128 Text -> Text
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange
    (Range 43 128 Text -> Text)
-> (OAuthCodeVerifier -> Range 43 128 Text)
-> OAuthCodeVerifier
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthCodeVerifier -> Range 43 128 Text
unOAuthCodeVerifier

data CreateOAuthAuthorizationCodeRequest = CreateOAuthAuthorizationCodeRequest
  { CreateOAuthAuthorizationCodeRequest -> OAuthClientId
clientId :: OAuthClientId,
    CreateOAuthAuthorizationCodeRequest -> OAuthScopes
scope :: OAuthScopes,
    CreateOAuthAuthorizationCodeRequest -> OAuthResponseType
responseType :: OAuthResponseType,
    CreateOAuthAuthorizationCodeRequest -> RedirectUrl
redirectUri :: RedirectUrl,
    CreateOAuthAuthorizationCodeRequest -> Text
state :: Text,
    CreateOAuthAuthorizationCodeRequest -> CodeChallengeMethod
codeChallengeMethod :: CodeChallengeMethod,
    CreateOAuthAuthorizationCodeRequest -> OAuthCodeChallenge
codeChallenge :: OAuthCodeChallenge
  }
  deriving (CreateOAuthAuthorizationCodeRequest
-> CreateOAuthAuthorizationCodeRequest -> Bool
(CreateOAuthAuthorizationCodeRequest
 -> CreateOAuthAuthorizationCodeRequest -> Bool)
-> (CreateOAuthAuthorizationCodeRequest
    -> CreateOAuthAuthorizationCodeRequest -> Bool)
-> Eq CreateOAuthAuthorizationCodeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateOAuthAuthorizationCodeRequest
-> CreateOAuthAuthorizationCodeRequest -> Bool
== :: CreateOAuthAuthorizationCodeRequest
-> CreateOAuthAuthorizationCodeRequest -> Bool
$c/= :: CreateOAuthAuthorizationCodeRequest
-> CreateOAuthAuthorizationCodeRequest -> Bool
/= :: CreateOAuthAuthorizationCodeRequest
-> CreateOAuthAuthorizationCodeRequest -> Bool
Eq, Int -> CreateOAuthAuthorizationCodeRequest -> ShowS
[CreateOAuthAuthorizationCodeRequest] -> ShowS
CreateOAuthAuthorizationCodeRequest -> String
(Int -> CreateOAuthAuthorizationCodeRequest -> ShowS)
-> (CreateOAuthAuthorizationCodeRequest -> String)
-> ([CreateOAuthAuthorizationCodeRequest] -> ShowS)
-> Show CreateOAuthAuthorizationCodeRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateOAuthAuthorizationCodeRequest -> ShowS
showsPrec :: Int -> CreateOAuthAuthorizationCodeRequest -> ShowS
$cshow :: CreateOAuthAuthorizationCodeRequest -> String
show :: CreateOAuthAuthorizationCodeRequest -> String
$cshowList :: [CreateOAuthAuthorizationCodeRequest] -> ShowS
showList :: [CreateOAuthAuthorizationCodeRequest] -> ShowS
Show, (forall x.
 CreateOAuthAuthorizationCodeRequest
 -> Rep CreateOAuthAuthorizationCodeRequest x)
-> (forall x.
    Rep CreateOAuthAuthorizationCodeRequest x
    -> CreateOAuthAuthorizationCodeRequest)
-> Generic CreateOAuthAuthorizationCodeRequest
forall x.
Rep CreateOAuthAuthorizationCodeRequest x
-> CreateOAuthAuthorizationCodeRequest
forall x.
CreateOAuthAuthorizationCodeRequest
-> Rep CreateOAuthAuthorizationCodeRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateOAuthAuthorizationCodeRequest
-> Rep CreateOAuthAuthorizationCodeRequest x
from :: forall x.
CreateOAuthAuthorizationCodeRequest
-> Rep CreateOAuthAuthorizationCodeRequest x
$cto :: forall x.
Rep CreateOAuthAuthorizationCodeRequest x
-> CreateOAuthAuthorizationCodeRequest
to :: forall x.
Rep CreateOAuthAuthorizationCodeRequest x
-> CreateOAuthAuthorizationCodeRequest
Generic)
  deriving (Gen CreateOAuthAuthorizationCodeRequest
Gen CreateOAuthAuthorizationCodeRequest
-> (CreateOAuthAuthorizationCodeRequest
    -> [CreateOAuthAuthorizationCodeRequest])
-> Arbitrary CreateOAuthAuthorizationCodeRequest
CreateOAuthAuthorizationCodeRequest
-> [CreateOAuthAuthorizationCodeRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CreateOAuthAuthorizationCodeRequest
arbitrary :: Gen CreateOAuthAuthorizationCodeRequest
$cshrink :: CreateOAuthAuthorizationCodeRequest
-> [CreateOAuthAuthorizationCodeRequest]
shrink :: CreateOAuthAuthorizationCodeRequest
-> [CreateOAuthAuthorizationCodeRequest]
Arbitrary) via (GenericUniform CreateOAuthAuthorizationCodeRequest)
  deriving ([CreateOAuthAuthorizationCodeRequest] -> Value
[CreateOAuthAuthorizationCodeRequest] -> Encoding
CreateOAuthAuthorizationCodeRequest -> Value
CreateOAuthAuthorizationCodeRequest -> Encoding
(CreateOAuthAuthorizationCodeRequest -> Value)
-> (CreateOAuthAuthorizationCodeRequest -> Encoding)
-> ([CreateOAuthAuthorizationCodeRequest] -> Value)
-> ([CreateOAuthAuthorizationCodeRequest] -> Encoding)
-> ToJSON CreateOAuthAuthorizationCodeRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CreateOAuthAuthorizationCodeRequest -> Value
toJSON :: CreateOAuthAuthorizationCodeRequest -> Value
$ctoEncoding :: CreateOAuthAuthorizationCodeRequest -> Encoding
toEncoding :: CreateOAuthAuthorizationCodeRequest -> Encoding
$ctoJSONList :: [CreateOAuthAuthorizationCodeRequest] -> Value
toJSONList :: [CreateOAuthAuthorizationCodeRequest] -> Value
$ctoEncodingList :: [CreateOAuthAuthorizationCodeRequest] -> Encoding
toEncodingList :: [CreateOAuthAuthorizationCodeRequest] -> Encoding
A.ToJSON, Value -> Parser [CreateOAuthAuthorizationCodeRequest]
Value -> Parser CreateOAuthAuthorizationCodeRequest
(Value -> Parser CreateOAuthAuthorizationCodeRequest)
-> (Value -> Parser [CreateOAuthAuthorizationCodeRequest])
-> FromJSON CreateOAuthAuthorizationCodeRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CreateOAuthAuthorizationCodeRequest
parseJSON :: Value -> Parser CreateOAuthAuthorizationCodeRequest
$cparseJSONList :: Value -> Parser [CreateOAuthAuthorizationCodeRequest]
parseJSONList :: Value -> Parser [CreateOAuthAuthorizationCodeRequest]
A.FromJSON, Typeable CreateOAuthAuthorizationCodeRequest
Typeable CreateOAuthAuthorizationCodeRequest =>
(Proxy CreateOAuthAuthorizationCodeRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CreateOAuthAuthorizationCodeRequest
Proxy CreateOAuthAuthorizationCodeRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CreateOAuthAuthorizationCodeRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CreateOAuthAuthorizationCodeRequest
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema CreateOAuthAuthorizationCodeRequest)

instance ToSchema CreateOAuthAuthorizationCodeRequest where
  schema :: ValueSchema NamedSwaggerDoc CreateOAuthAuthorizationCodeRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     CreateOAuthAuthorizationCodeRequest
-> ValueSchema NamedSwaggerDoc CreateOAuthAuthorizationCodeRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"CreateOAuthAuthorizationCodeRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   CreateOAuthAuthorizationCodeRequest
   CreateOAuthAuthorizationCodeRequest
 -> ValueSchema NamedSwaggerDoc CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     CreateOAuthAuthorizationCodeRequest
-> ValueSchema NamedSwaggerDoc CreateOAuthAuthorizationCodeRequest
forall a b. (a -> b) -> a -> b
$
      OAuthClientId
-> OAuthScopes
-> OAuthResponseType
-> RedirectUrl
-> Text
-> CodeChallengeMethod
-> OAuthCodeChallenge
-> CreateOAuthAuthorizationCodeRequest
CreateOAuthAuthorizationCodeRequest
        (OAuthClientId
 -> OAuthScopes
 -> OAuthResponseType
 -> RedirectUrl
 -> Text
 -> CodeChallengeMethod
 -> OAuthCodeChallenge
 -> CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     (OAuthScopes
      -> OAuthResponseType
      -> RedirectUrl
      -> Text
      -> CodeChallengeMethod
      -> OAuthCodeChallenge
      -> CreateOAuthAuthorizationCodeRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.clientId)
          (CreateOAuthAuthorizationCodeRequest -> OAuthClientId)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"client_id" NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (OAuthScopes
   -> OAuthResponseType
   -> RedirectUrl
   -> Text
   -> CodeChallengeMethod
   -> OAuthCodeChallenge
   -> CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthScopes
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     (OAuthResponseType
      -> RedirectUrl
      -> Text
      -> CodeChallengeMethod
      -> OAuthCodeChallenge
      -> CreateOAuthAuthorizationCodeRequest)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest a
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.scope)
          (CreateOAuthAuthorizationCodeRequest -> OAuthScopes)
-> SchemaP SwaggerDoc Object [Pair] OAuthScopes OAuthScopes
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthScopes
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthScopes
-> SchemaP SwaggerDoc Object [Pair] OAuthScopes OAuthScopes
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"scope" NamedSwaggerDoc -> NamedSwaggerDoc
scopeDescription ValueSchema NamedSwaggerDoc OAuthScopes
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (OAuthResponseType
   -> RedirectUrl
   -> Text
   -> CodeChallengeMethod
   -> OAuthCodeChallenge
   -> CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthResponseType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     (RedirectUrl
      -> Text
      -> CodeChallengeMethod
      -> OAuthCodeChallenge
      -> CreateOAuthAuthorizationCodeRequest)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest a
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.responseType)
          (CreateOAuthAuthorizationCodeRequest -> OAuthResponseType)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthResponseType OAuthResponseType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthResponseType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthResponseType
-> SchemaP
     SwaggerDoc Object [Pair] OAuthResponseType OAuthResponseType
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"response_type" NamedSwaggerDoc -> NamedSwaggerDoc
responseTypeDescription ValueSchema NamedSwaggerDoc OAuthResponseType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (RedirectUrl
   -> Text
   -> CodeChallengeMethod
   -> OAuthCodeChallenge
   -> CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     RedirectUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     (Text
      -> CodeChallengeMethod
      -> OAuthCodeChallenge
      -> CreateOAuthAuthorizationCodeRequest)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest a
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.redirectUri)
          (CreateOAuthAuthorizationCodeRequest -> RedirectUrl)
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     RedirectUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc RedirectUrl
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"redirect_uri" NamedSwaggerDoc -> NamedSwaggerDoc
redirectUriDescription ValueSchema NamedSwaggerDoc RedirectUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (Text
   -> CodeChallengeMethod
   -> OAuthCodeChallenge
   -> CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     (CodeChallengeMethod
      -> OAuthCodeChallenge -> CreateOAuthAuthorizationCodeRequest)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest a
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.state)
          (CreateOAuthAuthorizationCodeRequest -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"state" NamedSwaggerDoc -> NamedSwaggerDoc
stateDescription SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (CodeChallengeMethod
   -> OAuthCodeChallenge -> CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     CodeChallengeMethod
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     (OAuthCodeChallenge -> CreateOAuthAuthorizationCodeRequest)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest a
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.codeChallengeMethod)
          (CreateOAuthAuthorizationCodeRequest -> CodeChallengeMethod)
-> SchemaP
     SwaggerDoc Object [Pair] CodeChallengeMethod CodeChallengeMethod
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     CodeChallengeMethod
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc CodeChallengeMethod
-> SchemaP
     SwaggerDoc Object [Pair] CodeChallengeMethod CodeChallengeMethod
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"code_challenge_method" NamedSwaggerDoc -> NamedSwaggerDoc
codeChallengeMethodDescription ValueSchema NamedSwaggerDoc CodeChallengeMethod
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (OAuthCodeChallenge -> CreateOAuthAuthorizationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthCodeChallenge
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     CreateOAuthAuthorizationCodeRequest
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  CreateOAuthAuthorizationCodeRequest
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest a
-> SchemaP
     SwaggerDoc Object [Pair] CreateOAuthAuthorizationCodeRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.codeChallenge)
          (CreateOAuthAuthorizationCodeRequest -> OAuthCodeChallenge)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthCodeChallenge OAuthCodeChallenge
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateOAuthAuthorizationCodeRequest
     OAuthCodeChallenge
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthCodeChallenge
-> SchemaP
     SwaggerDoc Object [Pair] OAuthCodeChallenge OAuthCodeChallenge
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"code_challenge" NamedSwaggerDoc -> NamedSwaggerDoc
codeChallengeDescription ValueSchema NamedSwaggerDoc OAuthCodeChallenge
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      clientIdDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The ID of the OAuth client"
      scopeDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
scopeDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The scopes which are requested to get authorization for, separated by a space"
      responseTypeDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
responseTypeDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Indicates which authorization flow to use. Use `code` for authorization code flow."
      redirectUriDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
redirectUriDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The URL to which to redirect the browser after authorization has been granted by the user."
      stateDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
stateDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"An opaque value used by the client to maintain state between the request and callback. The authorization server includes this value when redirecting the user-agent back to the client.  The parameter SHOULD be used for preventing cross-site request forgery"
      codeChallengeMethodDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
codeChallengeMethodDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The method used to encode the code challenge. Only `S256` is supported."
      codeChallengeDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
codeChallengeDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Generated by the client from the code verifier (unpadded base64url-encoded SHA256 hash of the code verifier)"

newtype OAuthAuthorizationCode = OAuthAuthorizationCode {OAuthAuthorizationCode -> AsciiBase16
unOAuthAuthorizationCode :: AsciiBase16}
  deriving (OAuthAuthorizationCode -> OAuthAuthorizationCode -> Bool
(OAuthAuthorizationCode -> OAuthAuthorizationCode -> Bool)
-> (OAuthAuthorizationCode -> OAuthAuthorizationCode -> Bool)
-> Eq OAuthAuthorizationCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthAuthorizationCode -> OAuthAuthorizationCode -> Bool
== :: OAuthAuthorizationCode -> OAuthAuthorizationCode -> Bool
$c/= :: OAuthAuthorizationCode -> OAuthAuthorizationCode -> Bool
/= :: OAuthAuthorizationCode -> OAuthAuthorizationCode -> Bool
Eq, (forall x. OAuthAuthorizationCode -> Rep OAuthAuthorizationCode x)
-> (forall x.
    Rep OAuthAuthorizationCode x -> OAuthAuthorizationCode)
-> Generic OAuthAuthorizationCode
forall x. Rep OAuthAuthorizationCode x -> OAuthAuthorizationCode
forall x. OAuthAuthorizationCode -> Rep OAuthAuthorizationCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthAuthorizationCode -> Rep OAuthAuthorizationCode x
from :: forall x. OAuthAuthorizationCode -> Rep OAuthAuthorizationCode x
$cto :: forall x. Rep OAuthAuthorizationCode x -> OAuthAuthorizationCode
to :: forall x. Rep OAuthAuthorizationCode x -> OAuthAuthorizationCode
Generic, Gen OAuthAuthorizationCode
Gen OAuthAuthorizationCode
-> (OAuthAuthorizationCode -> [OAuthAuthorizationCode])
-> Arbitrary OAuthAuthorizationCode
OAuthAuthorizationCode -> [OAuthAuthorizationCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthAuthorizationCode
arbitrary :: Gen OAuthAuthorizationCode
$cshrink :: OAuthAuthorizationCode -> [OAuthAuthorizationCode]
shrink :: OAuthAuthorizationCode -> [OAuthAuthorizationCode]
Arbitrary)

instance Show OAuthAuthorizationCode where
  show :: OAuthAuthorizationCode -> String
show OAuthAuthorizationCode
_ = String
"<OAuthAuthorizationCode>"

instance ToSchema OAuthAuthorizationCode where
  schema :: ValueSchema NamedSwaggerDoc OAuthAuthorizationCode
schema = (AsciiBase16 -> Text
forall {k} (c :: k). AsciiText c -> Text
toText (AsciiBase16 -> Text)
-> (OAuthAuthorizationCode -> AsciiBase16)
-> OAuthAuthorizationCode
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthAuthorizationCode -> AsciiBase16
unOAuthAuthorizationCode) (OAuthAuthorizationCode -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text OAuthAuthorizationCode
-> ValueSchema NamedSwaggerDoc OAuthAuthorizationCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String OAuthAuthorizationCode)
-> SchemaP NamedSwaggerDoc Value Value Text OAuthAuthorizationCode
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"OAuthAuthorizationCode" ((AsciiBase16 -> OAuthAuthorizationCode)
-> Either String AsciiBase16
-> Either String OAuthAuthorizationCode
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AsciiBase16 -> OAuthAuthorizationCode
OAuthAuthorizationCode (Either String AsciiBase16 -> Either String OAuthAuthorizationCode)
-> (Text -> Either String AsciiBase16)
-> Text
-> Either String OAuthAuthorizationCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String AsciiBase16
validateBase16)

instance ToByteString OAuthAuthorizationCode where
  builder :: OAuthAuthorizationCode -> Builder
builder = AsciiBase16 -> Builder
forall a. ToByteString a => a -> Builder
builder (AsciiBase16 -> Builder)
-> (OAuthAuthorizationCode -> AsciiBase16)
-> OAuthAuthorizationCode
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthAuthorizationCode -> AsciiBase16
unOAuthAuthorizationCode

instance FromByteString OAuthAuthorizationCode where
  parser :: Parser OAuthAuthorizationCode
parser = AsciiBase16 -> OAuthAuthorizationCode
OAuthAuthorizationCode (AsciiBase16 -> OAuthAuthorizationCode)
-> Parser ByteString AsciiBase16 -> Parser OAuthAuthorizationCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AsciiBase16
forall a. FromByteString a => Parser a
parser

instance FromHttpApiData OAuthAuthorizationCode where
  parseQueryParam :: Text -> Either Text OAuthAuthorizationCode
parseQueryParam = (String -> Text)
-> (AsciiBase16 -> OAuthAuthorizationCode)
-> Either String AsciiBase16
-> Either Text OAuthAuthorizationCode
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack AsciiBase16 -> OAuthAuthorizationCode
OAuthAuthorizationCode (Either String AsciiBase16 -> Either Text OAuthAuthorizationCode)
-> (Text -> Either String AsciiBase16)
-> Text
-> Either Text OAuthAuthorizationCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String AsciiBase16
validateBase16

instance ToHttpApiData OAuthAuthorizationCode where
  toQueryParam :: OAuthAuthorizationCode -> Text
toQueryParam = AsciiBase16 -> Text
forall {k} (c :: k). AsciiText c -> Text
toText (AsciiBase16 -> Text)
-> (OAuthAuthorizationCode -> AsciiBase16)
-> OAuthAuthorizationCode
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthAuthorizationCode -> AsciiBase16
unOAuthAuthorizationCode

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

instance ToSchema OAuthGrantType where
  schema :: ValueSchema NamedSwaggerDoc OAuthGrantType
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
"OAuthGrantType" (SchemaP
   [Value] Text (Alt Maybe Text) OAuthGrantType OAuthGrantType
 -> ValueSchema NamedSwaggerDoc OAuthGrantType)
-> SchemaP
     [Value] Text (Alt Maybe Text) OAuthGrantType OAuthGrantType
-> ValueSchema NamedSwaggerDoc OAuthGrantType
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value] Text (Alt Maybe Text) OAuthGrantType OAuthGrantType]
-> SchemaP
     [Value] Text (Alt Maybe Text) OAuthGrantType OAuthGrantType
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> OAuthGrantType
-> SchemaP
     [Value] Text (Alt Maybe Text) OAuthGrantType OAuthGrantType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"authorization_code" OAuthGrantType
OAuthGrantTypeAuthorizationCode,
          Text
-> OAuthGrantType
-> SchemaP
     [Value] Text (Alt Maybe Text) OAuthGrantType OAuthGrantType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"refresh_token" OAuthGrantType
OAuthGrantTypeRefreshToken
        ]

instance FromByteString OAuthGrantType where
  parser :: Parser OAuthGrantType
parser = do
    Text
s <- Parser Text
forall a. FromByteString a => Parser a
parser
    case Text -> Text
T.toLower Text
s of
      Text
"authorization_code" -> OAuthGrantType -> Parser OAuthGrantType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OAuthGrantType
OAuthGrantTypeAuthorizationCode
      Text
"refresh_token" -> OAuthGrantType -> Parser OAuthGrantType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OAuthGrantType
OAuthGrantTypeRefreshToken
      Text
_ -> String -> Parser OAuthGrantType
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid OAuthGrantType"

instance ToByteString OAuthGrantType where
  builder :: OAuthGrantType -> Builder
builder = \case
    OAuthGrantType
OAuthGrantTypeAuthorizationCode -> Builder
"authorization_code"
    OAuthGrantType
OAuthGrantTypeRefreshToken -> Builder
"refresh_token"

instance FromHttpApiData OAuthGrantType where
  parseQueryParam :: Text -> Either Text OAuthGrantType
parseQueryParam = Either Text OAuthGrantType
-> (OAuthGrantType -> Either Text OAuthGrantType)
-> Maybe OAuthGrantType
-> Either Text OAuthGrantType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text OAuthGrantType
forall a b. a -> Either a b
Left Text
"invalid OAuthGrantType") OAuthGrantType -> Either Text OAuthGrantType
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OAuthGrantType -> Either Text OAuthGrantType)
-> (Text -> Maybe OAuthGrantType)
-> Text
-> Either Text OAuthGrantType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe OAuthGrantType
forall a. FromByteString a => ByteString -> Maybe a
fromByteString (ByteString -> Maybe OAuthGrantType)
-> (Text -> ByteString) -> Text -> Maybe OAuthGrantType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

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

data OAuthAccessTokenRequest = OAuthAccessTokenRequest
  { OAuthAccessTokenRequest -> OAuthGrantType
grantType :: OAuthGrantType,
    OAuthAccessTokenRequest -> OAuthClientId
clientId :: OAuthClientId,
    OAuthAccessTokenRequest -> OAuthCodeVerifier
codeVerifier :: OAuthCodeVerifier,
    OAuthAccessTokenRequest -> OAuthAuthorizationCode
code :: OAuthAuthorizationCode,
    OAuthAccessTokenRequest -> RedirectUrl
redirectUri :: RedirectUrl
  }
  deriving (OAuthAccessTokenRequest -> OAuthAccessTokenRequest -> Bool
(OAuthAccessTokenRequest -> OAuthAccessTokenRequest -> Bool)
-> (OAuthAccessTokenRequest -> OAuthAccessTokenRequest -> Bool)
-> Eq OAuthAccessTokenRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthAccessTokenRequest -> OAuthAccessTokenRequest -> Bool
== :: OAuthAccessTokenRequest -> OAuthAccessTokenRequest -> Bool
$c/= :: OAuthAccessTokenRequest -> OAuthAccessTokenRequest -> Bool
/= :: OAuthAccessTokenRequest -> OAuthAccessTokenRequest -> Bool
Eq, Int -> OAuthAccessTokenRequest -> ShowS
[OAuthAccessTokenRequest] -> ShowS
OAuthAccessTokenRequest -> String
(Int -> OAuthAccessTokenRequest -> ShowS)
-> (OAuthAccessTokenRequest -> String)
-> ([OAuthAccessTokenRequest] -> ShowS)
-> Show OAuthAccessTokenRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthAccessTokenRequest -> ShowS
showsPrec :: Int -> OAuthAccessTokenRequest -> ShowS
$cshow :: OAuthAccessTokenRequest -> String
show :: OAuthAccessTokenRequest -> String
$cshowList :: [OAuthAccessTokenRequest] -> ShowS
showList :: [OAuthAccessTokenRequest] -> ShowS
Show, (forall x.
 OAuthAccessTokenRequest -> Rep OAuthAccessTokenRequest x)
-> (forall x.
    Rep OAuthAccessTokenRequest x -> OAuthAccessTokenRequest)
-> Generic OAuthAccessTokenRequest
forall x. Rep OAuthAccessTokenRequest x -> OAuthAccessTokenRequest
forall x. OAuthAccessTokenRequest -> Rep OAuthAccessTokenRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthAccessTokenRequest -> Rep OAuthAccessTokenRequest x
from :: forall x. OAuthAccessTokenRequest -> Rep OAuthAccessTokenRequest x
$cto :: forall x. Rep OAuthAccessTokenRequest x -> OAuthAccessTokenRequest
to :: forall x. Rep OAuthAccessTokenRequest x -> OAuthAccessTokenRequest
Generic)
  deriving (Gen OAuthAccessTokenRequest
Gen OAuthAccessTokenRequest
-> (OAuthAccessTokenRequest -> [OAuthAccessTokenRequest])
-> Arbitrary OAuthAccessTokenRequest
OAuthAccessTokenRequest -> [OAuthAccessTokenRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthAccessTokenRequest
arbitrary :: Gen OAuthAccessTokenRequest
$cshrink :: OAuthAccessTokenRequest -> [OAuthAccessTokenRequest]
shrink :: OAuthAccessTokenRequest -> [OAuthAccessTokenRequest]
Arbitrary) via (GenericUniform OAuthAccessTokenRequest)
  deriving ([OAuthAccessTokenRequest] -> Value
[OAuthAccessTokenRequest] -> Encoding
OAuthAccessTokenRequest -> Value
OAuthAccessTokenRequest -> Encoding
(OAuthAccessTokenRequest -> Value)
-> (OAuthAccessTokenRequest -> Encoding)
-> ([OAuthAccessTokenRequest] -> Value)
-> ([OAuthAccessTokenRequest] -> Encoding)
-> ToJSON OAuthAccessTokenRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthAccessTokenRequest -> Value
toJSON :: OAuthAccessTokenRequest -> Value
$ctoEncoding :: OAuthAccessTokenRequest -> Encoding
toEncoding :: OAuthAccessTokenRequest -> Encoding
$ctoJSONList :: [OAuthAccessTokenRequest] -> Value
toJSONList :: [OAuthAccessTokenRequest] -> Value
$ctoEncodingList :: [OAuthAccessTokenRequest] -> Encoding
toEncodingList :: [OAuthAccessTokenRequest] -> Encoding
A.ToJSON, Value -> Parser [OAuthAccessTokenRequest]
Value -> Parser OAuthAccessTokenRequest
(Value -> Parser OAuthAccessTokenRequest)
-> (Value -> Parser [OAuthAccessTokenRequest])
-> FromJSON OAuthAccessTokenRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthAccessTokenRequest
parseJSON :: Value -> Parser OAuthAccessTokenRequest
$cparseJSONList :: Value -> Parser [OAuthAccessTokenRequest]
parseJSONList :: Value -> Parser [OAuthAccessTokenRequest]
A.FromJSON, Typeable OAuthAccessTokenRequest
Typeable OAuthAccessTokenRequest =>
(Proxy OAuthAccessTokenRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthAccessTokenRequest
Proxy OAuthAccessTokenRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthAccessTokenRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthAccessTokenRequest
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthAccessTokenRequest)

instance ToSchema OAuthAccessTokenRequest where
  schema :: ValueSchema NamedSwaggerDoc OAuthAccessTokenRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     OAuthAccessTokenRequest
-> ValueSchema NamedSwaggerDoc OAuthAccessTokenRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthAccessTokenRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   OAuthAccessTokenRequest
   OAuthAccessTokenRequest
 -> ValueSchema NamedSwaggerDoc OAuthAccessTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     OAuthAccessTokenRequest
-> ValueSchema NamedSwaggerDoc OAuthAccessTokenRequest
forall a b. (a -> b) -> a -> b
$
      OAuthGrantType
-> OAuthClientId
-> OAuthCodeVerifier
-> OAuthAuthorizationCode
-> RedirectUrl
-> OAuthAccessTokenRequest
OAuthAccessTokenRequest
        (OAuthGrantType
 -> OAuthClientId
 -> OAuthCodeVerifier
 -> OAuthAuthorizationCode
 -> RedirectUrl
 -> OAuthAccessTokenRequest)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest OAuthGrantType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     (OAuthClientId
      -> OAuthCodeVerifier
      -> OAuthAuthorizationCode
      -> RedirectUrl
      -> OAuthAccessTokenRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.grantType)
          (OAuthAccessTokenRequest -> OAuthGrantType)
-> SchemaP SwaggerDoc Object [Pair] OAuthGrantType OAuthGrantType
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest OAuthGrantType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthGrantType
-> SchemaP SwaggerDoc Object [Pair] OAuthGrantType OAuthGrantType
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"grant_type" NamedSwaggerDoc -> NamedSwaggerDoc
grantTypeDescription ValueSchema NamedSwaggerDoc OAuthGrantType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthAccessTokenRequest
  (OAuthClientId
   -> OAuthCodeVerifier
   -> OAuthAuthorizationCode
   -> RedirectUrl
   -> OAuthAccessTokenRequest)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     (OAuthCodeVerifier
      -> OAuthAuthorizationCode
      -> RedirectUrl
      -> OAuthAccessTokenRequest)
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest a
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.clientId)
          (OAuthAccessTokenRequest -> OAuthClientId)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest OAuthClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"client_id" NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthAccessTokenRequest
  (OAuthCodeVerifier
   -> OAuthAuthorizationCode
   -> RedirectUrl
   -> OAuthAccessTokenRequest)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest OAuthCodeVerifier
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     (OAuthAuthorizationCode -> RedirectUrl -> OAuthAccessTokenRequest)
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest a
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.codeVerifier)
          (OAuthAccessTokenRequest -> OAuthCodeVerifier)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthCodeVerifier OAuthCodeVerifier
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest OAuthCodeVerifier
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthCodeVerifier
-> SchemaP
     SwaggerDoc Object [Pair] OAuthCodeVerifier OAuthCodeVerifier
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"code_verifier" NamedSwaggerDoc -> NamedSwaggerDoc
codeVerifierDescription ValueSchema NamedSwaggerDoc OAuthCodeVerifier
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthAccessTokenRequest
  (OAuthAuthorizationCode -> RedirectUrl -> OAuthAccessTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     OAuthAuthorizationCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     (RedirectUrl -> OAuthAccessTokenRequest)
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest a
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.code)
          (OAuthAccessTokenRequest -> OAuthAuthorizationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAuthorizationCode
     OAuthAuthorizationCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     OAuthAuthorizationCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthAuthorizationCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAuthorizationCode
     OAuthAuthorizationCode
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"code" NamedSwaggerDoc -> NamedSwaggerDoc
codeDescription ValueSchema NamedSwaggerDoc OAuthAuthorizationCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthAccessTokenRequest
  (RedirectUrl -> OAuthAccessTokenRequest)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest RedirectUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenRequest
     OAuthAccessTokenRequest
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest a
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.redirectUri)
          (OAuthAccessTokenRequest -> RedirectUrl)
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenRequest RedirectUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc RedirectUrl
-> SchemaP SwaggerDoc Object [Pair] RedirectUrl RedirectUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"redirect_uri" NamedSwaggerDoc -> NamedSwaggerDoc
redirectUrlDescription ValueSchema NamedSwaggerDoc RedirectUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      grantTypeDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
grantTypeDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Indicates which authorization flow to use. Use `authorization_code` for authorization code flow."
      clientIdDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The ID of the OAuth client"
      codeVerifierDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
codeVerifierDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The code verifier to complete the code challenge"
      codeDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
codeDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The authorization code"
      redirectUrlDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
redirectUrlDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The URL must match the URL that was used to generate the authorization code."

instance FromForm OAuthAccessTokenRequest where
  fromForm :: Form -> Either Text OAuthAccessTokenRequest
fromForm Form
f =
    OAuthGrantType
-> OAuthClientId
-> OAuthCodeVerifier
-> OAuthAuthorizationCode
-> RedirectUrl
-> OAuthAccessTokenRequest
OAuthAccessTokenRequest
      (OAuthGrantType
 -> OAuthClientId
 -> OAuthCodeVerifier
 -> OAuthAuthorizationCode
 -> RedirectUrl
 -> OAuthAccessTokenRequest)
-> Either Text OAuthGrantType
-> Either
     Text
     (OAuthClientId
      -> OAuthCodeVerifier
      -> OAuthAuthorizationCode
      -> RedirectUrl
      -> OAuthAccessTokenRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form -> Either Text OAuthGrantType
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"grant_type" Form
f
      Either
  Text
  (OAuthClientId
   -> OAuthCodeVerifier
   -> OAuthAuthorizationCode
   -> RedirectUrl
   -> OAuthAccessTokenRequest)
-> Either Text OAuthClientId
-> Either
     Text
     (OAuthCodeVerifier
      -> OAuthAuthorizationCode
      -> RedirectUrl
      -> OAuthAccessTokenRequest)
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Form -> Either Text OAuthClientId
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"client_id" Form
f
      Either
  Text
  (OAuthCodeVerifier
   -> OAuthAuthorizationCode
   -> RedirectUrl
   -> OAuthAccessTokenRequest)
-> Either Text OAuthCodeVerifier
-> Either
     Text
     (OAuthAuthorizationCode -> RedirectUrl -> OAuthAccessTokenRequest)
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Form -> Either Text OAuthCodeVerifier
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"code_verifier" Form
f
      Either
  Text
  (OAuthAuthorizationCode -> RedirectUrl -> OAuthAccessTokenRequest)
-> Either Text OAuthAuthorizationCode
-> Either Text (RedirectUrl -> OAuthAccessTokenRequest)
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Form -> Either Text OAuthAuthorizationCode
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"code" Form
f
      Either Text (RedirectUrl -> OAuthAccessTokenRequest)
-> Either Text RedirectUrl -> Either Text OAuthAccessTokenRequest
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Form -> Either Text RedirectUrl
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"redirect_uri" Form
f

instance ToForm OAuthAccessTokenRequest where
  toForm :: OAuthAccessTokenRequest -> Form
toForm OAuthAccessTokenRequest
req =
    HashMap Text [Text] -> Form
Form (HashMap Text [Text] -> Form) -> HashMap Text [Text] -> Form
forall a b. (a -> b) -> a -> b
$
      HashMap Text [Text]
forall a. Monoid a => a
mempty
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"grant_type" [OAuthGrantType -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthAccessTokenRequest
req.grantType)]
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"client_id" [OAuthClientId -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthAccessTokenRequest
req.clientId)]
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"code_verifier" [OAuthCodeVerifier -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthAccessTokenRequest
req.codeVerifier)]
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"code" [OAuthAuthorizationCode -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthAccessTokenRequest
req.code)]
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"redirect_uri" [RedirectUrl -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthAccessTokenRequest
req.redirectUri)]

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

instance ToSchema OAuthAccessTokenType where
  schema :: ValueSchema NamedSwaggerDoc OAuthAccessTokenType
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
"OAuthAccessTokenType" (SchemaP
   [Value]
   Text
   (Alt Maybe Text)
   OAuthAccessTokenType
   OAuthAccessTokenType
 -> ValueSchema NamedSwaggerDoc OAuthAccessTokenType)
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     OAuthAccessTokenType
     OAuthAccessTokenType
-> ValueSchema NamedSwaggerDoc OAuthAccessTokenType
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value]
   Text
   (Alt Maybe Text)
   OAuthAccessTokenType
   OAuthAccessTokenType]
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     OAuthAccessTokenType
     OAuthAccessTokenType
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> OAuthAccessTokenType
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     OAuthAccessTokenType
     OAuthAccessTokenType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"Bearer" OAuthAccessTokenType
OAuthAccessTokenTypeBearer
        ]

data TokenTag = Access | Refresh

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

instance ToByteString (OAuthToken a) where
  builder :: OAuthToken a -> Builder
builder = ByteString -> Builder
forall a. ToByteString a => a -> Builder
builder (ByteString -> Builder)
-> (OAuthToken a -> ByteString) -> OAuthToken a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedJWT -> ByteString
forall a. ToCompact a => a -> ByteString
encodeCompact (SignedJWT -> ByteString)
-> (OAuthToken a -> SignedJWT) -> OAuthToken a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthToken a -> SignedJWT
forall {k} (a :: k). OAuthToken a -> SignedJWT
unOAuthToken

instance FromByteString (OAuthToken a) where
  parser :: Parser (OAuthToken a)
parser = do
    Text
t <- forall a. FromByteString a => Parser a
parser @Text
    case ByteString -> Either JWTError SignedJWT
forall a e (m :: * -> *).
(FromCompact a, AsError e, MonadError e m) =>
ByteString -> m a
decodeCompact (ByteString -> ByteString
fromStrict (Text -> ByteString
TE.encodeUtf8 Text
t)) of
      Left (JWTError
err :: JWTError) -> String -> Parser (OAuthToken a)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (OAuthToken a))
-> String -> Parser (OAuthToken a)
forall a b. (a -> b) -> a -> b
$ JWTError -> String
forall a. Show a => a -> String
show JWTError
err
      Right SignedJWT
jwt -> OAuthToken a -> Parser (OAuthToken a)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OAuthToken a -> Parser (OAuthToken a))
-> OAuthToken a -> Parser (OAuthToken a)
forall a b. (a -> b) -> a -> b
$ SignedJWT -> OAuthToken a
forall {k} (a :: k). SignedJWT -> OAuthToken a
OAuthToken SignedJWT
jwt

instance ToHttpApiData (OAuthToken a) where
  toHeader :: OAuthToken a -> ByteString
toHeader = OAuthToken a -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'
  toUrlPiece :: OAuthToken a -> Text
toUrlPiece = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (OAuthToken a -> ByteString) -> OAuthToken a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthToken a -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader

instance FromHttpApiData (OAuthToken a) where
  parseHeader :: ByteString -> Either Text (OAuthToken a)
parseHeader = (String -> Either Text (OAuthToken a))
-> (OAuthToken a -> Either Text (OAuthToken a))
-> Either String (OAuthToken a)
-> Either Text (OAuthToken a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Either Text (OAuthToken a)
forall a b. a -> Either a b
Left (Text -> Either Text (OAuthToken a))
-> (String -> Text) -> String -> Either Text (OAuthToken a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) OAuthToken a -> Either Text (OAuthToken a)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (OAuthToken a) -> Either Text (OAuthToken a))
-> (ByteString -> Either String (OAuthToken a))
-> ByteString
-> Either Text (OAuthToken a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (OAuthToken a) -> ByteString -> Either String (OAuthToken a)
forall a. Parser a -> ByteString -> Either String a
runParser Parser (OAuthToken a)
forall a. FromByteString a => Parser a
parser
  parseUrlPiece :: Text -> Either Text (OAuthToken a)
parseUrlPiece = ByteString -> Either Text (OAuthToken a)
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text (OAuthToken a))
-> (Text -> ByteString) -> Text -> Either Text (OAuthToken a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

instance ToSchema (OAuthToken a) where
  schema :: ValueSchema NamedSwaggerDoc (OAuthToken a)
schema =
    (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (OAuthToken a -> ByteString) -> OAuthToken a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthToken a -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString')
      (OAuthToken a -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text (OAuthToken a)
-> ValueSchema NamedSwaggerDoc (OAuthToken a)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value Text Text
-> (Text -> Parser (OAuthToken a))
-> SchemaP NamedSwaggerDoc Value Value Text (OAuthToken a)
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser
        SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        ( (String -> Parser (OAuthToken a))
-> (OAuthToken a -> Parser (OAuthToken a))
-> Either String (OAuthToken a)
-> Parser (OAuthToken a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (OAuthToken a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail OAuthToken a -> Parser (OAuthToken a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Either String (OAuthToken a) -> Parser (OAuthToken a))
-> (Text -> Either String (OAuthToken a))
-> Text
-> Parser (OAuthToken a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (OAuthToken a) -> ByteString -> Either String (OAuthToken a)
forall a. Parser a -> ByteString -> Either String a
runParser Parser (OAuthToken a)
forall a. FromByteString a => Parser a
parser
            (ByteString -> Either String (OAuthToken a))
-> (Text -> ByteString) -> Text -> Either String (OAuthToken a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
        )

type OAuthAccessToken = OAuthToken 'Access

type OAuthRefreshToken = OAuthToken 'Refresh

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

instance ToSchema OAuthAccessTokenResponse where
  schema :: ValueSchema NamedSwaggerDoc OAuthAccessTokenResponse
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     OAuthAccessTokenResponse
-> ValueSchema NamedSwaggerDoc OAuthAccessTokenResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthAccessTokenResponse" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   OAuthAccessTokenResponse
   OAuthAccessTokenResponse
 -> ValueSchema NamedSwaggerDoc OAuthAccessTokenResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     OAuthAccessTokenResponse
-> ValueSchema NamedSwaggerDoc OAuthAccessTokenResponse
forall a b. (a -> b) -> a -> b
$
      OAuthAccessToken
-> OAuthAccessTokenType
-> NominalDiffTime
-> OAuthRefreshToken
-> OAuthAccessTokenResponse
OAuthAccessTokenResponse
        (OAuthAccessToken
 -> OAuthAccessTokenType
 -> NominalDiffTime
 -> OAuthRefreshToken
 -> OAuthAccessTokenResponse)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenResponse OAuthAccessToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     (OAuthAccessTokenType
      -> NominalDiffTime
      -> OAuthRefreshToken
      -> OAuthAccessTokenResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OAuthAccessTokenResponse -> OAuthAccessToken
accessToken
          (OAuthAccessTokenResponse -> OAuthAccessToken)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessToken OAuthAccessToken
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenResponse OAuthAccessToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value OAuthAccessToken OAuthAccessToken
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessToken OAuthAccessToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"access_token" NamedSwaggerDoc -> NamedSwaggerDoc
accessTokenDescription SchemaP
  NamedSwaggerDoc Value Value OAuthAccessToken OAuthAccessToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthAccessTokenResponse
  (OAuthAccessTokenType
   -> NominalDiffTime
   -> OAuthRefreshToken
   -> OAuthAccessTokenResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     OAuthAccessTokenType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     (NominalDiffTime -> OAuthRefreshToken -> OAuthAccessTokenResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse a
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OAuthAccessTokenResponse -> OAuthAccessTokenType
tokenType
          (OAuthAccessTokenResponse -> OAuthAccessTokenType)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenType OAuthAccessTokenType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     OAuthAccessTokenType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthAccessTokenType
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenType OAuthAccessTokenType
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"token_type" NamedSwaggerDoc -> NamedSwaggerDoc
tokenTypeDescription ValueSchema NamedSwaggerDoc OAuthAccessTokenType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthAccessTokenResponse
  (NominalDiffTime -> OAuthRefreshToken -> OAuthAccessTokenResponse)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenResponse NominalDiffTime
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     (OAuthRefreshToken -> OAuthAccessTokenResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse a
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OAuthAccessTokenResponse -> NominalDiffTime
expiresIn
          (OAuthAccessTokenResponse -> NominalDiffTime)
-> SchemaP SwaggerDoc Object [Pair] NominalDiffTime NominalDiffTime
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenResponse NominalDiffTime
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value NominalDiffTime NominalDiffTime
-> SchemaP SwaggerDoc Object [Pair] NominalDiffTime NominalDiffTime
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"expires_in" NamedSwaggerDoc -> NamedSwaggerDoc
expiresInDescription (Int32 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> NominalDiffTime)
-> SchemaP NamedSwaggerDoc Value Value NominalDiffTime Int32
-> SchemaP
     NamedSwaggerDoc Value Value NominalDiffTime NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NominalDiffTime -> Int32
roundDiffTime (NominalDiffTime -> Int32)
-> SchemaP NamedSwaggerDoc Value Value Int32 Int32
-> SchemaP NamedSwaggerDoc Value Value NominalDiffTime Int32
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value Int32 Int32
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthAccessTokenResponse
  (OAuthRefreshToken -> OAuthAccessTokenResponse)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenResponse OAuthRefreshToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthAccessTokenResponse
     OAuthAccessTokenResponse
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse a
-> SchemaP SwaggerDoc Object [Pair] OAuthAccessTokenResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.refreshToken)
          (OAuthAccessTokenResponse -> OAuthRefreshToken)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshToken OAuthRefreshToken
-> SchemaP
     SwaggerDoc Object [Pair] OAuthAccessTokenResponse OAuthRefreshToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value OAuthRefreshToken OAuthRefreshToken
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshToken OAuthRefreshToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"refresh_token" NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenDescription SchemaP
  NamedSwaggerDoc Value Value OAuthRefreshToken OAuthRefreshToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      roundDiffTime :: NominalDiffTime -> Int32
      roundDiffTime :: NominalDiffTime -> Int32
roundDiffTime = NominalDiffTime -> Int32
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round
      accessTokenDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
accessTokenDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The access token, which has a relatively short lifetime"
      tokenTypeDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
tokenTypeDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The type of the access token. Currently only `Bearer` is supported."
      expiresInDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
expiresInDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The lifetime of the access token in seconds"
      refreshTokenDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The refresh token, which has a relatively long lifetime, and can be used to obtain a new access token"

data OAuthClaimsSet = OAuthClaimsSet {OAuthClaimsSet -> ClaimsSet
jwtClaims :: ClaimsSet, OAuthClaimsSet -> OAuthScopes
scope :: OAuthScopes}
  deriving (OAuthClaimsSet -> OAuthClaimsSet -> Bool
(OAuthClaimsSet -> OAuthClaimsSet -> Bool)
-> (OAuthClaimsSet -> OAuthClaimsSet -> Bool) -> Eq OAuthClaimsSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthClaimsSet -> OAuthClaimsSet -> Bool
== :: OAuthClaimsSet -> OAuthClaimsSet -> Bool
$c/= :: OAuthClaimsSet -> OAuthClaimsSet -> Bool
/= :: OAuthClaimsSet -> OAuthClaimsSet -> Bool
Eq, Int -> OAuthClaimsSet -> ShowS
[OAuthClaimsSet] -> ShowS
OAuthClaimsSet -> String
(Int -> OAuthClaimsSet -> ShowS)
-> (OAuthClaimsSet -> String)
-> ([OAuthClaimsSet] -> ShowS)
-> Show OAuthClaimsSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthClaimsSet -> ShowS
showsPrec :: Int -> OAuthClaimsSet -> ShowS
$cshow :: OAuthClaimsSet -> String
show :: OAuthClaimsSet -> String
$cshowList :: [OAuthClaimsSet] -> ShowS
showList :: [OAuthClaimsSet] -> ShowS
Show, (forall x. OAuthClaimsSet -> Rep OAuthClaimsSet x)
-> (forall x. Rep OAuthClaimsSet x -> OAuthClaimsSet)
-> Generic OAuthClaimsSet
forall x. Rep OAuthClaimsSet x -> OAuthClaimsSet
forall x. OAuthClaimsSet -> Rep OAuthClaimsSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthClaimsSet -> Rep OAuthClaimsSet x
from :: forall x. OAuthClaimsSet -> Rep OAuthClaimsSet x
$cto :: forall x. Rep OAuthClaimsSet x -> OAuthClaimsSet
to :: forall x. Rep OAuthClaimsSet x -> OAuthClaimsSet
Generic)

instance HasClaimsSet OAuthClaimsSet where
  claimsSet :: Lens' OAuthClaimsSet ClaimsSet
claimsSet ClaimsSet -> f ClaimsSet
f OAuthClaimsSet
s = (ClaimsSet -> OAuthClaimsSet) -> f ClaimsSet -> f OAuthClaimsSet
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ClaimsSet
a' -> OAuthClaimsSet
s {jwtClaims = a'}) (ClaimsSet -> f ClaimsSet
f (OAuthClaimsSet -> ClaimsSet
jwtClaims OAuthClaimsSet
s))

instance A.FromJSON OAuthClaimsSet where
  parseJSON :: Value -> Parser OAuthClaimsSet
parseJSON = String
-> (Object -> Parser OAuthClaimsSet)
-> Value
-> Parser OAuthClaimsSet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"OAuthClaimsSet" ((Object -> Parser OAuthClaimsSet)
 -> Value -> Parser OAuthClaimsSet)
-> (Object -> Parser OAuthClaimsSet)
-> Value
-> Parser OAuthClaimsSet
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ClaimsSet -> OAuthScopes -> OAuthClaimsSet
OAuthClaimsSet
      (ClaimsSet -> OAuthScopes -> OAuthClaimsSet)
-> Parser ClaimsSet -> Parser (OAuthScopes -> OAuthClaimsSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ClaimsSet
forall a. FromJSON a => Value -> Parser a
A.parseJSON (Object -> Value
A.Object Object
o)
      Parser (OAuthScopes -> OAuthClaimsSet)
-> Parser OAuthScopes -> Parser OAuthClaimsSet
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser OAuthScopes
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"scope"

instance A.ToJSON OAuthClaimsSet where
  toJSON :: OAuthClaimsSet -> Value
toJSON OAuthClaimsSet
s =
    Key -> OAuthScopes -> Value -> Value
forall {a}. ToJSON a => Key -> a -> Value -> Value
ins Key
"scope" (OAuthClaimsSet
s.scope) (ClaimsSet -> Value
forall a. ToJSON a => a -> Value
A.toJSON (OAuthClaimsSet -> ClaimsSet
jwtClaims OAuthClaimsSet
s))
    where
      ins :: Key -> a -> Value -> Value
ins Key
k a
v (A.Object Object
o) = Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
M.insert Key
k (a -> Value
forall a. ToJSON a => a -> Value
A.toJSON a
v) Object
o
      ins Key
_ a
_ Value
a = Value
a

hcsSub :: (HasClaimsSet hcs) => hcs -> Maybe (Id a)
hcsSub :: forall {k} hcs (a :: k). HasClaimsSet hcs => hcs -> Maybe (Id a)
hcsSub =
  Getting (Maybe StringOrURI) hcs (Maybe StringOrURI)
-> hcs -> Maybe StringOrURI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe StringOrURI) hcs (Maybe StringOrURI)
forall a. HasClaimsSet a => Lens' a (Maybe StringOrURI)
Lens' hcs (Maybe StringOrURI)
claimSub
    (hcs -> Maybe StringOrURI)
-> (StringOrURI -> Maybe (Id a)) -> hcs -> Maybe (Id a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Getting (First Text) StringOrURI Text -> StringOrURI -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) StringOrURI Text
Prism' StringOrURI Text
string
    (StringOrURI -> Maybe Text)
-> (Text -> Maybe (Id a)) -> StringOrURI -> Maybe (Id a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> Maybe (Id a))
-> (Id a -> Maybe (Id a)) -> Either String (Id a) -> Maybe (Id a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Id a) -> String -> Maybe (Id a)
forall a b. a -> b -> a
const Maybe (Id a)
forall a. Maybe a
Nothing) Id a -> Maybe (Id a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either String (Id a) -> Maybe (Id a))
-> (Text -> Either String (Id a)) -> Text -> Maybe (Id a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Id a)
forall {k} (a :: k). Text -> Either String (Id a)
parseIdFromText

-- | Verify a JWT and return the claims set. Use this function if you have a custom claims set.
verify :: JWK -> SignedJWT -> IO (Either JWTError OAuthClaimsSet)
verify :: JWK -> SignedJWT -> IO (Either JWTError OAuthClaimsSet)
verify JWK
key SignedJWT
token = do
  let audCheck :: b -> Bool
audCheck = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
  JOSE JWTError IO OAuthClaimsSet
-> IO (Either JWTError OAuthClaimsSet)
forall e (m :: * -> *) a. JOSE e m a -> m (Either e a)
runJOSE (JOSE JWTError IO OAuthClaimsSet
 -> IO (Either JWTError OAuthClaimsSet))
-> JOSE JWTError IO OAuthClaimsSet
-> IO (Either JWTError OAuthClaimsSet)
forall a b. (a -> b) -> a -> b
$ JWTValidationSettings
-> JWK -> SignedJWT -> JOSE JWTError IO OAuthClaimsSet
forall (m :: * -> *) a e payload k.
(MonadTime m, HasAllowedSkew a, HasAudiencePredicate a,
 HasIssuerPredicate a, HasCheckIssuedAt a, HasValidationSettings a,
 AsError e, AsJWTError e, MonadError e m,
 VerificationKeyStore m (JWSHeader ()) payload k,
 HasClaimsSet payload, FromJSON payload) =>
a -> k -> SignedJWT -> m payload
verifyJWT ((StringOrURI -> Bool) -> JWTValidationSettings
defaultJWTValidationSettings StringOrURI -> Bool
forall {b}. b -> Bool
audCheck) JWK
key SignedJWT
token

-- | Verify a JWT and return the claims set. Use this if you are using the default claims set.
verify' :: JWK -> SignedJWT -> IO (Either JWTError ClaimsSet)
verify' :: JWK -> SignedJWT -> IO (Either JWTError ClaimsSet)
verify' JWK
key SignedJWT
token = do
  let audCheck :: b -> Bool
audCheck = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
  JOSE JWTError IO ClaimsSet -> IO (Either JWTError ClaimsSet)
forall e (m :: * -> *) a. JOSE e m a -> m (Either e a)
runJOSE (JWTValidationSettings
-> JWK -> SignedJWT -> JOSE JWTError IO ClaimsSet
forall (m :: * -> *) a e k.
(MonadTime m, HasAllowedSkew a, HasAudiencePredicate a,
 HasIssuerPredicate a, HasCheckIssuedAt a, HasValidationSettings a,
 AsError e, AsJWTError e, MonadError e m,
 VerificationKeyStore m (JWSHeader ()) ClaimsSet k) =>
a -> k -> SignedJWT -> m ClaimsSet
verifyClaims ((StringOrURI -> Bool) -> JWTValidationSettings
defaultJWTValidationSettings StringOrURI -> Bool
forall {b}. b -> Bool
audCheck) JWK
key SignedJWT
token)

data OAuthRefreshTokenInfo = OAuthRefreshTokenInfo
  { OAuthRefreshTokenInfo -> OAuthRefreshTokenId
refreshTokenId :: OAuthRefreshTokenId,
    OAuthRefreshTokenInfo -> OAuthClientId
clientId :: OAuthClientId,
    OAuthRefreshTokenInfo -> UserId
userId :: UserId,
    OAuthRefreshTokenInfo -> OAuthScopes
scopes :: OAuthScopes,
    OAuthRefreshTokenInfo -> UTCTime
createdAt :: UTCTime
  }
  deriving (OAuthRefreshTokenInfo -> OAuthRefreshTokenInfo -> Bool
(OAuthRefreshTokenInfo -> OAuthRefreshTokenInfo -> Bool)
-> (OAuthRefreshTokenInfo -> OAuthRefreshTokenInfo -> Bool)
-> Eq OAuthRefreshTokenInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthRefreshTokenInfo -> OAuthRefreshTokenInfo -> Bool
== :: OAuthRefreshTokenInfo -> OAuthRefreshTokenInfo -> Bool
$c/= :: OAuthRefreshTokenInfo -> OAuthRefreshTokenInfo -> Bool
/= :: OAuthRefreshTokenInfo -> OAuthRefreshTokenInfo -> Bool
Eq, Int -> OAuthRefreshTokenInfo -> ShowS
[OAuthRefreshTokenInfo] -> ShowS
OAuthRefreshTokenInfo -> String
(Int -> OAuthRefreshTokenInfo -> ShowS)
-> (OAuthRefreshTokenInfo -> String)
-> ([OAuthRefreshTokenInfo] -> ShowS)
-> Show OAuthRefreshTokenInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthRefreshTokenInfo -> ShowS
showsPrec :: Int -> OAuthRefreshTokenInfo -> ShowS
$cshow :: OAuthRefreshTokenInfo -> String
show :: OAuthRefreshTokenInfo -> String
$cshowList :: [OAuthRefreshTokenInfo] -> ShowS
showList :: [OAuthRefreshTokenInfo] -> ShowS
Show, (forall x. OAuthRefreshTokenInfo -> Rep OAuthRefreshTokenInfo x)
-> (forall x. Rep OAuthRefreshTokenInfo x -> OAuthRefreshTokenInfo)
-> Generic OAuthRefreshTokenInfo
forall x. Rep OAuthRefreshTokenInfo x -> OAuthRefreshTokenInfo
forall x. OAuthRefreshTokenInfo -> Rep OAuthRefreshTokenInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthRefreshTokenInfo -> Rep OAuthRefreshTokenInfo x
from :: forall x. OAuthRefreshTokenInfo -> Rep OAuthRefreshTokenInfo x
$cto :: forall x. Rep OAuthRefreshTokenInfo x -> OAuthRefreshTokenInfo
to :: forall x. Rep OAuthRefreshTokenInfo x -> OAuthRefreshTokenInfo
Generic)

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

instance ToSchema OAuthRefreshAccessTokenRequest where
  schema :: ValueSchema NamedSwaggerDoc OAuthRefreshAccessTokenRequest
  schema :: ValueSchema NamedSwaggerDoc OAuthRefreshAccessTokenRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthRefreshAccessTokenRequest
-> ValueSchema NamedSwaggerDoc OAuthRefreshAccessTokenRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthRefreshAccessTokenRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   OAuthRefreshAccessTokenRequest
   OAuthRefreshAccessTokenRequest
 -> ValueSchema NamedSwaggerDoc OAuthRefreshAccessTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthRefreshAccessTokenRequest
-> ValueSchema NamedSwaggerDoc OAuthRefreshAccessTokenRequest
forall a b. (a -> b) -> a -> b
$
      OAuthGrantType
-> OAuthClientId
-> OAuthRefreshToken
-> OAuthRefreshAccessTokenRequest
OAuthRefreshAccessTokenRequest
        (OAuthGrantType
 -> OAuthClientId
 -> OAuthRefreshToken
 -> OAuthRefreshAccessTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthGrantType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     (OAuthClientId
      -> OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.grantType)
          (OAuthRefreshAccessTokenRequest -> OAuthGrantType)
-> SchemaP SwaggerDoc Object [Pair] OAuthGrantType OAuthGrantType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthGrantType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthGrantType
-> SchemaP SwaggerDoc Object [Pair] OAuthGrantType OAuthGrantType
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"grant_type" NamedSwaggerDoc -> NamedSwaggerDoc
grantTypeDescription ValueSchema NamedSwaggerDoc OAuthGrantType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthRefreshAccessTokenRequest
  (OAuthClientId
   -> OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     (OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] OAuthRefreshAccessTokenRequest (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshAccessTokenRequest a
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshAccessTokenRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.clientId)
          (OAuthRefreshAccessTokenRequest -> OAuthClientId)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"client_id" NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthRefreshAccessTokenRequest
  (OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthRefreshToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthRefreshAccessTokenRequest
forall a b.
SchemaP
  SwaggerDoc Object [Pair] OAuthRefreshAccessTokenRequest (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshAccessTokenRequest a
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshAccessTokenRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.refreshToken)
          (OAuthRefreshAccessTokenRequest -> OAuthRefreshToken)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshToken OAuthRefreshToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRefreshAccessTokenRequest
     OAuthRefreshToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value OAuthRefreshToken OAuthRefreshToken
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshToken OAuthRefreshToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"refresh_token" NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenDescription SchemaP
  NamedSwaggerDoc Value Value OAuthRefreshToken OAuthRefreshToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      grantTypeDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
grantTypeDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The grant type. Must be `refresh_token`"
      clientIdDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The OAuth client's ID"
      refreshTokenDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The refresh token"

instance FromForm OAuthRefreshAccessTokenRequest where
  fromForm :: Form -> Either Text OAuthRefreshAccessTokenRequest
  fromForm :: Form -> Either Text OAuthRefreshAccessTokenRequest
fromForm Form
f =
    OAuthGrantType
-> OAuthClientId
-> OAuthRefreshToken
-> OAuthRefreshAccessTokenRequest
OAuthRefreshAccessTokenRequest
      (OAuthGrantType
 -> OAuthClientId
 -> OAuthRefreshToken
 -> OAuthRefreshAccessTokenRequest)
-> Either Text OAuthGrantType
-> Either
     Text
     (OAuthClientId
      -> OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form -> Either Text OAuthGrantType
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"grant_type" Form
f
      Either
  Text
  (OAuthClientId
   -> OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
-> Either Text OAuthClientId
-> Either
     Text (OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Form -> Either Text OAuthClientId
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"client_id" Form
f
      Either Text (OAuthRefreshToken -> OAuthRefreshAccessTokenRequest)
-> Either Text OAuthRefreshToken
-> Either Text OAuthRefreshAccessTokenRequest
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Form -> Either Text OAuthRefreshToken
forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique Text
"refresh_token" Form
f

instance ToForm OAuthRefreshAccessTokenRequest where
  toForm :: OAuthRefreshAccessTokenRequest -> Form
toForm OAuthRefreshAccessTokenRequest
req =
    HashMap Text [Text] -> Form
Form (HashMap Text [Text] -> Form) -> HashMap Text [Text] -> Form
forall a b. (a -> b) -> a -> b
$
      HashMap Text [Text]
forall a. Monoid a => a
mempty
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"grant_type" [OAuthGrantType -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthRefreshAccessTokenRequest
req.grantType)]
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"client_id" [OAuthClientId -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthRefreshAccessTokenRequest
req.clientId)]
        HashMap Text [Text]
-> (HashMap Text [Text] -> HashMap Text [Text])
-> HashMap Text [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"refresh_token" [OAuthRefreshToken -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (OAuthRefreshAccessTokenRequest
req.refreshToken)]

instance FromForm (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest) where
  fromForm :: Form -> Either Text (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
  fromForm :: Form
-> Either
     Text
     (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
fromForm Form
f = Either Text OAuthAccessTokenRequest
-> Either Text OAuthRefreshAccessTokenRequest
-> Either
     Text
     (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
choose (forall a. FromForm a => Form -> Either Text a
fromForm @OAuthAccessTokenRequest Form
f) (forall a. FromForm a => Form -> Either Text a
fromForm @OAuthRefreshAccessTokenRequest Form
f)
    where
      choose :: Either Text OAuthAccessTokenRequest -> Either Text OAuthRefreshAccessTokenRequest -> Either Text (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
      choose :: Either Text OAuthAccessTokenRequest
-> Either Text OAuthRefreshAccessTokenRequest
-> Either
     Text
     (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
choose (Right OAuthAccessTokenRequest
a) Either Text OAuthRefreshAccessTokenRequest
_ = Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest
-> Either
     Text
     (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
forall a b. b -> Either a b
Right (OAuthAccessTokenRequest
-> Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest
forall a b. a -> Either a b
Left OAuthAccessTokenRequest
a)
      choose Either Text OAuthAccessTokenRequest
_ (Right OAuthRefreshAccessTokenRequest
a) = Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest
-> Either
     Text
     (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
forall a b. b -> Either a b
Right (OAuthRefreshAccessTokenRequest
-> Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest
forall a b. b -> Either a b
Right OAuthRefreshAccessTokenRequest
a)
      choose (Left Text
err) Either Text OAuthRefreshAccessTokenRequest
_ = Text
-> Either
     Text
     (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
forall a b. a -> Either a b
Left Text
err

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

instance ToSchema OAuthRevokeRefreshTokenRequest where
  schema :: ValueSchema NamedSwaggerDoc OAuthRevokeRefreshTokenRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     OAuthRevokeRefreshTokenRequest
-> ValueSchema NamedSwaggerDoc OAuthRevokeRefreshTokenRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthRevokeRefreshTokenRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   OAuthRevokeRefreshTokenRequest
   OAuthRevokeRefreshTokenRequest
 -> ValueSchema NamedSwaggerDoc OAuthRevokeRefreshTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     OAuthRevokeRefreshTokenRequest
-> ValueSchema NamedSwaggerDoc OAuthRevokeRefreshTokenRequest
forall a b. (a -> b) -> a -> b
$
      OAuthClientId
-> OAuthRefreshToken -> OAuthRevokeRefreshTokenRequest
OAuthRevokeRefreshTokenRequest
        (OAuthClientId
 -> OAuthRefreshToken -> OAuthRevokeRefreshTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     (OAuthRefreshToken -> OAuthRevokeRefreshTokenRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.clientId)
          (OAuthRevokeRefreshTokenRequest -> OAuthClientId)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     OAuthClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"client_id" NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthRevokeRefreshTokenRequest
  (OAuthRefreshToken -> OAuthRevokeRefreshTokenRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     OAuthRefreshToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     OAuthRevokeRefreshTokenRequest
forall a b.
SchemaP
  SwaggerDoc Object [Pair] OAuthRevokeRefreshTokenRequest (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRevokeRefreshTokenRequest a
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRevokeRefreshTokenRequest b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.refreshToken)
          (OAuthRevokeRefreshTokenRequest -> OAuthRefreshToken)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshToken OAuthRefreshToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthRevokeRefreshTokenRequest
     OAuthRefreshToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value OAuthRefreshToken OAuthRefreshToken
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshToken OAuthRefreshToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"refresh_token" NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenDescription SchemaP
  NamedSwaggerDoc Value Value OAuthRefreshToken OAuthRefreshToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      clientIdDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
clientIdDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The OAuth client's ID"
      refreshTokenDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The refresh token"

data OAuthSession = OAuthSession
  { OAuthSession -> OAuthRefreshTokenId
refreshTokenId :: OAuthRefreshTokenId,
    OAuthSession -> UTCTimeMillis
createdAt :: UTCTimeMillis
  }
  deriving (OAuthSession -> OAuthSession -> Bool
(OAuthSession -> OAuthSession -> Bool)
-> (OAuthSession -> OAuthSession -> Bool) -> Eq OAuthSession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthSession -> OAuthSession -> Bool
== :: OAuthSession -> OAuthSession -> Bool
$c/= :: OAuthSession -> OAuthSession -> Bool
/= :: OAuthSession -> OAuthSession -> Bool
Eq, Int -> OAuthSession -> ShowS
[OAuthSession] -> ShowS
OAuthSession -> String
(Int -> OAuthSession -> ShowS)
-> (OAuthSession -> String)
-> ([OAuthSession] -> ShowS)
-> Show OAuthSession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthSession -> ShowS
showsPrec :: Int -> OAuthSession -> ShowS
$cshow :: OAuthSession -> String
show :: OAuthSession -> String
$cshowList :: [OAuthSession] -> ShowS
showList :: [OAuthSession] -> ShowS
Show, Eq OAuthSession
Eq OAuthSession =>
(OAuthSession -> OAuthSession -> Ordering)
-> (OAuthSession -> OAuthSession -> Bool)
-> (OAuthSession -> OAuthSession -> Bool)
-> (OAuthSession -> OAuthSession -> Bool)
-> (OAuthSession -> OAuthSession -> Bool)
-> (OAuthSession -> OAuthSession -> OAuthSession)
-> (OAuthSession -> OAuthSession -> OAuthSession)
-> Ord OAuthSession
OAuthSession -> OAuthSession -> Bool
OAuthSession -> OAuthSession -> Ordering
OAuthSession -> OAuthSession -> OAuthSession
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OAuthSession -> OAuthSession -> Ordering
compare :: OAuthSession -> OAuthSession -> Ordering
$c< :: OAuthSession -> OAuthSession -> Bool
< :: OAuthSession -> OAuthSession -> Bool
$c<= :: OAuthSession -> OAuthSession -> Bool
<= :: OAuthSession -> OAuthSession -> Bool
$c> :: OAuthSession -> OAuthSession -> Bool
> :: OAuthSession -> OAuthSession -> Bool
$c>= :: OAuthSession -> OAuthSession -> Bool
>= :: OAuthSession -> OAuthSession -> Bool
$cmax :: OAuthSession -> OAuthSession -> OAuthSession
max :: OAuthSession -> OAuthSession -> OAuthSession
$cmin :: OAuthSession -> OAuthSession -> OAuthSession
min :: OAuthSession -> OAuthSession -> OAuthSession
Ord, (forall x. OAuthSession -> Rep OAuthSession x)
-> (forall x. Rep OAuthSession x -> OAuthSession)
-> Generic OAuthSession
forall x. Rep OAuthSession x -> OAuthSession
forall x. OAuthSession -> Rep OAuthSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthSession -> Rep OAuthSession x
from :: forall x. OAuthSession -> Rep OAuthSession x
$cto :: forall x. Rep OAuthSession x -> OAuthSession
to :: forall x. Rep OAuthSession x -> OAuthSession
Generic)
  deriving (Gen OAuthSession
Gen OAuthSession
-> (OAuthSession -> [OAuthSession]) -> Arbitrary OAuthSession
OAuthSession -> [OAuthSession]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthSession
arbitrary :: Gen OAuthSession
$cshrink :: OAuthSession -> [OAuthSession]
shrink :: OAuthSession -> [OAuthSession]
Arbitrary) via (GenericUniform OAuthSession)
  deriving ([OAuthSession] -> Value
[OAuthSession] -> Encoding
OAuthSession -> Value
OAuthSession -> Encoding
(OAuthSession -> Value)
-> (OAuthSession -> Encoding)
-> ([OAuthSession] -> Value)
-> ([OAuthSession] -> Encoding)
-> ToJSON OAuthSession
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthSession -> Value
toJSON :: OAuthSession -> Value
$ctoEncoding :: OAuthSession -> Encoding
toEncoding :: OAuthSession -> Encoding
$ctoJSONList :: [OAuthSession] -> Value
toJSONList :: [OAuthSession] -> Value
$ctoEncodingList :: [OAuthSession] -> Encoding
toEncodingList :: [OAuthSession] -> Encoding
A.ToJSON, Value -> Parser [OAuthSession]
Value -> Parser OAuthSession
(Value -> Parser OAuthSession)
-> (Value -> Parser [OAuthSession]) -> FromJSON OAuthSession
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthSession
parseJSON :: Value -> Parser OAuthSession
$cparseJSONList :: Value -> Parser [OAuthSession]
parseJSONList :: Value -> Parser [OAuthSession]
A.FromJSON, Typeable OAuthSession
Typeable OAuthSession =>
(Proxy OAuthSession -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthSession
Proxy OAuthSession -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthSession -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthSession -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthSession)

instance ToSchema OAuthSession where
  schema :: ValueSchema NamedSwaggerDoc OAuthSession
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] OAuthSession OAuthSession
-> ValueSchema NamedSwaggerDoc OAuthSession
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthSession" (SchemaP SwaggerDoc Object [Pair] OAuthSession OAuthSession
 -> ValueSchema NamedSwaggerDoc OAuthSession)
-> SchemaP SwaggerDoc Object [Pair] OAuthSession OAuthSession
-> ValueSchema NamedSwaggerDoc OAuthSession
forall a b. (a -> b) -> a -> b
$
      OAuthRefreshTokenId -> UTCTimeMillis -> OAuthSession
OAuthSession
        (OAuthRefreshTokenId -> UTCTimeMillis -> OAuthSession)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthSession OAuthRefreshTokenId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthSession
     (UTCTimeMillis -> OAuthSession)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.refreshTokenId) (OAuthSession -> OAuthRefreshTokenId)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshTokenId OAuthRefreshTokenId
-> SchemaP
     SwaggerDoc Object [Pair] OAuthSession OAuthRefreshTokenId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value OAuthRefreshTokenId OAuthRefreshTokenId
-> SchemaP
     SwaggerDoc Object [Pair] OAuthRefreshTokenId OAuthRefreshTokenId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"refresh_token_id" NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenIdDescription SchemaP
  NamedSwaggerDoc Value Value OAuthRefreshTokenId OAuthRefreshTokenId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthSession
  (UTCTimeMillis -> OAuthSession)
-> SchemaP SwaggerDoc Object [Pair] OAuthSession UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] OAuthSession OAuthSession
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthSession (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthSession a
-> SchemaP SwaggerDoc Object [Pair] OAuthSession b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.createdAt) (OAuthSession -> UTCTimeMillis)
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] OAuthSession UTCTimeMillis
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"created_at" NamedSwaggerDoc -> NamedSwaggerDoc
createdAtDescription SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      refreshTokenIdDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
refreshTokenIdDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The ID of the refresh token"
      createdAtDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
createdAtDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The time when the session was created"

data OAuthApplication = OAuthApplication
  { OAuthApplication -> OAuthClientId
applicationId :: OAuthClientId,
    OAuthApplication -> OAuthApplicationName
name :: OAuthApplicationName,
    OAuthApplication -> [OAuthSession]
sessions :: [OAuthSession]
  }
  deriving (OAuthApplication -> OAuthApplication -> Bool
(OAuthApplication -> OAuthApplication -> Bool)
-> (OAuthApplication -> OAuthApplication -> Bool)
-> Eq OAuthApplication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthApplication -> OAuthApplication -> Bool
== :: OAuthApplication -> OAuthApplication -> Bool
$c/= :: OAuthApplication -> OAuthApplication -> Bool
/= :: OAuthApplication -> OAuthApplication -> Bool
Eq, Int -> OAuthApplication -> ShowS
[OAuthApplication] -> ShowS
OAuthApplication -> String
(Int -> OAuthApplication -> ShowS)
-> (OAuthApplication -> String)
-> ([OAuthApplication] -> ShowS)
-> Show OAuthApplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthApplication -> ShowS
showsPrec :: Int -> OAuthApplication -> ShowS
$cshow :: OAuthApplication -> String
show :: OAuthApplication -> String
$cshowList :: [OAuthApplication] -> ShowS
showList :: [OAuthApplication] -> ShowS
Show, Eq OAuthApplication
Eq OAuthApplication =>
(OAuthApplication -> OAuthApplication -> Ordering)
-> (OAuthApplication -> OAuthApplication -> Bool)
-> (OAuthApplication -> OAuthApplication -> Bool)
-> (OAuthApplication -> OAuthApplication -> Bool)
-> (OAuthApplication -> OAuthApplication -> Bool)
-> (OAuthApplication -> OAuthApplication -> OAuthApplication)
-> (OAuthApplication -> OAuthApplication -> OAuthApplication)
-> Ord OAuthApplication
OAuthApplication -> OAuthApplication -> Bool
OAuthApplication -> OAuthApplication -> Ordering
OAuthApplication -> OAuthApplication -> OAuthApplication
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OAuthApplication -> OAuthApplication -> Ordering
compare :: OAuthApplication -> OAuthApplication -> Ordering
$c< :: OAuthApplication -> OAuthApplication -> Bool
< :: OAuthApplication -> OAuthApplication -> Bool
$c<= :: OAuthApplication -> OAuthApplication -> Bool
<= :: OAuthApplication -> OAuthApplication -> Bool
$c> :: OAuthApplication -> OAuthApplication -> Bool
> :: OAuthApplication -> OAuthApplication -> Bool
$c>= :: OAuthApplication -> OAuthApplication -> Bool
>= :: OAuthApplication -> OAuthApplication -> Bool
$cmax :: OAuthApplication -> OAuthApplication -> OAuthApplication
max :: OAuthApplication -> OAuthApplication -> OAuthApplication
$cmin :: OAuthApplication -> OAuthApplication -> OAuthApplication
min :: OAuthApplication -> OAuthApplication -> OAuthApplication
Ord, (forall x. OAuthApplication -> Rep OAuthApplication x)
-> (forall x. Rep OAuthApplication x -> OAuthApplication)
-> Generic OAuthApplication
forall x. Rep OAuthApplication x -> OAuthApplication
forall x. OAuthApplication -> Rep OAuthApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthApplication -> Rep OAuthApplication x
from :: forall x. OAuthApplication -> Rep OAuthApplication x
$cto :: forall x. Rep OAuthApplication x -> OAuthApplication
to :: forall x. Rep OAuthApplication x -> OAuthApplication
Generic)
  deriving (Gen OAuthApplication
Gen OAuthApplication
-> (OAuthApplication -> [OAuthApplication])
-> Arbitrary OAuthApplication
OAuthApplication -> [OAuthApplication]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OAuthApplication
arbitrary :: Gen OAuthApplication
$cshrink :: OAuthApplication -> [OAuthApplication]
shrink :: OAuthApplication -> [OAuthApplication]
Arbitrary) via (GenericUniform OAuthApplication)
  deriving ([OAuthApplication] -> Value
[OAuthApplication] -> Encoding
OAuthApplication -> Value
OAuthApplication -> Encoding
(OAuthApplication -> Value)
-> (OAuthApplication -> Encoding)
-> ([OAuthApplication] -> Value)
-> ([OAuthApplication] -> Encoding)
-> ToJSON OAuthApplication
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OAuthApplication -> Value
toJSON :: OAuthApplication -> Value
$ctoEncoding :: OAuthApplication -> Encoding
toEncoding :: OAuthApplication -> Encoding
$ctoJSONList :: [OAuthApplication] -> Value
toJSONList :: [OAuthApplication] -> Value
$ctoEncodingList :: [OAuthApplication] -> Encoding
toEncodingList :: [OAuthApplication] -> Encoding
A.ToJSON, Value -> Parser [OAuthApplication]
Value -> Parser OAuthApplication
(Value -> Parser OAuthApplication)
-> (Value -> Parser [OAuthApplication])
-> FromJSON OAuthApplication
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OAuthApplication
parseJSON :: Value -> Parser OAuthApplication
$cparseJSONList :: Value -> Parser [OAuthApplication]
parseJSONList :: Value -> Parser [OAuthApplication]
A.FromJSON, Typeable OAuthApplication
Typeable OAuthApplication =>
(Proxy OAuthApplication
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema OAuthApplication
Proxy OAuthApplication -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy OAuthApplication -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy OAuthApplication -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema OAuthApplication)

instance ToSchema OAuthApplication where
  schema :: ValueSchema NamedSwaggerDoc OAuthApplication
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplication OAuthApplication
-> ValueSchema NamedSwaggerDoc OAuthApplication
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OAuthApplication" (SchemaP SwaggerDoc Object [Pair] OAuthApplication OAuthApplication
 -> ValueSchema NamedSwaggerDoc OAuthApplication)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplication OAuthApplication
-> ValueSchema NamedSwaggerDoc OAuthApplication
forall a b. (a -> b) -> a -> b
$
      OAuthClientId
-> OAuthApplicationName -> [OAuthSession] -> OAuthApplication
OAuthApplication
        (OAuthClientId
 -> OAuthApplicationName -> [OAuthSession] -> OAuthApplication)
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication OAuthClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthApplication
     (OAuthApplicationName -> [OAuthSession] -> OAuthApplication)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OAuthApplication -> OAuthClientId
applicationId (OAuthApplication -> OAuthClientId)
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication OAuthClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
-> SchemaP SwaggerDoc Object [Pair] OAuthClientId OAuthClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"id" NamedSwaggerDoc -> NamedSwaggerDoc
idDescription SchemaP NamedSwaggerDoc Value Value OAuthClientId OAuthClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthApplication
  (OAuthApplicationName -> [OAuthSession] -> OAuthApplication)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplication OAuthApplicationName
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     OAuthApplication
     ([OAuthSession] -> OAuthApplication)
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthApplication (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication a
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.name) (OAuthApplication -> OAuthApplicationName)
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplicationName OAuthApplicationName
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplication OAuthApplicationName
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc OAuthApplicationName
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplicationName OAuthApplicationName
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"name" NamedSwaggerDoc -> NamedSwaggerDoc
nameDescription ValueSchema NamedSwaggerDoc OAuthApplicationName
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  OAuthApplication
  ([OAuthSession] -> OAuthApplication)
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication [OAuthSession]
-> SchemaP
     SwaggerDoc Object [Pair] OAuthApplication OAuthApplication
forall a b.
SchemaP SwaggerDoc Object [Pair] OAuthApplication (a -> b)
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication a
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OAuthApplication -> [OAuthSession]
sessions (OAuthApplication -> [OAuthSession])
-> SchemaP SwaggerDoc Object [Pair] [OAuthSession] [OAuthSession]
-> SchemaP SwaggerDoc Object [Pair] OAuthApplication [OAuthSession]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [OAuthSession] [OAuthSession]
-> SchemaP SwaggerDoc Object [Pair] [OAuthSession] [OAuthSession]
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"sessions" SwaggerDoc -> SwaggerDoc
sessionsDescription (ValueSchema NamedSwaggerDoc OAuthSession
-> SchemaP SwaggerDoc Value Value [OAuthSession] [OAuthSession]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc OAuthSession
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    where
      idDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
idDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The OAuth client's ID"
      nameDescription :: NamedSwaggerDoc -> NamedSwaggerDoc
nameDescription = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The OAuth client's name"
      sessionsDescription :: SwaggerDoc -> SwaggerDoc
sessionsDescription = (Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The OAuth client's sessions"

--------------------------------------------------------------------------------
-- Errors

data OAuthError
  = OAuthClientNotFound
  | OAuthRedirectUrlMissMatch
  | OAuthUnsupportedResponseType
  | OAuthJwtError
  | OAuthAuthorizationCodeNotFound
  | OAuthFeatureDisabled
  | OAuthInvalidClientCredentials
  | OAuthInvalidGrantType
  | OAuthInvalidRefreshToken
  | OAuthInvalidGrant

instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: OAuthError) where
  addToOpenApi :: OpenApi -> OpenApi
addToOpenApi = forall (e :: StaticError).
(Typeable e, KnownError e) =>
OpenApi -> OpenApi
addStaticErrorToSwagger @(MapError e)

type instance MapError 'OAuthClientNotFound = 'StaticError 404 "not-found" "OAuth client not found"

type instance MapError 'OAuthRedirectUrlMissMatch = 'StaticError 400 "redirect-url-miss-match" "The redirect URL does not match the one registered with the client"

type instance MapError 'OAuthUnsupportedResponseType = 'StaticError 400 "unsupported-response-type" "Unsupported response type"

type instance MapError 'OAuthJwtError = 'StaticError 500 "jwt-error" "Internal error while handling JWT token"

type instance MapError 'OAuthAuthorizationCodeNotFound = 'StaticError 404 "not-found" "OAuth authorization code not found"

type instance MapError 'OAuthFeatureDisabled = 'StaticError 403 "forbidden" "OAuth is disabled"

type instance MapError 'OAuthInvalidClientCredentials = 'StaticError 403 "forbidden" "Invalid client credentials"

type instance MapError 'OAuthInvalidGrantType = 'StaticError 403 "forbidden" "Invalid grant type"

type instance MapError 'OAuthInvalidRefreshToken = 'StaticError 403 "forbidden" "Invalid refresh token"

type instance MapError 'OAuthInvalidGrant = 'StaticError 403 "invalid_grant" "Invalid grant"

--------------------------------------------------------------------------------
-- CQL instances

instance Cql OAuthApplicationName where
  ctype :: Tagged OAuthApplicationName ColumnType
ctype = ColumnType -> Tagged OAuthApplicationName ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
TextColumn
  toCql :: OAuthApplicationName -> Value
toCql = Text -> Value
CqlText (Text -> Value)
-> (OAuthApplicationName -> Text) -> OAuthApplicationName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range
  OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
-> Text
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range
   OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
 -> Text)
-> (OAuthApplicationName
    -> Range
         OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
-> OAuthApplicationName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthApplicationName
-> Range
     OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
unOAuthApplicationName
  fromCql :: Value -> Either String OAuthApplicationName
fromCql (CqlText Text
t) = Text
-> Either
     String
     (Range
        OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
forall a (n :: Nat) (m :: Nat).
(KnownNat n, KnownNat m, Within a n m) =>
a -> Either String (Range n m a)
checkedEither Text
t Either
  String
  (Range
     OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text)
-> (Range
      OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
    -> OAuthApplicationName)
-> Either String OAuthApplicationName
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Range
  OAuthApplicationNameMinLength OAuthApplicationNameMaxLength Text
-> OAuthApplicationName
OAuthApplicationName
  fromCql Value
_ = String -> Either String OAuthApplicationName
forall a b. a -> Either a b
Left String
"OAuthApplicationName: Text expected"

instance Cql RedirectUrl where
  ctype :: Tagged RedirectUrl ColumnType
ctype = ColumnType -> Tagged RedirectUrl ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
BlobColumn
  toCql :: RedirectUrl -> Value
toCql = ByteString -> Value
CqlBlob (ByteString -> Value)
-> (RedirectUrl -> ByteString) -> RedirectUrl -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedirectUrl -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString
  fromCql :: Value -> Either String RedirectUrl
fromCql (CqlBlob ByteString
t) = Parser RedirectUrl -> ByteString -> Either String RedirectUrl
forall a. Parser a -> ByteString -> Either String a
runParser Parser RedirectUrl
forall a. FromByteString a => Parser a
parser (ByteString -> ByteString
toStrict ByteString
t)
  fromCql Value
_ = String -> Either String RedirectUrl
forall a b. a -> Either a b
Left String
"RedirectUrl: Blob expected"

instance Cql OAuthAuthorizationCode where
  ctype :: Tagged OAuthAuthorizationCode ColumnType
ctype = ColumnType -> Tagged OAuthAuthorizationCode ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
AsciiColumn
  toCql :: OAuthAuthorizationCode -> Value
toCql = Text -> Value
CqlAscii (Text -> Value)
-> (OAuthAuthorizationCode -> Text)
-> OAuthAuthorizationCode
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsciiBase16 -> Text
forall {k} (c :: k). AsciiText c -> Text
toText (AsciiBase16 -> Text)
-> (OAuthAuthorizationCode -> AsciiBase16)
-> OAuthAuthorizationCode
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthAuthorizationCode -> AsciiBase16
unOAuthAuthorizationCode
  fromCql :: Value -> Either String OAuthAuthorizationCode
fromCql (CqlAscii Text
t) = AsciiBase16 -> OAuthAuthorizationCode
OAuthAuthorizationCode (AsciiBase16 -> OAuthAuthorizationCode)
-> Either String AsciiBase16
-> Either String OAuthAuthorizationCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String AsciiBase16
validateBase16 Text
t
  fromCql Value
_ = String -> Either String OAuthAuthorizationCode
forall a b. a -> Either a b
Left String
"OAuthAuthorizationCode: Ascii expected"

instance Cql OAuthScope where
  ctype :: Tagged OAuthScope ColumnType
ctype = ColumnType -> Tagged OAuthScope ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
TextColumn
  toCql :: OAuthScope -> Value
toCql = Text -> Value
CqlText (Text -> Value) -> (OAuthScope -> Text) -> OAuthScope -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (OAuthScope -> ByteString) -> OAuthScope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthScope -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'
  fromCql :: Value -> Either String OAuthScope
fromCql (CqlText Text
t) =
    Either String OAuthScope
-> (OAuthScope -> Either String OAuthScope)
-> Maybe OAuthScope
-> Either String OAuthScope
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String OAuthScope
forall a b. a -> Either a b
Left String
"invalid oauth scope") OAuthScope -> Either String OAuthScope
forall a b. b -> Either a b
Right
      (Maybe OAuthScope -> Either String OAuthScope)
-> Maybe OAuthScope -> Either String OAuthScope
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe OAuthScope
forall a. FromByteString a => ByteString -> Maybe a
fromByteString'
        (ByteString -> Maybe OAuthScope)
-> (Text -> ByteString) -> Text -> Maybe OAuthScope
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
TE.encodeUtf8
      (Text -> Maybe OAuthScope) -> Text -> Maybe OAuthScope
forall a b. (a -> b) -> a -> b
$ Text
t
  fromCql Value
_ = String -> Either String OAuthScope
forall a b. a -> Either a b
Left String
"OAuthScope: Text expected"

instance Cql OAuthCodeChallenge where
  ctype :: Tagged OAuthCodeChallenge ColumnType
ctype = ColumnType -> Tagged OAuthCodeChallenge ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
BlobColumn
  toCql :: OAuthCodeChallenge -> Value
toCql = ByteString -> Value
CqlBlob (ByteString -> Value)
-> (OAuthCodeChallenge -> ByteString)
-> OAuthCodeChallenge
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthCodeChallenge -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString
  fromCql :: Value -> Either String OAuthCodeChallenge
fromCql (CqlBlob ByteString
t) = Parser OAuthCodeChallenge
-> ByteString -> Either String OAuthCodeChallenge
forall a. Parser a -> ByteString -> Either String a
runParser Parser OAuthCodeChallenge
forall a. FromByteString a => Parser a
parser (ByteString -> ByteString
toStrict ByteString
t)
  fromCql Value
_ = String -> Either String OAuthCodeChallenge
forall a b. a -> Either a b
Left String
"OAuthCodeChallenge: Blob expected"