module Mensam.API.Data.User where

import Mensam.API.Aeson
import Mensam.API.Aeson.StaticText
import Mensam.API.Pretty

import Data.Aeson qualified as A
import Data.Int
import Data.Kind
import Data.Text qualified as T
import Data.Time qualified as T
import Deriving.Aeson qualified as A
import GHC.Generics
import Servant.API qualified as Servant
import Text.Email.OrphanInstances ()

type UserAuthenticated :: Type
data UserAuthenticated = MkUserAuthenticated
  { UserAuthenticated -> IdentifierUser
userAuthenticatedId :: IdentifierUser
  , UserAuthenticated -> Maybe IdentifierSession
userAuthenticatedSession :: Maybe IdentifierSession
  }
  deriving stock (UserAuthenticated -> UserAuthenticated -> Bool
(UserAuthenticated -> UserAuthenticated -> Bool)
-> (UserAuthenticated -> UserAuthenticated -> Bool)
-> Eq UserAuthenticated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserAuthenticated -> UserAuthenticated -> Bool
== :: UserAuthenticated -> UserAuthenticated -> Bool
$c/= :: UserAuthenticated -> UserAuthenticated -> Bool
/= :: UserAuthenticated -> UserAuthenticated -> Bool
Eq, (forall x. UserAuthenticated -> Rep UserAuthenticated x)
-> (forall x. Rep UserAuthenticated x -> UserAuthenticated)
-> Generic UserAuthenticated
forall x. Rep UserAuthenticated x -> UserAuthenticated
forall x. UserAuthenticated -> Rep UserAuthenticated x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserAuthenticated -> Rep UserAuthenticated x
from :: forall x. UserAuthenticated -> Rep UserAuthenticated x
$cto :: forall x. Rep UserAuthenticated x -> UserAuthenticated
to :: forall x. Rep UserAuthenticated x -> UserAuthenticated
Generic, Eq UserAuthenticated
Eq UserAuthenticated =>
(UserAuthenticated -> UserAuthenticated -> Ordering)
-> (UserAuthenticated -> UserAuthenticated -> Bool)
-> (UserAuthenticated -> UserAuthenticated -> Bool)
-> (UserAuthenticated -> UserAuthenticated -> Bool)
-> (UserAuthenticated -> UserAuthenticated -> Bool)
-> (UserAuthenticated -> UserAuthenticated -> UserAuthenticated)
-> (UserAuthenticated -> UserAuthenticated -> UserAuthenticated)
-> Ord UserAuthenticated
UserAuthenticated -> UserAuthenticated -> Bool
UserAuthenticated -> UserAuthenticated -> Ordering
UserAuthenticated -> UserAuthenticated -> UserAuthenticated
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 :: UserAuthenticated -> UserAuthenticated -> Ordering
compare :: UserAuthenticated -> UserAuthenticated -> Ordering
$c< :: UserAuthenticated -> UserAuthenticated -> Bool
< :: UserAuthenticated -> UserAuthenticated -> Bool
$c<= :: UserAuthenticated -> UserAuthenticated -> Bool
<= :: UserAuthenticated -> UserAuthenticated -> Bool
$c> :: UserAuthenticated -> UserAuthenticated -> Bool
> :: UserAuthenticated -> UserAuthenticated -> Bool
$c>= :: UserAuthenticated -> UserAuthenticated -> Bool
>= :: UserAuthenticated -> UserAuthenticated -> Bool
$cmax :: UserAuthenticated -> UserAuthenticated -> UserAuthenticated
max :: UserAuthenticated -> UserAuthenticated -> UserAuthenticated
$cmin :: UserAuthenticated -> UserAuthenticated -> UserAuthenticated
min :: UserAuthenticated -> UserAuthenticated -> UserAuthenticated
Ord, ReadPrec [UserAuthenticated]
ReadPrec UserAuthenticated
Int -> ReadS UserAuthenticated
ReadS [UserAuthenticated]
(Int -> ReadS UserAuthenticated)
-> ReadS [UserAuthenticated]
-> ReadPrec UserAuthenticated
-> ReadPrec [UserAuthenticated]
-> Read UserAuthenticated
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UserAuthenticated
readsPrec :: Int -> ReadS UserAuthenticated
$creadList :: ReadS [UserAuthenticated]
readList :: ReadS [UserAuthenticated]
$creadPrec :: ReadPrec UserAuthenticated
readPrec :: ReadPrec UserAuthenticated
$creadListPrec :: ReadPrec [UserAuthenticated]
readListPrec :: ReadPrec [UserAuthenticated]
Read, Int -> UserAuthenticated -> ShowS
[UserAuthenticated] -> ShowS
UserAuthenticated -> String
(Int -> UserAuthenticated -> ShowS)
-> (UserAuthenticated -> String)
-> ([UserAuthenticated] -> ShowS)
-> Show UserAuthenticated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserAuthenticated -> ShowS
showsPrec :: Int -> UserAuthenticated -> ShowS
$cshow :: UserAuthenticated -> String
show :: UserAuthenticated -> String
$cshowList :: [UserAuthenticated] -> ShowS
showList :: [UserAuthenticated] -> ShowS
Show)
  deriving
    (Value -> Parser [UserAuthenticated]
Value -> Parser UserAuthenticated
(Value -> Parser UserAuthenticated)
-> (Value -> Parser [UserAuthenticated])
-> FromJSON UserAuthenticated
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserAuthenticated
parseJSON :: Value -> Parser UserAuthenticated
$cparseJSONList :: Value -> Parser [UserAuthenticated]
parseJSONList :: Value -> Parser [UserAuthenticated]
A.FromJSON, [UserAuthenticated] -> Value
[UserAuthenticated] -> Encoding
UserAuthenticated -> Value
UserAuthenticated -> Encoding
(UserAuthenticated -> Value)
-> (UserAuthenticated -> Encoding)
-> ([UserAuthenticated] -> Value)
-> ([UserAuthenticated] -> Encoding)
-> ToJSON UserAuthenticated
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserAuthenticated -> Value
toJSON :: UserAuthenticated -> Value
$ctoEncoding :: UserAuthenticated -> Encoding
toEncoding :: UserAuthenticated -> Encoding
$ctoJSONList :: [UserAuthenticated] -> Value
toJSONList :: [UserAuthenticated] -> Value
$ctoEncodingList :: [UserAuthenticated] -> Encoding
toEncodingList :: [UserAuthenticated] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "userAuthenticated") UserAuthenticated

