{-# 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
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
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 forall a. Pinchable a => Int16 -> a -> FieldPair
.= ApplicationException -> Text
appExMessage ApplicationException
p
    , Int16
2 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Tag ApplicationException)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
.: Int16
1
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value (Tag ApplicationException)
value 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
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
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]
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
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 = forall a. Pinchable a => a -> Value (Tag a)
pinch ((forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum ExceptionType
t) :: Int32)

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