{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

module Pinch.Internal.Exception
  ( ApplicationException (..)
  , ExceptionType (..)
  , ThriftError(..)
  )
where

import           Control.Exception        (Exception)
import           Data.Int
import           Data.Typeable            (Typeable)
import           Pinch.Internal.Pinchable
import           Pinch.Internal.TType

import qualified Data.Text                as T

-- | Thrift application exception as defined in <https://github.com/apache/thrift/blob/master/doc/specs/thrift-rpc.md#response-struct>.
data ApplicationException
  = ApplicationException
  { ApplicationException -> Text
appExMessage :: T.Text
  , ApplicationException -> ExceptionType
appExType    :: ExceptionType
  }
  deriving (Int -> ApplicationException -> ShowS
[ApplicationException] -> ShowS
ApplicationException -> String
(Int -> ApplicationException -> ShowS)
-> (ApplicationException -> String)
-> ([ApplicationException] -> ShowS)
-> Show ApplicationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationException] -> ShowS
$cshowList :: [ApplicationException] -> ShowS
show :: ApplicationException -> String
$cshow :: ApplicationException -> String
showsPrec :: Int -> ApplicationException -> ShowS
$cshowsPrec :: Int -> ApplicationException -> ShowS
Show, ApplicationException -> ApplicationException -> Bool
(ApplicationException -> ApplicationException -> Bool)
-> (ApplicationException -> ApplicationException -> Bool)
-> Eq ApplicationException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationException -> ApplicationException -> Bool
$c/= :: ApplicationException -> ApplicationException -> Bool
== :: ApplicationException -> ApplicationException -> Bool
$c== :: ApplicationException -> ApplicationException -> Bool
Eq, Typeable)

instance Exception ApplicationException

instance Pinchable ApplicationException where
  type Tag ApplicationException = TStruct

  pinch :: ApplicationException -> Value (Tag ApplicationException)
pinch ApplicationException
p = [FieldPair] -> Value TStruct
struct
    [ Int16
1 Int16 -> Text -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
.= ApplicationException -> Text
appExMessage ApplicationException
p
    , Int16
2 Int16 -> ExceptionType -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
.= ApplicationException -> ExceptionType
appExType ApplicationException
p
    ]

  unpinch :: Value (Tag ApplicationException) -> Parser ApplicationException
unpinch Value (Tag ApplicationException)
value = Text -> ExceptionType -> ApplicationException
ApplicationException
    (Text -> ExceptionType -> ApplicationException)
-> Parser Text -> Parser (ExceptionType -> ApplicationException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value TStruct
Value (Tag ApplicationException)
value Value TStruct -> Int16 -> Parser Text
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
.: Int16
1
    Parser (ExceptionType -> ApplicationException)
-> Parser ExceptionType -> Parser ApplicationException
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value TStruct
Value (Tag ApplicationException)
value Value TStruct -> Int16 -> Parser ExceptionType
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
.: Int16
2

-- | Thrift exception type as defined in <https://github.com/apache/thrift/blob/master/doc/specs/thrift-rpc.md#response-struct>.
data ExceptionType
  -- DO NOT RE-ORDER, the enum values need to match the ones defined in the Thrift specification!
  = Unknown               -- 0
  | UnknownMethod         -- 1
  | InvalidMessageType    -- 2
  | WrongMethodName       -- 3
  | BadSequenceId         -- 4
  | MissingResult         -- 5
  | InternalError         -- 6
  | ProtocolError         -- 7
  | InvalidTransform      -- 8
  | InvalidProtocol       -- 9
  | UnsupportedClientType -- 10
  deriving (Int -> ExceptionType -> ShowS
[ExceptionType] -> ShowS
ExceptionType -> String
(Int -> ExceptionType -> ShowS)
-> (ExceptionType -> String)
-> ([ExceptionType] -> ShowS)
-> Show ExceptionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExceptionType] -> ShowS
$cshowList :: [ExceptionType] -> ShowS
show :: ExceptionType -> String
$cshow :: ExceptionType -> String
showsPrec :: Int -> ExceptionType -> ShowS
$cshowsPrec :: Int -> ExceptionType -> ShowS
Show, ExceptionType -> ExceptionType -> Bool
(ExceptionType -> ExceptionType -> Bool)
-> (ExceptionType -> ExceptionType -> Bool) -> Eq ExceptionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExceptionType -> ExceptionType -> Bool
$c/= :: ExceptionType -> ExceptionType -> Bool
== :: ExceptionType -> ExceptionType -> Bool
$c== :: ExceptionType -> ExceptionType -> Bool
Eq, Int -> ExceptionType
ExceptionType -> Int
ExceptionType -> [ExceptionType]
ExceptionType -> ExceptionType
ExceptionType -> ExceptionType -> [ExceptionType]
ExceptionType -> ExceptionType -> ExceptionType -> [ExceptionType]
(ExceptionType -> ExceptionType)
-> (ExceptionType -> ExceptionType)
-> (Int -> ExceptionType)
-> (ExceptionType -> Int)
-> (ExceptionType -> [ExceptionType])
-> (ExceptionType -> ExceptionType -> [ExceptionType])
-> (ExceptionType -> ExceptionType -> [ExceptionType])
-> (ExceptionType
    -> ExceptionType -> ExceptionType -> [ExceptionType])
-> Enum ExceptionType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ExceptionType -> ExceptionType -> ExceptionType -> [ExceptionType]
$cenumFromThenTo :: ExceptionType -> ExceptionType -> ExceptionType -> [ExceptionType]
enumFromTo :: ExceptionType -> ExceptionType -> [ExceptionType]
$cenumFromTo :: ExceptionType -> ExceptionType -> [ExceptionType]
enumFromThen :: ExceptionType -> ExceptionType -> [ExceptionType]
$cenumFromThen :: ExceptionType -> ExceptionType -> [ExceptionType]
enumFrom :: ExceptionType -> [ExceptionType]
$cenumFrom :: ExceptionType -> [ExceptionType]
fromEnum :: ExceptionType -> Int
$cfromEnum :: ExceptionType -> Int
toEnum :: Int -> ExceptionType
$ctoEnum :: Int -> ExceptionType
pred :: ExceptionType -> ExceptionType
$cpred :: ExceptionType -> ExceptionType
succ :: ExceptionType -> ExceptionType
$csucc :: ExceptionType -> ExceptionType
Enum, ExceptionType
ExceptionType -> ExceptionType -> Bounded ExceptionType
forall a. a -> a -> Bounded a
maxBound :: ExceptionType
$cmaxBound :: ExceptionType
minBound :: ExceptionType
$cminBound :: ExceptionType
Bounded)

