{-# LANGUAGE DeriveGeneric #-}

module Network.OAuth.OAuth2.TokenRequest where

import           Data.Aeson
import           GHC.Generics

instance FromJSON Errors where
  parseJSON :: Value -> Parser Errors
parseJSON = Options -> Value -> Parser Errors
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { constructorTagModifier :: String -> String
constructorTagModifier = Char -> String -> String
camelTo2 Char
'_', allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True }
instance ToJSON Errors where
  toEncoding :: Errors -> Encoding
toEncoding = Options -> Errors -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions { constructorTagModifier :: String -> String
constructorTagModifier = Char -> String -> String
camelTo2 Char
'_', allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True }

-- | Token Error Responses https://tools.ietf.org/html/rfc6749#section-5.2
data Errors =
    InvalidRequest
  | InvalidClient
  | InvalidGrant
  | UnauthorizedClient
  | UnsupportedGrantType
  | InvalidScope
  deriving (Int -> Errors -> String -> String
[Errors] -> String -> String
Errors -> String
(Int -> Errors -> String -> String)
-> (Errors -> String)
-> ([Errors] -> String -> String)
-> Show Errors
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Errors] -> String -> String
$cshowList :: [Errors] -> String -> String
show :: Errors -> String
$cshow :: Errors -> String
showsPrec :: Int -> Errors -> String -> String
$cshowsPrec :: Int -> Errors -> String -> String
Show, Errors -> Errors -> Bool
(Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool) -> Eq Errors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Errors -> Errors -> Bool
$c/= :: Errors -> Errors -> Bool
== :: Errors -> Errors -> Bool
$c== :: Errors -> Errors -> Bool
Eq, (forall x. Errors -> Rep Errors x)
-> (forall x. Rep Errors x -> Errors) -> Generic Errors
forall x. Rep Errors x -> Errors
forall x. Errors -> Rep Errors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Errors x -> Errors
$cfrom :: forall x. Errors -> Rep Errors x
Generic)