type IdentifierUser :: Type
newtype IdentifierUser = MkIdentifierUser {IdentifierUser -> Int64
unIdentifierUser :: Int64}
  deriving stock (IdentifierUser -> IdentifierUser -> Bool
(IdentifierUser -> IdentifierUser -> Bool)
-> (IdentifierUser -> IdentifierUser -> Bool) -> Eq IdentifierUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentifierUser -> IdentifierUser -> Bool
== :: IdentifierUser -> IdentifierUser -> Bool
$c/= :: IdentifierUser -> IdentifierUser -> Bool
/= :: IdentifierUser -> IdentifierUser -> Bool
Eq, (forall x. IdentifierUser -> Rep IdentifierUser x)
-> (forall x. Rep IdentifierUser x -> IdentifierUser)
-> Generic IdentifierUser
forall x. Rep IdentifierUser x -> IdentifierUser
forall x. IdentifierUser -> Rep IdentifierUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IdentifierUser -> Rep IdentifierUser x
from :: forall x. IdentifierUser -> Rep IdentifierUser x
$cto :: forall x. Rep IdentifierUser x -> IdentifierUser
to :: forall x. Rep IdentifierUser x -> IdentifierUser
Generic, Eq IdentifierUser
Eq IdentifierUser =>
(IdentifierUser -> IdentifierUser -> Ordering)
-> (IdentifierUser -> IdentifierUser -> Bool)
-> (IdentifierUser -> IdentifierUser -> Bool)
-> (IdentifierUser -> IdentifierUser -> Bool)
-> (IdentifierUser -> IdentifierUser -> Bool)
-> (IdentifierUser -> IdentifierUser -> IdentifierUser)
-> (IdentifierUser -> IdentifierUser -> IdentifierUser)
-> Ord IdentifierUser
IdentifierUser -> IdentifierUser -> Bool
IdentifierUser -> IdentifierUser -> Ordering
IdentifierUser -> IdentifierUser -> IdentifierUser
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 :: IdentifierUser -> IdentifierUser -> Ordering
compare :: IdentifierUser -> IdentifierUser -> Ordering
$c< :: IdentifierUser -> IdentifierUser -> Bool
< :: IdentifierUser -> IdentifierUser -> Bool
$c<= :: IdentifierUser -> IdentifierUser -> Bool
<= :: IdentifierUser -> IdentifierUser -> Bool
$c> :: IdentifierUser -> IdentifierUser -> Bool
> :: IdentifierUser -> IdentifierUser -> Bool
$c>= :: IdentifierUser -> IdentifierUser -> Bool
>= :: IdentifierUser -> IdentifierUser -> Bool
$cmax :: IdentifierUser -> IdentifierUser -> IdentifierUser
max :: IdentifierUser -> IdentifierUser -> IdentifierUser
$cmin :: IdentifierUser -> IdentifierUser -> IdentifierUser
min :: IdentifierUser -> IdentifierUser -> IdentifierUser
Ord, ReadPrec [IdentifierUser]
ReadPrec IdentifierUser
Int -> ReadS IdentifierUser
ReadS [IdentifierUser]
(Int -> ReadS IdentifierUser)
-> ReadS [IdentifierUser]
-> ReadPrec IdentifierUser
-> ReadPrec [IdentifierUser]
-> Read IdentifierUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS IdentifierUser
readsPrec :: Int -> ReadS IdentifierUser
$creadList :: ReadS [IdentifierUser]
readList :: ReadS [IdentifierUser]
$creadPrec :: ReadPrec IdentifierUser
readPrec :: ReadPrec IdentifierUser
$creadListPrec :: ReadPrec [IdentifierUser]
readListPrec :: ReadPrec [IdentifierUser]
Read, Int -> IdentifierUser -> ShowS
[IdentifierUser] -> ShowS
IdentifierUser -> String
(Int -> IdentifierUser -> ShowS)
-> (IdentifierUser -> String)
-> ([IdentifierUser] -> ShowS)
-> Show IdentifierUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdentifierUser -> ShowS
showsPrec :: Int -> IdentifierUser -> ShowS
$cshow :: IdentifierUser -> String
show :: IdentifierUser -> String
$cshowList :: [IdentifierUser] -> ShowS
showList :: [IdentifierUser] -> ShowS
Show)
  deriving newtype (Value -> Parser [IdentifierUser]
Value -> Parser IdentifierUser
(Value -> Parser IdentifierUser)
-> (Value -> Parser [IdentifierUser]) -> FromJSON IdentifierUser
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser IdentifierUser
parseJSON :: Value -> Parser IdentifierUser
$cparseJSONList :: Value -> Parser [IdentifierUser]
parseJSONList :: Value -> Parser [IdentifierUser]
A.FromJSON, [IdentifierUser] -> Value
[IdentifierUser] -> Encoding
IdentifierUser -> Value
IdentifierUser -> Encoding
(IdentifierUser -> Value)
-> (IdentifierUser -> Encoding)
-> ([IdentifierUser] -> Value)
-> ([IdentifierUser] -> Encoding)
-> ToJSON IdentifierUser
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: IdentifierUser -> Value
toJSON :: IdentifierUser -> Value
$ctoEncoding :: IdentifierUser -> Encoding
toEncoding :: IdentifierUser -> Encoding
$ctoJSONList :: [IdentifierUser] -> Value
toJSONList :: [IdentifierUser] -> Value
$ctoEncodingList :: [IdentifierUser] -> Encoding
toEncodingList :: [IdentifierUser] -> Encoding
A.ToJSON)
  deriving newtype (ByteString -> Either Text IdentifierUser
Text -> Either Text IdentifierUser
(Text -> Either Text IdentifierUser)
-> (ByteString -> Either Text IdentifierUser)
-> (Text -> Either Text IdentifierUser)
-> FromHttpApiData IdentifierUser
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text IdentifierUser
parseUrlPiece :: Text -> Either Text IdentifierUser
$cparseHeader :: ByteString -> Either Text IdentifierUser
parseHeader :: ByteString -> Either Text IdentifierUser
$cparseQueryParam :: Text -> Either Text IdentifierUser
parseQueryParam :: Text -> Either Text IdentifierUser
Servant.FromHttpApiData, IdentifierUser -> ByteString
IdentifierUser -> Text
IdentifierUser -> Builder
(IdentifierUser -> Text)
-> (IdentifierUser -> Builder)
-> (IdentifierUser -> ByteString)
-> (IdentifierUser -> Text)
-> (IdentifierUser -> Builder)
-> ToHttpApiData IdentifierUser
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: IdentifierUser -> Text
toUrlPiece :: IdentifierUser -> Text
$ctoEncodedUrlPiece :: IdentifierUser -> Builder
toEncodedUrlPiece :: IdentifierUser -> Builder
$ctoHeader :: IdentifierUser -> ByteString
toHeader :: IdentifierUser -> ByteString
$ctoQueryParam :: IdentifierUser -> Text
toQueryParam :: IdentifierUser -> Text
$ctoEncodedQueryParam :: IdentifierUser -> Builder
toEncodedQueryParam :: IdentifierUser -> Builder
Servant.ToHttpApiData)

