{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
module Telegram.Bot.API.Types.PassportElementError where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson.Text (encodeToLazyText)
import Data.Text (Text)
import GHC.Generics (Generic)
import Servant.API (ToHttpApiData (..))

import qualified Data.Text.Lazy as TL

import Telegram.Bot.API.Types.EncryptedPassportElement
import Telegram.Bot.API.Internal.Utils

-- ** 'PassportElementError'

data PassportErrorSource
  = PassportErrorSourceData
  | PassportErrorSourceFrontSide
  | PassportErrorSourceReverseSide
  | PassportErrorSourceSelfie
  | PassportErrorSourceFile
  | PassportErrorSourceFiles
  | PassportErrorSourceTranslationFile
  | PassportErrorSourceTranslationFiles
  | PassportErrorSourceUnspecified
  deriving (forall x. Rep PassportErrorSource x -> PassportErrorSource
forall x. PassportErrorSource -> Rep PassportErrorSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PassportErrorSource x -> PassportErrorSource
$cfrom :: forall x. PassportErrorSource -> Rep PassportErrorSource x
Generic, Int -> PassportErrorSource -> ShowS
[PassportErrorSource] -> ShowS
PassportErrorSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PassportErrorSource] -> ShowS
$cshowList :: [PassportErrorSource] -> ShowS
show :: PassportErrorSource -> String
$cshow :: PassportErrorSource -> String
showsPrec :: Int -> PassportErrorSource -> ShowS
$cshowsPrec :: Int -> PassportErrorSource -> ShowS
Show)

instance ToJSON   PassportErrorSource where toJSON :: PassportErrorSource -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON PassportErrorSource where parseJSON :: Value -> Parser PassportErrorSource
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON

data PassportElementError
  = PassportElementError
    { PassportElementError -> PassportErrorSource
passportElementErroSource       :: PassportErrorSource -- ^ Error source, must be one of 'PassportErrorSource'.
    , PassportElementError -> PassportElementType
passportElementErrorType        :: PassportElementType -- ^ The section of the user's Telegram Passport which has the error, one of 'PassportElementType'.
    , PassportElementError -> Text
passportElementErrorName        :: Text                -- ^ Name of the data field which has the error.
    , PassportElementError -> Maybe Text
passportElementErrorHash        :: Maybe Text          -- ^ Base64-encoded data hash.
    , PassportElementError -> Text
passportElementErrorMessage     :: Text                -- ^ Error message.
    , PassportElementError -> Maybe Text
passportElementErrorFileHash    :: Maybe Text          -- ^ Base64-encoded hash of the file with the reverse side of the document.
    , PassportElementError -> Maybe [Text]
passportElementErrorFileHashes  :: Maybe [Text]        -- ^ List of base64-encoded file hashes.
    , PassportElementError -> Maybe Text
passportElementErrorElementHash :: Maybe Text          -- ^ Base64-encoded element hash.
    }
    deriving (forall x. Rep PassportElementError x -> PassportElementError
forall x. PassportElementError -> Rep PassportElementError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PassportElementError x -> PassportElementError
$cfrom :: forall x. PassportElementError -> Rep PassportElementError x
Generic, Int -> PassportElementError -> ShowS
[PassportElementError] -> ShowS
PassportElementError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PassportElementError] -> ShowS
$cshowList :: [PassportElementError] -> ShowS
show :: PassportElementError -> String
$cshow :: PassportElementError -> String
showsPrec :: Int -> PassportElementError -> ShowS
$cshowsPrec :: Int -> PassportElementError -> ShowS
Show)

instance ToHttpApiData PassportElementError where
  toUrlPiece :: PassportElementError -> Text
toUrlPiece = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Text
encodeToLazyText

instance ToHttpApiData [PassportElementError] where
  toUrlPiece :: [PassportElementError] -> Text
toUrlPiece = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Text
encodeToLazyText

instance ToJSON   PassportElementError where toJSON :: PassportElementError -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON PassportElementError where parseJSON :: Value -> Parser PassportElementError
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON