{-# LANGUAGE DeriveGeneric #-}
-- | Network Transport
module Network.Transport
  ( -- * Types
    Transport(..)
  , EndPoint(..)
  , Connection(..)
  , Event(..)
  , ConnectionId
  , Reliability(..)
  , MulticastGroup(..)
  , EndPointAddress(..)
  , MulticastAddress(..)
    -- * Hints
  , ConnectHints(..)
  , defaultConnectHints
    -- * Error codes
  , TransportError(..)
  , NewEndPointErrorCode(..)
  , ConnectErrorCode(..)
  , NewMulticastGroupErrorCode(..)
  , ResolveMulticastGroupErrorCode(..)
  , SendErrorCode(..)
  , EventErrorCode(..)
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (copy)
import qualified Data.ByteString.Char8 as BSC (unpack)
import Control.DeepSeq (NFData(rnf))
import Control.Exception (Exception)
import Control.Applicative ((<$>))
import Data.Typeable (Typeable)
import Data.Binary (Binary(..))
import Data.Hashable
import Data.Word (Word64)
import Data.Data (Data)
import GHC.Generics (Generic)

--------------------------------------------------------------------------------
-- Main API                                                                   --
--------------------------------------------------------------------------------

-- | To create a network abstraction layer, use one of the
-- @Network.Transport.*@ packages.
data Transport = Transport {
    -- | Create a new end point (heavyweight operation)
    Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint :: IO (Either (TransportError NewEndPointErrorCode) EndPoint)
    -- | Shutdown the transport completely
  , Transport -> IO ()
closeTransport :: IO ()
  }

-- | Network endpoint.
data EndPoint = EndPoint {
    -- | Endpoints have a single shared receive queue.
    EndPoint -> IO Event
receive :: IO Event
    -- | EndPointAddress of the endpoint.
  , EndPoint -> EndPointAddress
address :: EndPointAddress
    -- | Create a new lightweight connection.
    --
    -- 'connect' should be as asynchronous as possible; for instance, in
    -- Transport implementations based on some heavy-weight underlying network
    -- protocol (TCP, ssh), a call to 'connect' should be asynchronous when a
    -- heavyweight connection has already been established.
  , EndPoint
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect :: EndPointAddress -> Reliability -> ConnectHints -> IO (Either (TransportError ConnectErrorCode) Connection)
    -- | Create a new multicast group.
  , EndPoint
-> IO
     (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)
newMulticastGroup :: IO (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)
    -- | Resolve an address to a multicast group.
  , EndPoint
-> MulticastAddress
-> IO
     (Either
        (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)
resolveMulticastGroup :: MulticastAddress -> IO (Either (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)
    -- | Close the endpoint
  , EndPoint -> IO ()
closeEndPoint :: IO ()
  }

-- | Lightweight connection to an endpoint.
data Connection = Connection {
    -- | Send a message on this connection.
    --
    -- 'send' provides vectored I/O, and allows multiple data segments to be
    -- sent using a single call (cf. 'Network.Socket.ByteString.sendMany').
    -- Note that this segment structure is entirely unrelated to the segment
    -- structure /returned/ by a 'Received' event.
    Connection
-> [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send :: [ByteString] -> IO (Either (TransportError SendErrorCode) ())
    -- | Close the connection.
  , Connection -> IO ()
close :: IO ()
  }

-- | Event on an endpoint.
data Event =
    -- | Received a message
    Received {-# UNPACK #-} !ConnectionId [ByteString]
    -- | Connection closed
  | ConnectionClosed {-# UNPACK #-} !ConnectionId
    -- | Connection opened
    --
    -- 'ConnectionId's need not be allocated contiguously.
  | ConnectionOpened {-# UNPACK #-} !ConnectionId Reliability EndPointAddress
    -- | Received multicast
  | ReceivedMulticast MulticastAddress [ByteString]
    -- | The endpoint got closed (manually, by a call to closeEndPoint or closeTransport)
  | EndPointClosed
    -- | An error occurred
  | ErrorEvent (TransportError EventErrorCode)
  deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic)

instance Binary Event

-- | Connection data ConnectHintsIDs enable receivers to distinguish one connection from another.
type ConnectionId = Word64

-- | Reliability guarantees of a connection.
data Reliability =
    ReliableOrdered
  | ReliableUnordered
  | Unreliable
  deriving (Int -> Reliability -> ShowS
[Reliability] -> ShowS
Reliability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reliability] -> ShowS
$cshowList :: [Reliability] -> ShowS
show :: Reliability -> String
$cshow :: Reliability -> String
showsPrec :: Int -> Reliability -> ShowS
$cshowsPrec :: Int -> Reliability -> ShowS
Show, Reliability -> Reliability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reliability -> Reliability -> Bool
$c/= :: Reliability -> Reliability -> Bool
== :: Reliability -> Reliability -> Bool
$c== :: Reliability -> Reliability -> Bool
Eq, Typeable, forall x. Rep Reliability x -> Reliability
forall x. Reliability -> Rep Reliability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Reliability x -> Reliability
$cfrom :: forall x. Reliability -> Rep Reliability x
Generic)

instance Binary Reliability
-- | Multicast group.
data MulticastGroup = MulticastGroup {
    -- | EndPointAddress of the multicast group.
    MulticastGroup -> MulticastAddress
multicastAddress     :: MulticastAddress
    -- | Delete the multicast group completely.
  , MulticastGroup -> IO ()
deleteMulticastGroup :: IO ()
    -- | Maximum message size that we can send to this group.
  , MulticastGroup -> Maybe Int
maxMsgSize           :: Maybe Int
    -- | Send a message to the group.
  , MulticastGroup -> [ByteString] -> IO ()
multicastSend        :: [ByteString] -> IO ()
    -- | Subscribe to the given multicast group (to start receiving messages from the group).
  , MulticastGroup -> IO ()
multicastSubscribe   :: IO ()
    -- | Unsubscribe from the given multicast group (to stop receiving messages from the group).
  , MulticastGroup -> IO ()
multicastUnsubscribe :: IO ()
    -- | Close the group (that is, indicate you no longer wish to send to the group).
  , MulticastGroup -> IO ()
multicastClose       :: IO ()
  }

-- | EndPointAddress of an endpoint.
newtype EndPointAddress = EndPointAddress { EndPointAddress -> ByteString
endPointAddressToByteString :: ByteString }
  deriving (EndPointAddress -> EndPointAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndPointAddress -> EndPointAddress -> Bool
$c/= :: EndPointAddress -> EndPointAddress -> Bool
== :: EndPointAddress -> EndPointAddress -> Bool
$c== :: EndPointAddress -> EndPointAddress -> Bool
Eq, Eq EndPointAddress
EndPointAddress -> EndPointAddress -> Bool
EndPointAddress -> EndPointAddress -> Ordering
EndPointAddress -> EndPointAddress -> EndPointAddress
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EndPointAddress -> EndPointAddress -> EndPointAddress
$cmin :: EndPointAddress -> EndPointAddress -> EndPointAddress
max :: EndPointAddress -> EndPointAddress -> EndPointAddress
$cmax :: EndPointAddress -> EndPointAddress -> EndPointAddress
>= :: EndPointAddress -> EndPointAddress -> Bool
$c>= :: EndPointAddress -> EndPointAddress -> Bool
> :: EndPointAddress -> EndPointAddress -> Bool
$c> :: EndPointAddress -> EndPointAddress -> Bool
<= :: EndPointAddress -> EndPointAddress -> Bool
$c<= :: EndPointAddress -> EndPointAddress -> Bool
< :: EndPointAddress -> EndPointAddress -> Bool
$c< :: EndPointAddress -> EndPointAddress -> Bool
compare :: EndPointAddress -> EndPointAddress -> Ordering
$ccompare :: EndPointAddress -> EndPointAddress -> Ordering
Ord, Typeable, Typeable EndPointAddress
EndPointAddress -> DataType
EndPointAddress -> Constr
(forall b. Data b => b -> b) -> EndPointAddress -> EndPointAddress
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> EndPointAddress -> u
forall u. (forall d. Data d => d -> u) -> EndPointAddress -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EndPointAddress
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EndPointAddress -> c EndPointAddress
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EndPointAddress)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EndPointAddress)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EndPointAddress -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EndPointAddress -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EndPointAddress -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EndPointAddress -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
gmapT :: (forall b. Data b => b -> b) -> EndPointAddress -> EndPointAddress
$cgmapT :: (forall b. Data b => b -> b) -> EndPointAddress -> EndPointAddress
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EndPointAddress)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EndPointAddress)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EndPointAddress)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EndPointAddress)
dataTypeOf :: EndPointAddress -> DataType
$cdataTypeOf :: EndPointAddress -> DataType
toConstr :: EndPointAddress -> Constr
$ctoConstr :: EndPointAddress -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EndPointAddress
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EndPointAddress
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EndPointAddress -> c EndPointAddress
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EndPointAddress -> c EndPointAddress
Data, Eq EndPointAddress
Int -> EndPointAddress -> Int
EndPointAddress -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: EndPointAddress -> Int
$chash :: EndPointAddress -> Int
hashWithSalt :: Int -> EndPointAddress -> Int
$chashWithSalt :: Int -> EndPointAddress -> Int
Hashable)