instance ToPrettyText IdentifierUser where
  toPrettyText :: IdentifierUser -> Text
toPrettyText = (Text
"#" <>) (Text -> Text)
-> (IdentifierUser -> Text) -> IdentifierUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (IdentifierUser -> String) -> IdentifierUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String)
-> (IdentifierUser -> Int64) -> IdentifierUser -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierUser -> Int64
unIdentifierUser

deriving via PrettyHtml5ViaPrettyText IdentifierUser instance ToPrettyHtml5 IdentifierUser

type Session :: Type
data Session = MkSession
  { Session -> IdentifierSession
sessionId :: IdentifierSession
  , Session -> UTCTime
sessionTimeCreated :: T.UTCTime
  , Session -> Maybe UTCTime
sessionTimeExpired :: Maybe T.UTCTime
  }
  deriving stock (Session -> Session -> Bool
(Session -> Session -> Bool)
-> (Session -> Session -> Bool) -> Eq Session
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Session -> Session -> Bool
== :: Session -> Session -> Bool
$c/= :: Session -> Session -> Bool
/= :: Session -> Session -> Bool
Eq, (forall x. Session -> Rep Session x)
-> (forall x. Rep Session x -> Session) -> Generic Session
forall x. Rep Session x -> Session
forall x. Session -> Rep Session x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Session -> Rep Session x
from :: forall x. Session -> Rep Session x
$cto :: forall x. Rep Session x -> Session
to :: forall x. Rep Session x -> Session
Generic, Eq Session
Eq Session =>
(Session -> Session -> Ordering)
-> (Session -> Session -> Bool)
-> (Session -> Session -> Bool)
-> (Session -> Session -> Bool)
-> (Session -> Session -> Bool)
-> (Session -> Session -> Session)
-> (Session -> Session -> Session)
-> Ord Session
Session -> Session -> Bool
Session -> Session -> Ordering
Session -> Session -> Session
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 :: Session -> Session -> Ordering
compare :: Session -> Session -> Ordering
$c< :: Session -> Session -> Bool
< :: Session -> Session -> Bool
$c<= :: Session -> Session -> Bool
<= :: Session -> Session -> Bool
$c> :: Session -> Session -> Bool
> :: Session -> Session -> Bool
$c>= :: Session -> Session -> Bool
>= :: Session -> Session -> Bool
$cmax :: Session -> Session -> Session
max :: Session -> Session -> Session
$cmin :: Session -> Session -> Session
min :: Session -> Session -> Session
Ord, ReadPrec [Session]
ReadPrec Session
Int -> ReadS Session
ReadS [Session]
(Int -> ReadS Session)
-> ReadS [Session]
-> ReadPrec Session
-> ReadPrec [Session]
-> Read Session
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Session
readsPrec :: Int -> ReadS Session
$creadList :: ReadS [Session]
readList :: ReadS [Session]
$creadPrec :: ReadPrec Session
readPrec :: ReadPrec Session
$creadListPrec :: ReadPrec [Session]
readListPrec :: ReadPrec [Session]
Read, Int -> Session -> ShowS
[Session] -> ShowS
Session -> String
(Int -> Session -> ShowS)
-> (Session -> String) -> ([Session] -> ShowS) -> Show Session
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Session -> ShowS
showsPrec :: Int -> Session -> ShowS
$cshow :: Session -> String
show :: Session -> String
$cshowList :: [Session] -> ShowS
showList :: [Session] -> ShowS
Show)
  deriving
    (Value -> Parser [Session]
Value -> Parser Session
(Value -> Parser Session)
-> (Value -> Parser [Session]) -> FromJSON Session
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Session
parseJSON :: Value -> Parser Session
$cparseJSONList :: Value -> Parser [Session]
parseJSONList :: Value -> Parser [Session]
A.FromJSON, [Session] -> Value
[Session] -> Encoding
Session -> Value
Session -> Encoding
(Session -> Value)
-> (Session -> Encoding)
-> ([Session] -> Value)
-> ([Session] -> Encoding)
-> ToJSON Session
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Session -> Value
toJSON :: Session -> Value
$ctoEncoding :: Session -> Encoding
toEncoding :: Session -> Encoding
$ctoJSONList :: [Session] -> Value
toJSONList :: [Session] -> Value
$ctoEncodingList :: [Session] -> Encoding
toEncodingList :: [Session] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "session") Session

