{-# 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 $bQpackDecompressionFailed :: ApplicationProtocolError
$mQpackDecompressionFailed :: forall {r}.
ApplicationProtocolError -> ((# #) -> r) -> ((# #) -> r) -> r
QpackDecompressionFailed  = ApplicationProtocolError 0x200

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

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

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

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

instance Exception DecodeError
instance Exception EncoderInstructionError
instance Exception DecoderInstructionError