instance Binary EndPointAddress where
  put :: EndPointAddress -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndPointAddress -> ByteString
endPointAddressToByteString
  get :: Get EndPointAddress
get = ByteString -> EndPointAddress
EndPointAddress forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.copy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

instance Show EndPointAddress where
  show :: EndPointAddress -> String
show = ByteString -> String
BSC.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndPointAddress -> ByteString
endPointAddressToByteString

instance NFData EndPointAddress where rnf :: EndPointAddress -> ()
rnf EndPointAddress
x = EndPointAddress
x seq :: forall a b. a -> b -> b
`seq` ()

-- | EndPointAddress of a multicast group.
newtype MulticastAddress = MulticastAddress { MulticastAddress -> ByteString
multicastAddressToByteString :: ByteString }
  deriving (MulticastAddress -> MulticastAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MulticastAddress -> MulticastAddress -> Bool
$c/= :: MulticastAddress -> MulticastAddress -> Bool
== :: MulticastAddress -> MulticastAddress -> Bool
$c== :: MulticastAddress -> MulticastAddress -> Bool
Eq, Eq MulticastAddress
MulticastAddress -> MulticastAddress -> Bool
MulticastAddress -> MulticastAddress -> Ordering
MulticastAddress -> MulticastAddress -> MulticastAddress
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MulticastAddress -> MulticastAddress -> MulticastAddress
$cmin :: MulticastAddress -> MulticastAddress -> MulticastAddress
max :: MulticastAddress -> MulticastAddress -> MulticastAddress
$cmax :: MulticastAddress -> MulticastAddress -> MulticastAddress
>= :: MulticastAddress -> MulticastAddress -> Bool
$c>= :: MulticastAddress -> MulticastAddress -> Bool
> :: MulticastAddress -> MulticastAddress -> Bool
$c> :: MulticastAddress -> MulticastAddress -> Bool
<= :: MulticastAddress -> MulticastAddress -> Bool
$c<= :: MulticastAddress -> MulticastAddress -> Bool
< :: MulticastAddress -> MulticastAddress -> Bool
$c< :: MulticastAddress -> MulticastAddress -> Bool
compare :: MulticastAddress -> MulticastAddress -> Ordering
$ccompare :: MulticastAddress -> MulticastAddress -> Ordering
Ord, forall x. Rep MulticastAddress x -> MulticastAddress
forall x. MulticastAddress -> Rep MulticastAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MulticastAddress x -> MulticastAddress
$cfrom :: forall x. MulticastAddress -> Rep MulticastAddress x
Generic)

