{-# LANGUAGE PatternSynonyms #-}

module Network.QUIC.Types.Error where

import qualified Network.TLS as TLS
import Network.TLS.QUIC
import Text.Printf

-- | Transport errors of QUIC.
newtype TransportError = TransportError Int deriving (TransportError -> TransportError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransportError -> TransportError -> Bool
$c/= :: TransportError -> TransportError -> Bool
== :: TransportError -> TransportError -> Bool
$c== :: TransportError -> TransportError -> Bool
Eq)

pattern NoError                 :: TransportError
pattern $bNoError :: TransportError
$mNoError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
NoError                  = TransportError  0x0

pattern InternalError           :: TransportError
pattern $bInternalError :: TransportError
$mInternalError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
InternalError            = TransportError  0x1

pattern ConnectionRefused       :: TransportError
pattern $bConnectionRefused :: TransportError
$mConnectionRefused :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
ConnectionRefused        = TransportError  0x2

pattern FlowControlError        :: TransportError
pattern $bFlowControlError :: TransportError
$mFlowControlError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
FlowControlError         = TransportError  0x3

pattern StreamLimitError        :: TransportError
pattern $bStreamLimitError :: TransportError
$mStreamLimitError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
StreamLimitError         = TransportError  0x4

pattern StreamStateError        :: TransportError
pattern $bStreamStateError :: TransportError
$mStreamStateError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
StreamStateError         = TransportError  0x5

pattern FinalSizeError          :: TransportError
pattern $bFinalSizeError :: TransportError
$mFinalSizeError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
FinalSizeError           = TransportError  0x6

pattern FrameEncodingError      :: TransportError
pattern $bFrameEncodingError :: TransportError
$mFrameEncodingError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
FrameEncodingError       = TransportError  0x7

pattern TransportParameterError :: TransportError
pattern $bTransportParameterError :: TransportError
$mTransportParameterError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
TransportParameterError  = TransportError  0x8

pattern ConnectionIdLimitError  :: TransportError
pattern $bConnectionIdLimitError :: TransportError
$mConnectionIdLimitError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
ConnectionIdLimitError   = TransportError  0x9

pattern ProtocolViolation       :: TransportError
pattern $bProtocolViolation :: TransportError
$mProtocolViolation :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
ProtocolViolation        = TransportError  0xa

pattern InvalidToken            :: TransportError
pattern $bInvalidToken :: TransportError
$mInvalidToken :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
InvalidToken             = TransportError  0xb

pattern ApplicationError        :: TransportError
pattern $bApplicationError :: TransportError
$mApplicationError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
ApplicationError         = TransportError  0xc

pattern CryptoBufferExceeded    :: TransportError
pattern $bCryptoBufferExceeded :: TransportError
$mCryptoBufferExceeded :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
CryptoBufferExceeded     = TransportError  0xd

pattern KeyUpdateError          :: TransportError
pattern $bKeyUpdateError :: TransportError
$mKeyUpdateError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
KeyUpdateError           = TransportError  0xe

pattern AeadLimitReached        :: TransportError
pattern $bAeadLimitReached :: TransportError
$mAeadLimitReached :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
AeadLimitReached         = TransportError  0xf

pattern NoViablePath            :: TransportError
pattern $bNoViablePath :: TransportError
$mNoViablePath :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
NoViablePath             = TransportError 0x10

pattern VersionNegotiationError :: TransportError
pattern $bVersionNegotiationError :: TransportError
$mVersionNegotiationError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
VersionNegotiationError  = TransportError 0x11

instance Show TransportError where
    show :: TransportError -> String
show (TransportError    Int
0x0) = String
"NoError"
    show (TransportError    Int
0x1) = String
"InternalError"
    show (TransportError    Int
0x2) = String
"ConnectionRefused"
    show (TransportError    Int
0x3) = String
"FlowControlError"
    show (TransportError    Int
0x4) = String
"StreamLimitError"
    show (TransportError    Int
0x5) = String
"StreamStateError"
    show (TransportError    Int
0x6) = String
"FinalSizeError"
    show (TransportError    Int
0x7) = String
"FrameEncodingError"
    show (TransportError    Int
0x8) = String
"TransportParameterError"
    show (TransportError    Int
0x9) = String
"ConnectionIdLimitError"
    show (TransportError    Int
0xa) = String
"ProtocolViolation"
    show (TransportError    Int
0xb) = String
"InvalidToken"
    show (TransportError    Int
0xc) = String
"ApplicationError"
    show (TransportError    Int
0xd) = String
"CryptoBufferExceeded"
    show (TransportError    Int
0xe) = String
"KeyUpdateError"
    show (TransportError    Int
0xf) = String
"AeadLimitReached"
    show (TransportError   Int
0x10) = String
"NoViablePath"
    show (TransportError   Int
0x11) = String
"VersionNegotiationError"
    show (TransportError      Int
x)
      | Int
0x100 forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
0x01ff = case Word8 -> Maybe AlertDescription
toAlertDescription forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Num a => a -> a -> a
- Int
0x100) of
          Just AlertDescription
e  -> String
"TLS " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show AlertDescription
e
          Maybe AlertDescription
Nothing -> String
"TLS Alert " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x
      | Bool
otherwise = String
"TransportError " forall a. [a] -> [a] -> [a]
++ forall r. PrintfType r => String -> r
printf String
"%x" Int
x

-- | Converting a TLS alert to a corresponding transport error.
cryptoError :: TLS.AlertDescription -> TransportError
cryptoError :: AlertDescription -> TransportError
cryptoError AlertDescription
ad = Int -> TransportError
TransportError Int
ec
  where
    ec :: Int
ec = Int
0x100 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (AlertDescription -> Word8
fromAlertDescription AlertDescription
ad)

-- | Application protocol errors of QUIC.
newtype ApplicationProtocolError = ApplicationProtocolError Int deriving (ApplicationProtocolError -> ApplicationProtocolError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
$c/= :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
== :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
$c== :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
Eq, Int -> ApplicationProtocolError -> ShowS
[ApplicationProtocolError] -> ShowS
ApplicationProtocolError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationProtocolError] -> ShowS
$cshowList :: [ApplicationProtocolError] -> ShowS
show :: ApplicationProtocolError -> String
$cshow :: ApplicationProtocolError -> String
showsPrec :: Int -> ApplicationProtocolError -> ShowS
$cshowsPrec :: Int -> ApplicationProtocolError -> ShowS
Show)