{-# LANGUAGE PatternSynonyms #-}

module Network.QPACK.Error (
    -- * Errors
    ApplicationProtocolError (
        QpackDecompressionFailed,
        QpackEncoderStreamError,
        QpackDecoderStreamError
    ),
    DecodeError (..),
    EncoderInstructionError (..),
    DecoderInstructionError (..),
) where

import Data.Typeable
import UnliftIO.Exception

import Network.QUIC

{- FOURMOLU_DISABLE -}
pattern QpackDecompressionFailed :: ApplicationProtocolError
pattern $mQpackDecompressionFailed :: forall {r}.
ApplicationProtocolError -> ((# #) -> r) -> ((# #) -> r) -> r
$bQpackDecompressionFailed :: ApplicationProtocolError
QpackDecompressionFailed  = ApplicationProtocolError 0x200

pattern QpackEncoderStreamError  :: ApplicationProtocolError
pattern $mQpackEncoderStreamError :: forall {r}.
ApplicationProtocolError -> ((# #) -> r) -> ((# #) -> r) -> r
$bQpackEncoderStreamError :: ApplicationProtocolError
QpackEncoderStreamError   = ApplicationProtocolError 0x201

pattern QpackDecoderStreamError  :: ApplicationProtocolError
pattern $mQpackDecoderStreamError :: forall {r}.
ApplicationProtocolError -> ((# #) -> r) -> ((# #) -> r) -> r
$bQpackDecoderStreamError :: ApplicationProtocolError
QpackDecoderStreamError   = ApplicationProtocolError 0x202
{- FOURMOLU_ENABLE -}

data DecodeError
    = IllegalStaticIndex
    | IllegalInsertCount
    deriving (DecodeError -> DecodeError -> Bool
(DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool) -> Eq DecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeError -> DecodeError -> Bool
== :: DecodeError -> DecodeError -> Bool
$c/= :: DecodeError -> DecodeError -> Bool
/= :: DecodeError -> DecodeError -> Bool
Eq, Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeError -> ShowS
showsPrec :: Int -> DecodeError -> ShowS
$cshow :: DecodeError -> String
show :: DecodeError -> String
$cshowList :: [DecodeError] -> ShowS
showList :: [DecodeError] -> ShowS
Show, Typeable)

data EncoderInstructionError = EncoderInstructionError
    deriving (EncoderInstructionError -> EncoderInstructionError -> Bool
(EncoderInstructionError -> EncoderInstructionError -> Bool)
-> (EncoderInstructionError -> EncoderInstructionError -> Bool)
-> Eq EncoderInstructionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncoderInstructionError -> EncoderInstructionError -> Bool
== :: EncoderInstructionError -> EncoderInstructionError -> Bool
$c/= :: EncoderInstructionError -> EncoderInstructionError -> Bool
/= :: EncoderInstructionError -> EncoderInstructionError -> Bool
Eq, Int -> EncoderInstructionError -> ShowS
[EncoderInstructionError] -> ShowS
EncoderInstructionError -> String
(Int -> EncoderInstructionError -> ShowS)
-> (EncoderInstructionError -> String)
-> ([EncoderInstructionError] -> ShowS)
-> Show EncoderInstructionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncoderInstructionError -> ShowS
showsPrec :: Int -> EncoderInstructionError -> ShowS
$cshow :: EncoderInstructionError -> String
show :: EncoderInstructionError -> String
$cshowList :: [EncoderInstructionError] -> ShowS
showList :: [EncoderInstructionError] -> ShowS
Show, Typeable)
data DecoderInstructionError = DecoderInstructionError
    deriving (DecoderInstructionError -> DecoderInstructionError -> Bool
(DecoderInstructionError -> DecoderInstructionError -> Bool)
-> (DecoderInstructionError -> DecoderInstructionError -> Bool)
-> Eq DecoderInstructionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecoderInstructionError -> DecoderInstructionError -> Bool
== :: DecoderInstructionError -> DecoderInstructionError -> Bool
$c/= :: DecoderInstructionError -> DecoderInstructionError -> Bool
/= :: DecoderInstructionError -> DecoderInstructionError -> Bool
Eq, Int -> DecoderInstructionError -> ShowS
[DecoderInstructionError] -> ShowS
DecoderInstructionError -> String
(Int -> DecoderInstructionError -> ShowS)
-> (DecoderInstructionError -> String)
-> ([DecoderInstructionError] -> ShowS)
-> Show DecoderInstructionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecoderInstructionError -> ShowS
showsPrec :: Int -> DecoderInstructionError -> ShowS
$cshow :: DecoderInstructionError -> String
show :: DecoderInstructionError -> String
$cshowList :: [DecoderInstructionError] -> ShowS
showList :: [DecoderInstructionError] -> ShowS
Show, Typeable)

instance Exception DecodeError
instance Exception EncoderInstructionError
instance Exception DecoderInstructionError