instance Binary MulticastAddress

instance Show MulticastAddress where
  show :: MulticastAddress -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. MulticastAddress -> ByteString
multicastAddressToByteString

--------------------------------------------------------------------------------
-- Hints                                                                      --
--                                                                            --
-- Hints provide transport-generic "suggestions". For now, these are          --
-- placeholders only.                                                         --
--------------------------------------------------------------------------------

-- | Hints used by 'connect'
data ConnectHints = ConnectHints {
    -- Timeout
    ConnectHints -> Maybe Int
connectTimeout :: Maybe Int
  }

-- | Default hints for connecting
defaultConnectHints :: ConnectHints
defaultConnectHints :: ConnectHints
defaultConnectHints = ConnectHints {
    connectTimeout :: Maybe Int
connectTimeout = forall a. Maybe a
Nothing
  }

--------------------------------------------------------------------------------
-- Error codes                                                                --
--                                                                            --
-- Errors should be transport-implementation independent. The deciding factor --
-- for distinguishing one kind of error from another should be: might         --
-- application code have to take a different action depending on the kind of  --
-- error?                                                                     --
--------------------------------------------------------------------------------

-- | Errors returned by Network.Transport API functions consist of an error
-- code and a human readable description of the problem
data TransportError error = TransportError error String
  deriving (Int -> TransportError error -> ShowS
forall error. Show error => Int -> TransportError error -> ShowS
forall error. Show error => [TransportError error] -> ShowS
forall error. Show error => TransportError error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransportError error] -> ShowS
$cshowList :: forall error. Show error => [TransportError error] -> ShowS
show :: TransportError error -> String
$cshow :: forall error. Show error => TransportError error -> String
showsPrec :: Int -> TransportError error -> ShowS
$cshowsPrec :: forall error. Show error => Int -> TransportError error -> ShowS
Show, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall error x.
Rep (TransportError error) x -> TransportError error
forall error x.
TransportError error -> Rep (TransportError error) x
$cto :: forall error x.
Rep (TransportError error) x -> TransportError error
$cfrom :: forall error x.
TransportError error -> Rep (TransportError error) x
Generic)

