module SocketsAndPipes.Serve.Exceptions
(
BindFailed (..), AddrTried (..),
displayBindFailed, displayAddrTried,
overException, firstSuccessOrAllExceptions
) where
import Control.Exception.Safe
( Exception (displayException), SomeException, catch, throw )
import Data.Foldable ( fold )
import qualified Data.Sequence as Seq
import qualified Data.Foldable as Seq ( toList )
import qualified Data.List as List
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified Network.Socket as Socket
data BindFailed =
BindFailed
{ BindFailed -> [AddrTried]
bindAddrsTried :: [AddrTried]
}
deriving Int -> BindFailed -> ShowS
[BindFailed] -> ShowS
BindFailed -> String
(Int -> BindFailed -> ShowS)
-> (BindFailed -> String)
-> ([BindFailed] -> ShowS)
-> Show BindFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindFailed] -> ShowS
$cshowList :: [BindFailed] -> ShowS
show :: BindFailed -> String
$cshow :: BindFailed -> String
showsPrec :: Int -> BindFailed -> ShowS
$cshowsPrec :: Int -> BindFailed -> ShowS
Show
instance Exception BindFailed
where
displayException :: BindFailed -> String
displayException = Text -> String
LT.unpack (Text -> String) -> (BindFailed -> Text) -> BindFailed -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (BindFailed -> Builder) -> BindFailed -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindFailed -> Builder
displayBindFailed
data AddrTried =
AddrTried
{ AddrTried -> AddrInfo
addrTried :: Socket.AddrInfo
, AddrTried -> SomeException
addrException :: SomeException
}
deriving Int -> AddrTried -> ShowS
[AddrTried] -> ShowS
AddrTried -> String
(Int -> AddrTried -> ShowS)
-> (AddrTried -> String)
-> ([AddrTried] -> ShowS)
-> Show AddrTried
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrTried] -> ShowS
$cshowList :: [AddrTried] -> ShowS
show :: AddrTried -> String
$cshow :: AddrTried -> String
showsPrec :: Int -> AddrTried -> ShowS
$cshowsPrec :: Int -> AddrTried -> ShowS
Show
instance Exception AddrTried
where
displayException :: AddrTried -> String
displayException = Text -> String
LT.unpack (Text -> String) -> (AddrTried -> Text) -> AddrTried -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (AddrTried -> Builder) -> AddrTried -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrTried -> Builder
displayAddrTried
displayBindFailed :: BindFailed -> TB.Builder
displayBindFailed :: BindFailed -> Builder
displayBindFailed BindFailed{ [AddrTried]
bindAddrsTried :: [AddrTried]
bindAddrsTried :: BindFailed -> [AddrTried]
bindAddrsTried }
| [AddrTried] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AddrTried]
bindAddrsTried = Builder
displayBindFailedNoAddresses
| Bool
otherwise = [AddrTried] -> Builder
displayBindFailedWithAddrs [AddrTried]
bindAddrsTried
displayBindFailedNoAddresses :: TB.Builder
displayBindFailedNoAddresses :: Builder
displayBindFailedNoAddresses =
String -> Builder
TB.fromString
String
"Failed to set up a passive socket for the server \
\because no candidate addresses were found."
displayBindFailedWithAddrs :: [AddrTried] -> TB.Builder
displayBindFailedWithAddrs :: [AddrTried] -> Builder
displayBindFailedWithAddrs [AddrTried]
bindAddrsTried =
String -> Builder
TB.fromString String
"Failed to set up a passive socket for the server. \
\The following addresses were tried:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
[Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
(
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse
(String -> Builder
TB.fromString String
"\n")
(
(AddrTried -> Builder) -> [AddrTried] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
List.map
( \AddrTried{ AddrInfo
addrTried :: AddrInfo
addrTried :: AddrTried -> AddrInfo
addrTried, SomeException
addrException :: SomeException
addrException :: AddrTried -> SomeException
addrException } ->
String -> Builder
TB.fromString String
" ❌ " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Builder
TB.fromString (SockAddr -> String
forall a. Show a => a -> String
show (AddrInfo -> SockAddr
Socket.addrAddress AddrInfo
addrTried)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Builder
TB.fromString String
" — " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Builder
TB.fromString (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
addrException)
)
[AddrTried]
bindAddrsTried
)
)
displayAddrTried :: AddrTried -> TB.Builder
displayAddrTried :: AddrTried -> Builder
displayAddrTried AddrTried{ AddrInfo
addrTried :: AddrInfo
addrTried :: AddrTried -> AddrInfo
addrTried, SomeException
addrException :: SomeException
addrException :: AddrTried -> SomeException
addrException } =
String -> Builder
TB.fromString (AddrInfo -> String
forall a. Show a => a -> String
show AddrInfo
addrTried) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString String
": "
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
addrException)
overException :: (Exception e1, Exception e2) =>
(e1 -> e2)
-> IO a
-> IO a
overException :: (e1 -> e2) -> IO a -> IO a
overException e1 -> e2
f IO a
a = IO a -> (e1 -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch IO a
a (e2 -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (e2 -> IO a) -> (e1 -> e2) -> e1 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f)
firstSuccessOrAllExceptions :: (Exception e1, Exception e2) =>
([e1] -> e2)
-> [IO a]
-> IO a
firstSuccessOrAllExceptions :: ([e1] -> e2) -> [IO a] -> IO a
firstSuccessOrAllExceptions [e1] -> e2
f = Seq e1 -> [IO a] -> IO a
forall (m :: * -> *) a. MonadCatch m => Seq e1 -> [m a] -> m a
go Seq e1
forall a. Seq a
Seq.empty
where
go :: Seq e1 -> [m a] -> m a
go Seq e1
exs [] = e2 -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw ([e1] -> e2
f (Seq e1 -> [e1]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Seq.toList Seq e1
exs))
go Seq e1
exs (m a
a : [m a]
as) = m a -> (e1 -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a (\e1
ex -> Seq e1 -> [m a] -> m a
go (Seq e1
exs Seq e1 -> e1 -> Seq e1
forall a. Seq a -> a -> Seq a
Seq.|> e1
ex) [m a]
as)