type IdentifierSession :: Type
newtype IdentifierSession = MkIdentifierSession {IdentifierSession -> Int64
unIdentifierSession :: Int64}
  deriving stock (IdentifierSession -> IdentifierSession -> Bool
(IdentifierSession -> IdentifierSession -> Bool)
-> (IdentifierSession -> IdentifierSession -> Bool)
-> Eq IdentifierSession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentifierSession -> IdentifierSession -> Bool
== :: IdentifierSession -> IdentifierSession -> Bool
$c/= :: IdentifierSession -> IdentifierSession -> Bool
/= :: IdentifierSession -> IdentifierSession -> Bool
Eq, (forall x. IdentifierSession -> Rep IdentifierSession x)
-> (forall x. Rep IdentifierSession x -> IdentifierSession)
-> Generic IdentifierSession
forall x. Rep IdentifierSession x -> IdentifierSession
forall x. IdentifierSession -> Rep IdentifierSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IdentifierSession -> Rep IdentifierSession x
from :: forall x. IdentifierSession -> Rep IdentifierSession x
$cto :: forall x. Rep IdentifierSession x -> IdentifierSession
to :: forall x. Rep IdentifierSession x -> IdentifierSession
Generic, Eq IdentifierSession
Eq IdentifierSession =>
(IdentifierSession -> IdentifierSession -> Ordering)
-> (IdentifierSession -> IdentifierSession -> Bool)
-> (IdentifierSession -> IdentifierSession -> Bool)
-> (IdentifierSession -> IdentifierSession -> Bool)
-> (IdentifierSession -> IdentifierSession -> Bool)
-> (IdentifierSession -> IdentifierSession -> IdentifierSession)
-> (IdentifierSession -> IdentifierSession -> IdentifierSession)
-> Ord IdentifierSession
IdentifierSession -> IdentifierSession -> Bool
IdentifierSession -> IdentifierSession -> Ordering
IdentifierSession -> IdentifierSession -> IdentifierSession
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 :: IdentifierSession -> IdentifierSession -> Ordering
compare :: IdentifierSession -> IdentifierSession -> Ordering
$c< :: IdentifierSession -> IdentifierSession -> Bool
< :: IdentifierSession -> IdentifierSession -> Bool
$c<= :: IdentifierSession -> IdentifierSession -> Bool
<= :: IdentifierSession -> IdentifierSession -> Bool
$c> :: IdentifierSession -> IdentifierSession -> Bool
> :: IdentifierSession -> IdentifierSession -> Bool
$c>= :: IdentifierSession -> IdentifierSession -> Bool
>= :: IdentifierSession -> IdentifierSession -> Bool
$cmax :: IdentifierSession -> IdentifierSession -> IdentifierSession
max :: IdentifierSession -> IdentifierSession -> IdentifierSession
$cmin :: IdentifierSession -> IdentifierSession -> IdentifierSession
min :: IdentifierSession -> IdentifierSession -> IdentifierSession
Ord, ReadPrec [IdentifierSession]
ReadPrec IdentifierSession
Int -> ReadS IdentifierSession
ReadS [IdentifierSession]
(Int -> ReadS IdentifierSession)
-> ReadS [IdentifierSession]
-> ReadPrec IdentifierSession
-> ReadPrec [IdentifierSession]
-> Read IdentifierSession
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS IdentifierSession
readsPrec :: Int -> ReadS IdentifierSession
$creadList :: ReadS [IdentifierSession]
readList :: ReadS [IdentifierSession]
$creadPrec :: ReadPrec IdentifierSession
readPrec :: ReadPrec IdentifierSession
$creadListPrec :: ReadPrec [IdentifierSession]
readListPrec :: ReadPrec [IdentifierSession]
Read, Int -> IdentifierSession -> ShowS
[IdentifierSession] -> ShowS
IdentifierSession -> String
(Int -> IdentifierSession -> ShowS)
-> (IdentifierSession -> String)
-> ([IdentifierSession] -> ShowS)
-> Show IdentifierSession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdentifierSession -> ShowS
showsPrec :: Int -> IdentifierSession -> ShowS
$cshow :: IdentifierSession -> String
show :: IdentifierSession -> String
$cshowList :: [IdentifierSession] -> ShowS
showList :: [IdentifierSession] -> ShowS
Show)
  deriving newtype (Value -> Parser [IdentifierSession]
Value -> Parser IdentifierSession
(Value -> Parser IdentifierSession)
-> (Value -> Parser [IdentifierSession])
-> FromJSON IdentifierSession
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser IdentifierSession
parseJSON :: Value -> Parser IdentifierSession
$cparseJSONList :: Value -> Parser [IdentifierSession]
parseJSONList :: Value -> Parser [IdentifierSession]
A.FromJSON, [IdentifierSession] -> Value
[IdentifierSession] -> Encoding
IdentifierSession -> Value
IdentifierSession -> Encoding
(IdentifierSession -> Value)
-> (IdentifierSession -> Encoding)
-> ([IdentifierSession] -> Value)
-> ([IdentifierSession] -> Encoding)
-> ToJSON IdentifierSession
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: IdentifierSession -> Value
toJSON :: IdentifierSession -> Value
$ctoEncoding :: IdentifierSession -> Encoding
toEncoding :: IdentifierSession -> Encoding
$ctoJSONList :: [IdentifierSession] -> Value
toJSONList :: [IdentifierSession] -> Value
$ctoEncodingList :: [IdentifierSession] -> Encoding
toEncodingList :: [IdentifierSession] -> Encoding
A.ToJSON)