instance (Binary error) => Binary (TransportError error)

-- | Although the functions in the transport API never throw TransportErrors
-- (but return them explicitly), application code may want to turn these into
-- exceptions.
instance (Typeable err, Show err) => Exception (TransportError err)

-- | When comparing errors we ignore the human-readable strings
instance Eq error => Eq (TransportError error) where
  TransportError error
err1 String
_ == :: TransportError error -> TransportError error -> Bool
== TransportError error
err2 String
_ = error
err1 forall a. Eq a => a -> a -> Bool
== error
err2

-- | Errors during the creation of an endpoint
data NewEndPointErrorCode =
    -- | Not enough resources
    NewEndPointInsufficientResources
    -- | Failed for some other reason
  | NewEndPointFailed
  deriving (Int -> NewEndPointErrorCode -> ShowS
[NewEndPointErrorCode] -> ShowS
NewEndPointErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewEndPointErrorCode] -> ShowS
$cshowList :: [NewEndPointErrorCode] -> ShowS
show :: NewEndPointErrorCode -> String
$cshow :: NewEndPointErrorCode -> String
showsPrec :: Int -> NewEndPointErrorCode -> ShowS
$cshowsPrec :: Int -> NewEndPointErrorCode -> ShowS
Show, Typeable, NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
$c/= :: NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
== :: NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
$c== :: NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
Eq)

-- | Connection failure
data ConnectErrorCode =
    -- | Could not resolve the address
    ConnectNotFound
    -- | Insufficient resources (for instance, no more sockets available)
  | ConnectInsufficientResources
    -- | Timeout
  | ConnectTimeout
    -- | Failed for other reasons (including syntax error)
  | ConnectFailed
  deriving (Int -> ConnectErrorCode -> ShowS
[ConnectErrorCode] -> ShowS
ConnectErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectErrorCode] -> ShowS
$cshowList :: [ConnectErrorCode] -> ShowS
show :: ConnectErrorCode -> String
$cshow :: ConnectErrorCode -> String
showsPrec :: Int -> ConnectErrorCode -> ShowS
$cshowsPrec :: Int -> ConnectErrorCode -> ShowS
Show, Typeable, ConnectErrorCode -> ConnectErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectErrorCode -> ConnectErrorCode -> Bool
$c/= :: ConnectErrorCode -> ConnectErrorCode -> Bool
== :: ConnectErrorCode -> ConnectErrorCode -> Bool
$c== :: ConnectErrorCode -> ConnectErrorCode -> Bool
Eq)

-- | Failure during the creation of a new multicast group
data NewMulticastGroupErrorCode =
    -- | Insufficient resources
    NewMulticastGroupInsufficientResources
    -- | Failed for some other reason
  | NewMulticastGroupFailed
    -- | Not all transport implementations support multicast
  | NewMulticastGroupUnsupported
  deriving (Int -> NewMulticastGroupErrorCode -> ShowS
[NewMulticastGroupErrorCode] -> ShowS
NewMulticastGroupErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewMulticastGroupErrorCode] -> ShowS
$cshowList :: [NewMulticastGroupErrorCode] -> ShowS
show :: NewMulticastGroupErrorCode -> String
$cshow :: NewMulticastGroupErrorCode -> String
showsPrec :: Int -> NewMulticastGroupErrorCode -> ShowS
$cshowsPrec :: Int -> NewMulticastGroupErrorCode -> ShowS
Show, Typeable, NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
$c/= :: NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
== :: NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
$c== :: NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
Eq)