instance Pinchable ExceptionType where
  type Tag ExceptionType = TEnum

  pinch :: ExceptionType -> Value (Tag ExceptionType)
pinch ExceptionType
t = Int32 -> Value (Tag Int32)
forall a. Pinchable a => a -> Value (Tag a)
pinch ((Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ ExceptionType -> Int
forall a. Enum a => a -> Int
fromEnum ExceptionType
t) :: Int32)

  unpinch :: Value (Tag ExceptionType) -> Parser ExceptionType
unpinch Value (Tag ExceptionType)
v = do
    Int
value <- (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int32 -> Int) (Int32 -> Int) -> Parser Int32 -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Tag Int32) -> Parser Int32
forall a. Pinchable a => Value (Tag a) -> Parser a
unpinch Value (Tag Int32)
Value (Tag ExceptionType)
v
    if (ExceptionType -> Int
forall a. Enum a => a -> Int
fromEnum (ExceptionType -> Int) -> ExceptionType -> Int
forall a b. (a -> b) -> a -> b
$ Bounded ExceptionType => ExceptionType
forall a. Bounded a => a
minBound @ExceptionType) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
value Bool -> Bool -> Bool
&& Int
value Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (ExceptionType -> Int
forall a. Enum a => a -> Int
fromEnum (ExceptionType -> Int) -> ExceptionType -> Int
forall a b. (a -> b) -> a -> b
$ Bounded ExceptionType => ExceptionType
forall a. Bounded a => a
maxBound @ExceptionType)
      then ExceptionType -> Parser ExceptionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptionType -> Parser ExceptionType)
-> ExceptionType -> Parser ExceptionType
forall a b. (a -> b) -> a -> b
$ Int -> ExceptionType
forall a. Enum a => Int -> a
toEnum (Int -> ExceptionType) -> Int -> ExceptionType
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value
      else String -> Parser ExceptionType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ExceptionType) -> String -> Parser ExceptionType
forall a b. (a -> b) -> a -> b
$ String
"Unknown application exception type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
value

-- | An error occured while processing a thrift call.
-- Signals errors like premature EOF, Thrift protocol parsing failures etc.
data ThriftError = ThriftError T.Text
  deriving (Int -> ThriftError -> ShowS
[ThriftError] -> ShowS
ThriftError -> String
(Int -> ThriftError -> ShowS)
-> (ThriftError -> String)
-> ([ThriftError] -> ShowS)
-> Show ThriftError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThriftError] -> ShowS
$cshowList :: [ThriftError] -> ShowS
show :: ThriftError -> String
$cshow :: ThriftError -> String
showsPrec :: Int -> ThriftError -> ShowS
$cshowsPrec :: Int -> ThriftError -> ShowS
Show, ThriftError -> ThriftError -> Bool
(ThriftError -> ThriftError -> Bool)
-> (ThriftError -> ThriftError -> Bool) -> Eq ThriftError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThriftError -> ThriftError -> Bool
$c/= :: ThriftError -> ThriftError -> Bool
== :: ThriftError -> ThriftError -> Bool
$c== :: ThriftError -> ThriftError -> Bool
Eq)
instance Exception ThriftError