module Network.QUIC.Types.Exception where

import qualified Network.TLS as TLS
import qualified UnliftIO.Exception as E

import Network.QUIC.Imports
import Network.QUIC.Types.Error
import Network.QUIC.Types.Frame
import Network.QUIC.Types.Packet

-- | User level exceptions for QUIC.
data QUICException
    = ConnectionIsClosed -- NoError
    | TransportErrorIsReceived TransportError ReasonPhrase
    | TransportErrorIsSent TransportError ReasonPhrase
    | ApplicationProtocolErrorIsReceived ApplicationProtocolError ReasonPhrase
    | ApplicationProtocolErrorIsSent ApplicationProtocolError ReasonPhrase
    | ConnectionIsTimeout String
    | ConnectionIsReset
    | StreamIsClosed
    | HandshakeFailed TLS.AlertDescription -- failed in my side
    | VersionIsUnknown Word32
    | NoVersionIsSpecified
    | VersionNegotiationFailed
    | BadThingHappen E.SomeException
    deriving (Int -> QUICException -> ShowS
[QUICException] -> ShowS
QUICException -> String
(Int -> QUICException -> ShowS)
-> (QUICException -> String)
-> ([QUICException] -> ShowS)
-> Show QUICException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QUICException -> ShowS
showsPrec :: Int -> QUICException -> ShowS
$cshow :: QUICException -> String
show :: QUICException -> String
$cshowList :: [QUICException] -> ShowS
showList :: [QUICException] -> ShowS
Show)

instance E.Exception QUICException

data InternalControl
    = MustNotReached
    | ExitConnection
    | WrongTransportParameter
    | WrongVersionInformation
    | BreakForever
    deriving (InternalControl -> InternalControl -> Bool
(InternalControl -> InternalControl -> Bool)
-> (InternalControl -> InternalControl -> Bool)
-> Eq InternalControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalControl -> InternalControl -> Bool
== :: InternalControl -> InternalControl -> Bool
$c/= :: InternalControl -> InternalControl -> Bool
/= :: InternalControl -> InternalControl -> Bool
Eq, Int -> InternalControl -> ShowS
[InternalControl] -> ShowS
InternalControl -> String
(Int -> InternalControl -> ShowS)
-> (InternalControl -> String)
-> ([InternalControl] -> ShowS)
-> Show InternalControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalControl -> ShowS
showsPrec :: Int -> InternalControl -> ShowS
$cshow :: InternalControl -> String
show :: InternalControl -> String
$cshowList :: [InternalControl] -> ShowS
showList :: [InternalControl] -> ShowS
Show)

instance E.Exception InternalControl

newtype NextVersion = NextVersion VersionInfo deriving (Int -> NextVersion -> ShowS
[NextVersion] -> ShowS
NextVersion -> String
(Int -> NextVersion -> ShowS)
-> (NextVersion -> String)
-> ([NextVersion] -> ShowS)
-> Show NextVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NextVersion -> ShowS
showsPrec :: Int -> NextVersion -> ShowS
$cshow :: NextVersion -> String
show :: NextVersion -> String
$cshowList :: [NextVersion] -> ShowS
showList :: [NextVersion] -> ShowS
Show)

instance E.Exception NextVersion

data Abort
    = Abort ApplicationProtocolError ReasonPhrase
    | VerNego VersionInfo
    deriving (Int -> Abort -> ShowS
[Abort] -> ShowS
Abort -> String
(Int -> Abort -> ShowS)
-> (Abort -> String) -> ([Abort] -> ShowS) -> Show Abort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Abort -> ShowS
showsPrec :: Int -> Abort -> ShowS
$cshow :: Abort -> String
show :: Abort -> String
$cshowList :: [Abort] -> ShowS
showList :: [Abort] -> ShowS
Show)

instance E.Exception Abort where
    fromException :: SomeException -> Maybe Abort
fromException = SomeException -> Maybe Abort
forall e. Exception e => SomeException -> Maybe e
E.asyncExceptionFromException
    toException :: Abort -> SomeException
toException = Abort -> SomeException
forall e. Exception e => e -> SomeException
E.asyncExceptionToException