type ConfirmationSecret :: Type
newtype ConfirmationSecret = MkConfirmationSecret {ConfirmationSecret -> Text
unConfirmationSecret :: T.Text}
  deriving stock (ConfirmationSecret -> ConfirmationSecret -> Bool
(ConfirmationSecret -> ConfirmationSecret -> Bool)
-> (ConfirmationSecret -> ConfirmationSecret -> Bool)
-> Eq ConfirmationSecret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfirmationSecret -> ConfirmationSecret -> Bool
== :: ConfirmationSecret -> ConfirmationSecret -> Bool
$c/= :: ConfirmationSecret -> ConfirmationSecret -> Bool
/= :: ConfirmationSecret -> ConfirmationSecret -> Bool
Eq, (forall x. ConfirmationSecret -> Rep ConfirmationSecret x)
-> (forall x. Rep ConfirmationSecret x -> ConfirmationSecret)
-> Generic ConfirmationSecret
forall x. Rep ConfirmationSecret x -> ConfirmationSecret
forall x. ConfirmationSecret -> Rep ConfirmationSecret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfirmationSecret -> Rep ConfirmationSecret x
from :: forall x. ConfirmationSecret -> Rep ConfirmationSecret x
$cto :: forall x. Rep ConfirmationSecret x -> ConfirmationSecret
to :: forall x. Rep ConfirmationSecret x -> ConfirmationSecret
Generic, Eq ConfirmationSecret
Eq ConfirmationSecret =>
(ConfirmationSecret -> ConfirmationSecret -> Ordering)
-> (ConfirmationSecret -> ConfirmationSecret -> Bool)
-> (ConfirmationSecret -> ConfirmationSecret -> Bool)
-> (ConfirmationSecret -> ConfirmationSecret -> Bool)
-> (ConfirmationSecret -> ConfirmationSecret -> Bool)
-> (ConfirmationSecret -> ConfirmationSecret -> ConfirmationSecret)
-> (ConfirmationSecret -> ConfirmationSecret -> ConfirmationSecret)
-> Ord ConfirmationSecret
ConfirmationSecret -> ConfirmationSecret -> Bool
ConfirmationSecret -> ConfirmationSecret -> Ordering
ConfirmationSecret -> ConfirmationSecret -> ConfirmationSecret
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 :: ConfirmationSecret -> ConfirmationSecret -> Ordering
compare :: ConfirmationSecret -> ConfirmationSecret -> Ordering
$c< :: ConfirmationSecret -> ConfirmationSecret -> Bool
< :: ConfirmationSecret -> ConfirmationSecret -> Bool
$c<= :: ConfirmationSecret -> ConfirmationSecret -> Bool
<= :: ConfirmationSecret -> ConfirmationSecret -> Bool
$c> :: ConfirmationSecret -> ConfirmationSecret -> Bool
> :: ConfirmationSecret -> ConfirmationSecret -> Bool
$c>= :: ConfirmationSecret -> ConfirmationSecret -> Bool
>= :: ConfirmationSecret -> ConfirmationSecret -> Bool
$cmax :: ConfirmationSecret -> ConfirmationSecret -> ConfirmationSecret
max :: ConfirmationSecret -> ConfirmationSecret -> ConfirmationSecret
$cmin :: ConfirmationSecret -> ConfirmationSecret -> ConfirmationSecret
min :: ConfirmationSecret -> ConfirmationSecret -> ConfirmationSecret
Ord, ReadPrec [ConfirmationSecret]
ReadPrec ConfirmationSecret
Int -> ReadS ConfirmationSecret
ReadS [ConfirmationSecret]
(Int -> ReadS ConfirmationSecret)
-> ReadS [ConfirmationSecret]
-> ReadPrec ConfirmationSecret
-> ReadPrec [ConfirmationSecret]
-> Read ConfirmationSecret
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConfirmationSecret
readsPrec :: Int -> ReadS ConfirmationSecret
$creadList :: ReadS [ConfirmationSecret]
readList :: ReadS [ConfirmationSecret]
$creadPrec :: ReadPrec ConfirmationSecret
readPrec :: ReadPrec ConfirmationSecret
$creadListPrec :: ReadPrec [ConfirmationSecret]
readListPrec :: ReadPrec [ConfirmationSecret]
Read, Int -> ConfirmationSecret -> ShowS
[ConfirmationSecret] -> ShowS
ConfirmationSecret -> String
(Int -> ConfirmationSecret -> ShowS)
-> (ConfirmationSecret -> String)
-> ([ConfirmationSecret] -> ShowS)
-> Show ConfirmationSecret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfirmationSecret -> ShowS
showsPrec :: Int -> ConfirmationSecret -> ShowS
$cshow :: ConfirmationSecret -> String
show :: ConfirmationSecret -> String
$cshowList :: [ConfirmationSecret] -> ShowS
showList :: [ConfirmationSecret] -> ShowS
Show)
  deriving newtype (Value -> Parser [ConfirmationSecret]
Value -> Parser ConfirmationSecret
(Value -> Parser ConfirmationSecret)
-> (Value -> Parser [ConfirmationSecret])
-> FromJSON ConfirmationSecret
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConfirmationSecret
parseJSON :: Value -> Parser ConfirmationSecret
$cparseJSONList :: Value -> Parser [ConfirmationSecret]
parseJSONList :: Value -> Parser [ConfirmationSecret]
A.FromJSON, [ConfirmationSecret] -> Value
[ConfirmationSecret] -> Encoding
ConfirmationSecret -> Value
ConfirmationSecret -> Encoding
(ConfirmationSecret -> Value)
-> (ConfirmationSecret -> Encoding)
-> ([ConfirmationSecret] -> Value)
-> ([ConfirmationSecret] -> Encoding)
-> ToJSON ConfirmationSecret
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConfirmationSecret -> Value
toJSON :: ConfirmationSecret -> Value
$ctoEncoding :: ConfirmationSecret -> Encoding
toEncoding :: ConfirmationSecret -> Encoding
$ctoJSONList :: [ConfirmationSecret] -> Value
toJSONList :: [ConfirmationSecret] -> Value
$ctoEncodingList :: [ConfirmationSecret] -> Encoding
toEncodingList :: [ConfirmationSecret] -> Encoding
A.ToJSON)

