module Client.EventLoop.Errors
( exceptionToLines
) where
import Control.Exception
import Data.List.NonEmpty (NonEmpty(..))
import Network.Connection
import Network.TLS
import Network.Socks5
exceptionToLines ::
SomeException ->
NonEmpty String
exceptionToLines
= indentMessages
. exceptionToLines'
indentMessages :: NonEmpty String -> NonEmpty String
indentMessages (x :| xs) = x :| map ("⋯ "++) xs
exceptionToLines' ::
SomeException ->
NonEmpty String
exceptionToLines' ex
| Just tls <- fromException ex = explainTLSException tls
| Just (HostNotResolved str) <- fromException ex =
("Host not resolved: " ++ str) :| []
| Just (HostCannotConnect str exs) <- fromException ex =
("Host cannot connect: " ++ str) :| map explainIOError exs
| Just LineTooLong <- fromException ex = "Server IRC message too long" :| []
| Just err <- fromException ex = explainSocksError err :| []
| Just ioe <- fromException ex =
explainIOError ioe :| []
| otherwise = displayException ex :| []
explainIOError :: IOError -> String
explainIOError ioe = "IO error: " ++ displayException ioe
explainTLSException :: TLSException -> NonEmpty String
explainTLSException ex =
case ex of
ConnectionNotEstablished ->
"Attempt to use connection out of order" :| []
Terminated _ _ tlsError ->
"Connection closed due to early-termination in TLS layer"
:| explainTLSError tlsError
HandshakeFailed (Error_Packet_Parsing str) ->
"Connection closed due to handshake failure in TLS layer" :|
[ "Packet parse error: " ++ str
, "Please verify you're using a TLS enabled port"
]
HandshakeFailed tlsError ->
"Connection closed due to handshake failure in TLS layer"
:| explainTLSError tlsError
explainTLSError :: TLSError -> [String]
explainTLSError ex =
case ex of
Error_Misc str -> ["Miscellaneous error: " ++ str]
Error_Protocol (str, _, _desc) -> ["Protocol error: " ++ str]
Error_Certificate str -> ["Certificate error: " ++ str]
Error_HandshakePolicy str -> ["Handshake policy: " ++ str]
Error_EOF -> ["Unexpected end of connection"]
Error_Packet str -> ["Packet error: " ++ str]
Error_Packet_unexpected msg expect -> ("Packet unexpected: " ++ msg)
: [ expect | not (null expect) ]
Error_Packet_Parsing str -> ["Packet parse error: " ++ str]
explainSocksError :: SocksError -> String
explainSocksError ex =
case ex of
SocksErrorGeneralServerFailure -> "SOCKS: General server failure"
SocksErrorConnectionNotAllowedByRule -> "SOCKS: Connection not allowed by rule"
SocksErrorNetworkUnreachable -> "SOCKS: Network unreachable"
SocksErrorHostUnreachable -> "SOCKS: Host unreachable"
SocksErrorConnectionRefused -> "SOCKS: Connection refused"
SocksErrorTTLExpired -> "SOCKS: TTL Expired"
SocksErrorCommandNotSupported -> "SOCKS: Command not supported"
SocksErrorAddrTypeNotSupported -> "SOCKS: Address type not supported"
SocksErrorOther n -> "SOCKS: Unknown error " ++ show n