{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternSynonyms #-}

module Network.TLS.Error where

import Control.Exception (Exception (..))
import Data.Typeable
import Network.TLS.Imports

----------------------------------------------------------------

-- | TLSError that might be returned through the TLS stack.
--
-- Prior to version 1.8.0, this type had an @Exception@ instance.
-- In version 1.8.0, this instance was removed, and functions in
-- this library now only throw 'TLSException'.
data TLSError
    = -- | mainly for instance of Error
      Error_Misc String
    | -- | A fatal error condition was encountered at a low level.  The
      -- elements of the tuple give (freeform text description, structured
      -- error description).
      Error_Protocol String AlertDescription
    | -- | A non-fatal error condition was encountered at a low level at a low
      -- level.  The elements of the tuple give (freeform text description,
      -- structured error description).
      Error_Protocol_Warning String AlertDescription
    | Error_Certificate String
    | -- | handshake policy failed.
      Error_HandshakePolicy String
    | Error_EOF
    | Error_Packet String
    | Error_Packet_unexpected String String
    | Error_Packet_Parsing String
    | Error_TCP_Terminate
    deriving (TLSError -> TLSError -> Bool
(TLSError -> TLSError -> Bool)
-> (TLSError -> TLSError -> Bool) -> Eq TLSError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TLSError -> TLSError -> Bool
== :: TLSError -> TLSError -> Bool
$c/= :: TLSError -> TLSError -> Bool
/= :: TLSError -> TLSError -> Bool
Eq, Int -> TLSError -> ShowS
[TLSError] -> ShowS
TLSError -> String
(Int -> TLSError -> ShowS)
-> (TLSError -> String) -> ([TLSError] -> ShowS) -> Show TLSError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLSError -> ShowS
showsPrec :: Int -> TLSError -> ShowS
$cshow :: TLSError -> String
show :: TLSError -> String
$cshowList :: [TLSError] -> ShowS
showList :: [TLSError] -> ShowS
Show, Typeable)

----------------------------------------------------------------

-- | TLS Exceptions. Some of the data constructors indicate incorrect use of
--   the library, and the documentation for those data constructors calls
--   this out. The others wrap 'TLSError' with some kind of context to explain
--   when the exception occurred.
data TLSException
    = -- | Early termination exception with the reason and the error associated
      Terminated Bool String TLSError
    | -- | Handshake failed for the reason attached.
      HandshakeFailed TLSError
    | -- | Failure occurred while sending or receiving data after the
      --   TLS handshake succeeded.
      PostHandshake TLSError
    | -- | Lifts a 'TLSError' into 'TLSException' without provided any context
      --   around when the error happened.
      Uncontextualized TLSError
    | -- | Usage error when the connection has not been established
      --   and the user is trying to send or receive data.
      --   Indicates that this library has been used incorrectly.
      ConnectionNotEstablished
    | -- | Expected that a TLS handshake had already taken place, but no TLS
      --   handshake had occurred.
      --   Indicates that this library has been used incorrectly.
      MissingHandshake
    deriving (Int -> TLSException -> ShowS
[TLSException] -> ShowS
TLSException -> String
(Int -> TLSException -> ShowS)
-> (TLSException -> String)
-> ([TLSException] -> ShowS)
-> Show TLSException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLSException -> ShowS
showsPrec :: Int -> TLSException -> ShowS
$cshow :: TLSException -> String
show :: TLSException -> String
$cshowList :: [TLSException] -> ShowS
showList :: [TLSException] -> ShowS
Show, TLSException -> TLSException -> Bool
(TLSException -> TLSException -> Bool)
-> (TLSException -> TLSException -> Bool) -> Eq TLSException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TLSException -> TLSException -> Bool
== :: TLSException -> TLSException -> Bool
$c/= :: TLSException -> TLSException -> Bool
/= :: TLSException -> TLSException -> Bool
Eq, Typeable)

instance Exception TLSException

----------------------------------------------------------------

newtype AlertLevel = AlertLevel {AlertLevel -> Word8
fromAlertLevel :: Word8} deriving (AlertLevel -> AlertLevel -> Bool
(AlertLevel -> AlertLevel -> Bool)
-> (AlertLevel -> AlertLevel -> Bool) -> Eq AlertLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlertLevel -> AlertLevel -> Bool
== :: AlertLevel -> AlertLevel -> Bool
$c/= :: AlertLevel -> AlertLevel -> Bool
/= :: AlertLevel -> AlertLevel -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern AlertLevel_Warning :: AlertLevel
pattern $mAlertLevel_Warning :: forall {r}. AlertLevel -> ((# #) -> r) -> ((# #) -> r) -> r
$bAlertLevel_Warning :: AlertLevel
AlertLevel_Warning  = AlertLevel 1
pattern AlertLevel_Fatal   :: AlertLevel
pattern $mAlertLevel_Fatal :: forall {r}. AlertLevel -> ((# #) -> r) -> ((# #) -> r) -> r
$bAlertLevel_Fatal :: AlertLevel
AlertLevel_Fatal    = AlertLevel 2

instance Show AlertLevel where
    show :: AlertLevel -> String
show AlertLevel
AlertLevel_Warning = String
"AlertLevel_Warning"
    show AlertLevel
AlertLevel_Fatal   = String
"AlertLevel_Fatal"
    show (AlertLevel Word8
x)     = String
"AlertLevel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

----------------------------------------------------------------

newtype AlertDescription = AlertDescription {AlertDescription -> Word8
fromAlertDescription :: Word8}
    deriving (AlertDescription -> AlertDescription -> Bool
(AlertDescription -> AlertDescription -> Bool)
-> (AlertDescription -> AlertDescription -> Bool)
-> Eq AlertDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlertDescription -> AlertDescription -> Bool
== :: AlertDescription -> AlertDescription -> Bool
$c/= :: AlertDescription -> AlertDescription -> Bool
/= :: AlertDescription -> AlertDescription -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern CloseNotify                  :: AlertDescription
pattern $mCloseNotify :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCloseNotify :: AlertDescription
CloseNotify                   = AlertDescription 0
pattern UnexpectedMessage            :: AlertDescription
pattern $mUnexpectedMessage :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnexpectedMessage :: AlertDescription
UnexpectedMessage             = AlertDescription 10
pattern BadRecordMac                 :: AlertDescription
pattern $mBadRecordMac :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadRecordMac :: AlertDescription
BadRecordMac                  = AlertDescription 20
pattern DecryptionFailed             :: AlertDescription
pattern $mDecryptionFailed :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecryptionFailed :: AlertDescription
DecryptionFailed              = AlertDescription 21
pattern RecordOverflow               :: AlertDescription
pattern $mRecordOverflow :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bRecordOverflow :: AlertDescription
RecordOverflow                = AlertDescription 22
pattern DecompressionFailure         :: AlertDescription
pattern $mDecompressionFailure :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecompressionFailure :: AlertDescription
DecompressionFailure          = AlertDescription 30
pattern HandshakeFailure             :: AlertDescription
pattern $mHandshakeFailure :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeFailure :: AlertDescription
HandshakeFailure              = AlertDescription 40
pattern BadCertificate               :: AlertDescription
pattern $mBadCertificate :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadCertificate :: AlertDescription
BadCertificate                = AlertDescription 42
pattern UnsupportedCertificate       :: AlertDescription
pattern $mUnsupportedCertificate :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnsupportedCertificate :: AlertDescription
UnsupportedCertificate        = AlertDescription 43
pattern CertificateRevoked           :: AlertDescription
pattern $mCertificateRevoked :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateRevoked :: AlertDescription
CertificateRevoked            = AlertDescription 44
pattern CertificateExpired           :: AlertDescription
pattern $mCertificateExpired :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateExpired :: AlertDescription
CertificateExpired            = AlertDescription 45
pattern CertificateUnknown           :: AlertDescription
pattern $mCertificateUnknown :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateUnknown :: AlertDescription
CertificateUnknown            = AlertDescription 46
pattern IllegalParameter             :: AlertDescription
pattern $mIllegalParameter :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bIllegalParameter :: AlertDescription
IllegalParameter              = AlertDescription 47
pattern UnknownCa                    :: AlertDescription
pattern $mUnknownCa :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnknownCa :: AlertDescription
UnknownCa                     = AlertDescription 48
pattern AccessDenied                 :: AlertDescription
pattern $mAccessDenied :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bAccessDenied :: AlertDescription
AccessDenied                  = AlertDescription 49
pattern DecodeError                  :: AlertDescription
pattern $mDecodeError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecodeError :: AlertDescription
DecodeError                   = AlertDescription 50
pattern DecryptError                 :: AlertDescription
pattern $mDecryptError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecryptError :: AlertDescription
DecryptError                  = AlertDescription 51
pattern ExportRestriction            :: AlertDescription
pattern $mExportRestriction :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bExportRestriction :: AlertDescription
ExportRestriction             = AlertDescription 60
pattern ProtocolVersion              :: AlertDescription
pattern $mProtocolVersion :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bProtocolVersion :: AlertDescription
ProtocolVersion               = AlertDescription 70
pattern InsufficientSecurity         :: AlertDescription
pattern $mInsufficientSecurity :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bInsufficientSecurity :: AlertDescription
InsufficientSecurity          = AlertDescription 71
pattern InternalError                :: AlertDescription
pattern $mInternalError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bInternalError :: AlertDescription
InternalError                 = AlertDescription 80
pattern InappropriateFallback        :: AlertDescription
pattern $mInappropriateFallback :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bInappropriateFallback :: AlertDescription
InappropriateFallback         = AlertDescription 86  -- RFC7507
pattern UserCanceled                 :: AlertDescription
pattern $mUserCanceled :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUserCanceled :: AlertDescription
UserCanceled                  = AlertDescription 90
pattern NoRenegotiation              :: AlertDescription
pattern $mNoRenegotiation :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoRenegotiation :: AlertDescription
NoRenegotiation               = AlertDescription 100
pattern MissingExtension             :: AlertDescription
pattern $mMissingExtension :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bMissingExtension :: AlertDescription
MissingExtension              = AlertDescription 109
pattern UnsupportedExtension         :: AlertDescription
pattern $mUnsupportedExtension :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnsupportedExtension :: AlertDescription
UnsupportedExtension          = AlertDescription 110
pattern CertificateUnobtainable      :: AlertDescription
pattern $mCertificateUnobtainable :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateUnobtainable :: AlertDescription
CertificateUnobtainable       = AlertDescription 111
pattern UnrecognizedName             :: AlertDescription
pattern $mUnrecognizedName :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnrecognizedName :: AlertDescription
UnrecognizedName              = AlertDescription 112
pattern BadCertificateStatusResponse :: AlertDescription
pattern $mBadCertificateStatusResponse :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadCertificateStatusResponse :: AlertDescription
BadCertificateStatusResponse  = AlertDescription 113
pattern BadCertificateHashValue      :: AlertDescription
pattern $mBadCertificateHashValue :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadCertificateHashValue :: AlertDescription
BadCertificateHashValue       = AlertDescription 114
pattern UnknownPskIdentity           :: AlertDescription
pattern $mUnknownPskIdentity :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnknownPskIdentity :: AlertDescription
UnknownPskIdentity            = AlertDescription 115
pattern CertificateRequired          :: AlertDescription
pattern $mCertificateRequired :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateRequired :: AlertDescription
CertificateRequired           = AlertDescription 116
pattern GeneralError                 :: AlertDescription
pattern $mGeneralError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bGeneralError :: AlertDescription
GeneralError                  = AlertDescription 117
pattern NoApplicationProtocol        :: AlertDescription
pattern $mNoApplicationProtocol :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoApplicationProtocol :: AlertDescription
NoApplicationProtocol         = AlertDescription 120 -- RFC7301

instance Show AlertDescription where
    show :: AlertDescription -> String
show AlertDescription
CloseNotify                  = String
"CloseNotify"
    show AlertDescription
UnexpectedMessage            = String
"UnexpectedMessage"
    show AlertDescription
BadRecordMac                 = String
"BadRecordMac"
    show AlertDescription
DecryptionFailed             = String
"DecryptionFailed"
    show AlertDescription
RecordOverflow               = String
"RecordOverflow"
    show AlertDescription
DecompressionFailure         = String
"DecompressionFailure"
    show AlertDescription
HandshakeFailure             = String
"HandshakeFailure"
    show AlertDescription
BadCertificate               = String
"BadCertificate"
    show AlertDescription
UnsupportedCertificate       = String
"UnsupportedCertificate"
    show AlertDescription
CertificateRevoked           = String
"CertificateRevoked"
    show AlertDescription
CertificateExpired           = String
"CertificateExpired"
    show AlertDescription
CertificateUnknown           = String
"CertificateUnknown"
    show AlertDescription
IllegalParameter             = String
"IllegalParameter"
    show AlertDescription
UnknownCa                    = String
"UnknownCa"
    show AlertDescription
AccessDenied                 = String
"AccessDenied"
    show AlertDescription
DecodeError                  = String
"DecodeError"
    show AlertDescription
DecryptError                 = String
"DecryptError"
    show AlertDescription
ExportRestriction            = String
"ExportRestriction"
    show AlertDescription
ProtocolVersion              = String
"ProtocolVersion"
    show AlertDescription
InsufficientSecurity         = String
"InsufficientSecurity"
    show AlertDescription
InternalError                = String
"InternalError"
    show AlertDescription
InappropriateFallback        = String
"InappropriateFallback"
    show AlertDescription
UserCanceled                 = String
"UserCanceled"
    show AlertDescription
NoRenegotiation              = String
"NoRenegotiation"
    show AlertDescription
MissingExtension             = String
"MissingExtension"
    show AlertDescription
UnsupportedExtension         = String
"UnsupportedExtension"
    show AlertDescription
CertificateUnobtainable      = String
"CertificateUnobtainable"
    show AlertDescription
UnrecognizedName             = String
"UnrecognizedName"
    show AlertDescription
BadCertificateStatusResponse = String
"BadCertificateStatusResponse"
    show AlertDescription
BadCertificateHashValue      = String
"BadCertificateHashValue"
    show AlertDescription
UnknownPskIdentity           = String
"UnknownPskIdentity"
    show AlertDescription
CertificateRequired          = String
"CertificateRequired"
    show AlertDescription
GeneralError                 = String
"GeneralError"
    show AlertDescription
NoApplicationProtocol        = String
"NoApplicationProtocol"
    show (AlertDescription Word8
x)         = String
"AlertDescription " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}