type ErrorBasicAuth :: Type
data ErrorBasicAuth
  = MkErrorBasicAuthUsername
  | MkErrorBasicAuthPassword
  | MkErrorBasicAuthIndefinite
  deriving stock (ErrorBasicAuth -> ErrorBasicAuth -> Bool
(ErrorBasicAuth -> ErrorBasicAuth -> Bool)
-> (ErrorBasicAuth -> ErrorBasicAuth -> Bool) -> Eq ErrorBasicAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
== :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
$c/= :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
/= :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
Eq, (forall x. ErrorBasicAuth -> Rep ErrorBasicAuth x)
-> (forall x. Rep ErrorBasicAuth x -> ErrorBasicAuth)
-> Generic ErrorBasicAuth
forall x. Rep ErrorBasicAuth x -> ErrorBasicAuth
forall x. ErrorBasicAuth -> Rep ErrorBasicAuth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrorBasicAuth -> Rep ErrorBasicAuth x
from :: forall x. ErrorBasicAuth -> Rep ErrorBasicAuth x
$cto :: forall x. Rep ErrorBasicAuth x -> ErrorBasicAuth
to :: forall x. Rep ErrorBasicAuth x -> ErrorBasicAuth
Generic, Eq ErrorBasicAuth
Eq ErrorBasicAuth =>
(ErrorBasicAuth -> ErrorBasicAuth -> Ordering)
-> (ErrorBasicAuth -> ErrorBasicAuth -> Bool)
-> (ErrorBasicAuth -> ErrorBasicAuth -> Bool)
-> (ErrorBasicAuth -> ErrorBasicAuth -> Bool)
-> (ErrorBasicAuth -> ErrorBasicAuth -> Bool)
-> (ErrorBasicAuth -> ErrorBasicAuth -> ErrorBasicAuth)
-> (ErrorBasicAuth -> ErrorBasicAuth -> ErrorBasicAuth)
-> Ord ErrorBasicAuth
ErrorBasicAuth -> ErrorBasicAuth -> Bool
ErrorBasicAuth -> ErrorBasicAuth -> Ordering
ErrorBasicAuth -> ErrorBasicAuth -> ErrorBasicAuth
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 :: ErrorBasicAuth -> ErrorBasicAuth -> Ordering
compare :: ErrorBasicAuth -> ErrorBasicAuth -> Ordering
$c< :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
< :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
$c<= :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
<= :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
$c> :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
> :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
$c>= :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
>= :: ErrorBasicAuth -> ErrorBasicAuth -> Bool
$cmax :: ErrorBasicAuth -> ErrorBasicAuth -> ErrorBasicAuth
max :: ErrorBasicAuth -> ErrorBasicAuth -> ErrorBasicAuth
$cmin :: ErrorBasicAuth -> ErrorBasicAuth -> ErrorBasicAuth
min :: ErrorBasicAuth -> ErrorBasicAuth -> ErrorBasicAuth
Ord, ReadPrec [ErrorBasicAuth]
ReadPrec ErrorBasicAuth
Int -> ReadS ErrorBasicAuth
ReadS [ErrorBasicAuth]
(Int -> ReadS ErrorBasicAuth)
-> ReadS [ErrorBasicAuth]
-> ReadPrec ErrorBasicAuth
-> ReadPrec [ErrorBasicAuth]
-> Read ErrorBasicAuth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ErrorBasicAuth
readsPrec :: Int -> ReadS ErrorBasicAuth
$creadList :: ReadS [ErrorBasicAuth]
readList :: ReadS [ErrorBasicAuth]
$creadPrec :: ReadPrec ErrorBasicAuth
readPrec :: ReadPrec ErrorBasicAuth
$creadListPrec :: ReadPrec [ErrorBasicAuth]
readListPrec :: ReadPrec [ErrorBasicAuth]
Read, Int -> ErrorBasicAuth -> ShowS
[ErrorBasicAuth] -> ShowS
ErrorBasicAuth -> String
(Int -> ErrorBasicAuth -> ShowS)
-> (ErrorBasicAuth -> String)
-> ([ErrorBasicAuth] -> ShowS)
-> Show ErrorBasicAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorBasicAuth -> ShowS
showsPrec :: Int -> ErrorBasicAuth -> ShowS
$cshow :: ErrorBasicAuth -> String
show :: ErrorBasicAuth -> String
$cshowList :: [ErrorBasicAuth] -> ShowS
showList :: [ErrorBasicAuth] -> ShowS
Show)
  deriving
    (Value -> Parser [ErrorBasicAuth]
Value -> Parser ErrorBasicAuth
(Value -> Parser ErrorBasicAuth)
-> (Value -> Parser [ErrorBasicAuth]) -> FromJSON ErrorBasicAuth
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ErrorBasicAuth
parseJSON :: Value -> Parser ErrorBasicAuth
$cparseJSONList :: Value -> Parser [ErrorBasicAuth]
parseJSONList :: Value -> Parser [ErrorBasicAuth]
A.FromJSON, [ErrorBasicAuth] -> Value
[ErrorBasicAuth] -> Encoding
ErrorBasicAuth -> Value
ErrorBasicAuth -> Encoding
(ErrorBasicAuth -> Value)
-> (ErrorBasicAuth -> Encoding)
-> ([ErrorBasicAuth] -> Value)
-> ([ErrorBasicAuth] -> Encoding)
-> ToJSON ErrorBasicAuth
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ErrorBasicAuth -> Value
toJSON :: ErrorBasicAuth -> Value
$ctoEncoding :: ErrorBasicAuth -> Encoding
toEncoding :: ErrorBasicAuth -> Encoding
$ctoJSONList :: [ErrorBasicAuth] -> Value
toJSONList :: [ErrorBasicAuth] -> Value
$ctoEncodingList :: [ErrorBasicAuth] -> Encoding
toEncodingList :: [ErrorBasicAuth] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkErrorBasicAuth" "") ErrorBasicAuth

type ErrorBearerAuth :: Type
newtype ErrorBearerAuth = MkErrorBearerAuth {ErrorBearerAuth -> StaticText "indefinite"
unErrorBearerAuth :: StaticText "indefinite"}
  deriving stock (ErrorBearerAuth -> ErrorBearerAuth -> Bool
(ErrorBearerAuth -> ErrorBearerAuth -> Bool)
-> (ErrorBearerAuth -> ErrorBearerAuth -> Bool)
-> Eq ErrorBearerAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
== :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
$c/= :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
/= :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
Eq, (forall x. ErrorBearerAuth -> Rep ErrorBearerAuth x)
-> (forall x. Rep ErrorBearerAuth x -> ErrorBearerAuth)
-> Generic ErrorBearerAuth
forall x. Rep ErrorBearerAuth x -> ErrorBearerAuth
forall x. ErrorBearerAuth -> Rep ErrorBearerAuth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrorBearerAuth -> Rep ErrorBearerAuth x
from :: forall x. ErrorBearerAuth -> Rep ErrorBearerAuth x
$cto :: forall x. Rep ErrorBearerAuth x -> ErrorBearerAuth
to :: forall x. Rep ErrorBearerAuth x -> ErrorBearerAuth
Generic, Eq ErrorBearerAuth
Eq ErrorBearerAuth =>
(ErrorBearerAuth -> ErrorBearerAuth -> Ordering)
-> (ErrorBearerAuth -> ErrorBearerAuth -> Bool)
-> (ErrorBearerAuth -> ErrorBearerAuth -> Bool)
-> (ErrorBearerAuth -> ErrorBearerAuth -> Bool)
-> (ErrorBearerAuth -> ErrorBearerAuth -> Bool)
-> (ErrorBearerAuth -> ErrorBearerAuth -> ErrorBearerAuth)
-> (ErrorBearerAuth -> ErrorBearerAuth -> ErrorBearerAuth)
-> Ord ErrorBearerAuth
ErrorBearerAuth -> ErrorBearerAuth -> Bool
ErrorBearerAuth -> ErrorBearerAuth -> Ordering
ErrorBearerAuth -> ErrorBearerAuth -> ErrorBearerAuth
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 :: ErrorBearerAuth -> ErrorBearerAuth -> Ordering
compare :: ErrorBearerAuth -> ErrorBearerAuth -> Ordering
$c< :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
< :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
$c<= :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
<= :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
$c> :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
> :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
$c>= :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
>= :: ErrorBearerAuth -> ErrorBearerAuth -> Bool
$cmax :: ErrorBearerAuth -> ErrorBearerAuth -> ErrorBearerAuth
max :: ErrorBearerAuth -> ErrorBearerAuth -> ErrorBearerAuth
$cmin :: ErrorBearerAuth -> ErrorBearerAuth -> ErrorBearerAuth
min :: ErrorBearerAuth -> ErrorBearerAuth -> ErrorBearerAuth
Ord, ReadPrec [ErrorBearerAuth]
ReadPrec ErrorBearerAuth
Int -> ReadS ErrorBearerAuth
ReadS [ErrorBearerAuth]
(Int -> ReadS ErrorBearerAuth)
-> ReadS [ErrorBearerAuth]
-> ReadPrec ErrorBearerAuth
-> ReadPrec [ErrorBearerAuth]
-> Read ErrorBearerAuth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ErrorBearerAuth
readsPrec :: Int -> ReadS ErrorBearerAuth
$creadList :: ReadS [ErrorBearerAuth]
readList :: ReadS [ErrorBearerAuth]
$creadPrec :: ReadPrec ErrorBearerAuth
readPrec :: ReadPrec ErrorBearerAuth
$creadListPrec :: ReadPrec [ErrorBearerAuth]
readListPrec :: ReadPrec [ErrorBearerAuth]
Read, Int -> ErrorBearerAuth -> ShowS
[ErrorBearerAuth] -> ShowS
ErrorBearerAuth -> String
(Int -> ErrorBearerAuth -> ShowS)
-> (ErrorBearerAuth -> String)
-> ([ErrorBearerAuth] -> ShowS)
-> Show ErrorBearerAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorBearerAuth -> ShowS
showsPrec :: Int -> ErrorBearerAuth -> ShowS
$cshow :: ErrorBearerAuth -> String
show :: ErrorBearerAuth -> String
$cshowList :: [ErrorBearerAuth] -> ShowS
showList :: [ErrorBearerAuth] -> ShowS
Show)
  deriving newtype (Value -> Parser [ErrorBearerAuth]
Value -> Parser ErrorBearerAuth
(Value -> Parser ErrorBearerAuth)
-> (Value -> Parser [ErrorBearerAuth]) -> FromJSON ErrorBearerAuth
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ErrorBearerAuth
parseJSON :: Value -> Parser ErrorBearerAuth
$cparseJSONList :: Value -> Parser [ErrorBearerAuth]
parseJSONList :: Value -> Parser [ErrorBearerAuth]
A.FromJSON, [ErrorBearerAuth] -> Value
[ErrorBearerAuth] -> Encoding
ErrorBearerAuth -> Value
ErrorBearerAuth -> Encoding
(ErrorBearerAuth -> Value)
-> (ErrorBearerAuth -> Encoding)
-> ([ErrorBearerAuth] -> Value)
-> ([ErrorBearerAuth] -> Encoding)
-> ToJSON ErrorBearerAuth
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ErrorBearerAuth -> Value
toJSON :: ErrorBearerAuth -> Value
$ctoEncoding :: ErrorBearerAuth -> Encoding
toEncoding :: ErrorBearerAuth -> Encoding
$ctoJSONList :: [ErrorBearerAuth] -> Value
toJSONList :: [ErrorBearerAuth] -> Value
$ctoEncodingList :: [ErrorBearerAuth] -> Encoding
toEncodingList :: [ErrorBearerAuth] -> Encoding
A.ToJSON)