-- | Failure during the resolution of a multicast group
data ResolveMulticastGroupErrorCode =
    -- | Multicast group not found
    ResolveMulticastGroupNotFound
    -- | Failed for some other reason (including syntax error)
  | ResolveMulticastGroupFailed
    -- | Not all transport implementations support multicast
  | ResolveMulticastGroupUnsupported
  deriving (Int -> ResolveMulticastGroupErrorCode -> ShowS
[ResolveMulticastGroupErrorCode] -> ShowS
ResolveMulticastGroupErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolveMulticastGroupErrorCode] -> ShowS
$cshowList :: [ResolveMulticastGroupErrorCode] -> ShowS
show :: ResolveMulticastGroupErrorCode -> String
$cshow :: ResolveMulticastGroupErrorCode -> String
showsPrec :: Int -> ResolveMulticastGroupErrorCode -> ShowS
$cshowsPrec :: Int -> ResolveMulticastGroupErrorCode -> ShowS
Show, Typeable, ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
$c/= :: ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
== :: ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
$c== :: ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
Eq)

-- | Failure during sending a message
data SendErrorCode =
    -- | Connection was closed
    SendClosed
    -- | Send failed for some other reason
  | SendFailed
  deriving (Int -> SendErrorCode -> ShowS
[SendErrorCode] -> ShowS
SendErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendErrorCode] -> ShowS
$cshowList :: [SendErrorCode] -> ShowS
show :: SendErrorCode -> String
$cshow :: SendErrorCode -> String
showsPrec :: Int -> SendErrorCode -> ShowS
$cshowsPrec :: Int -> SendErrorCode -> ShowS
Show, Typeable, SendErrorCode -> SendErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendErrorCode -> SendErrorCode -> Bool
$c/= :: SendErrorCode -> SendErrorCode -> Bool
== :: SendErrorCode -> SendErrorCode -> Bool
$c== :: SendErrorCode -> SendErrorCode -> Bool
Eq)

-- | Error codes used when reporting errors to endpoints (through receive)
data EventErrorCode =
    -- | Failure of the entire endpoint
    EventEndPointFailed
    -- | Transport-wide fatal error
  | EventTransportFailed
    -- | We lost connection to another endpoint
    --
    -- Although "Network.Transport" provides multiple independent lightweight
    -- connections between endpoints, those connections cannot /fail/
    -- independently: once one connection has failed, /all/ connections, in
    -- both directions, must now be considered to have failed; they fail as a
    -- "bundle" of connections, with only a single "bundle" of connections per
    -- endpoint at any point in time.
    --
    -- That is, suppose there are multiple connections in either direction
    -- between endpoints A and B, and A receives a notification that it has
    -- lost contact with B. Then A must not be able to send any further
    -- messages to B on existing connections.
    --
    -- Although B may not realize /immediately/ that its connection to A has
    -- been broken, messages sent by B on existing connections should not be
    -- delivered, and B must eventually get an EventConnectionLost message,
    -- too.
    --
    -- Moreover, this event must be posted before A has successfully
    -- reconnected (in other words, if B notices a reconnection attempt from A,
    -- it must post the EventConnectionLost before acknowledging the connection
    -- from A) so that B will not receive events about new connections or
    -- incoming messages from A without realizing that it got disconnected.
    --
    -- If B attempts to establish another connection to A before it realized
    -- that it got disconnected from A then it's okay for this connection
    -- attempt to fail, and the EventConnectionLost to be posted at that point,
    -- or for the EventConnectionLost to be posted and for the new connection
    -- to be considered the first connection of the "new bundle".
  | EventConnectionLost EndPointAddress
  deriving (Int -> EventErrorCode -> ShowS
[EventErrorCode] -> ShowS
EventErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventErrorCode] -> ShowS
$cshowList :: [EventErrorCode] -> ShowS
show :: EventErrorCode -> String
$cshow :: EventErrorCode -> String
showsPrec :: Int -> EventErrorCode -> ShowS
$cshowsPrec :: Int -> EventErrorCode -> ShowS
Show, Typeable, EventErrorCode -> EventErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventErrorCode -> EventErrorCode -> Bool
$c/= :: EventErrorCode -> EventErrorCode -> Bool
== :: EventErrorCode -> EventErrorCode -> Bool
$c== :: EventErrorCode -> EventErrorCode -> Bool
Eq, forall x. Rep EventErrorCode x -> EventErrorCode
forall x. EventErrorCode -> Rep EventErrorCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventErrorCode x -> EventErrorCode
$cfrom :: forall x. EventErrorCode -> Rep EventErrorCode x
Generic)

instance Binary EventErrorCode