{-# 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
(TransportError -> TransportError -> Bool)
-> (TransportError -> TransportError -> Bool) -> Eq TransportError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransportError -> TransportError -> Bool
== :: TransportError -> TransportError -> Bool
$c/= :: TransportError -> TransportError -> Bool
/= :: TransportError -> TransportError -> Bool
Eq)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

pattern VersionNegotiationError :: TransportError
pattern $mVersionNegotiationError :: forall {r}. TransportError -> ((# #) -> r) -> ((# #) -> r) -> r
$bVersionNegotiationError :: TransportError
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x01ff = String
"TLS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AlertDescription -> String
forall a. Show a => a -> String
show (Word8 -> AlertDescription
toAlertDescription (Word8 -> AlertDescription) -> Word8 -> AlertDescription
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x100))
      | Bool
otherwise = String
"TransportError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%x" Int
x
{- FOURMOLU_ENABLE -}

-- | 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
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
(ApplicationProtocolError -> ApplicationProtocolError -> Bool)
-> (ApplicationProtocolError -> ApplicationProtocolError -> Bool)
-> Eq ApplicationProtocolError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
== :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
$c/= :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
/= :: ApplicationProtocolError -> ApplicationProtocolError -> Bool
Eq, Int -> ApplicationProtocolError -> ShowS
[ApplicationProtocolError] -> ShowS
ApplicationProtocolError -> String
(Int -> ApplicationProtocolError -> ShowS)
-> (ApplicationProtocolError -> String)
-> ([ApplicationProtocolError] -> ShowS)
-> Show ApplicationProtocolError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplicationProtocolError -> ShowS
showsPrec :: Int -> ApplicationProtocolError -> ShowS
$cshow :: ApplicationProtocolError -> String
show :: ApplicationProtocolError -> String
$cshowList :: [ApplicationProtocolError] -> ShowS
showList :: [ApplicationProtocolError] -> ShowS
Show)