{-# 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 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
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
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
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
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
(Int -> Reliability -> ShowS)
-> (Reliability -> String)
-> ([Reliability] -> ShowS)
-> Show Reliability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reliability -> ShowS
showsPrec :: Int -> Reliability -> ShowS
$cshow :: Reliability -> String
show :: Reliability -> String
$cshowList :: [Reliability] -> ShowS
showList :: [Reliability] -> ShowS
Show, Reliability -> Reliability -> Bool
(Reliability -> Reliability -> Bool)
-> (Reliability -> Reliability -> Bool) -> Eq Reliability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reliability -> Reliability -> Bool
== :: Reliability -> Reliability -> Bool
$c/= :: Reliability -> Reliability -> Bool
/= :: Reliability -> Reliability -> Bool
Eq, Typeable, (forall x. Reliability -> Rep Reliability x)
-> (forall x. Rep Reliability x -> Reliability)
-> Generic Reliability
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
$cfrom :: forall x. Reliability -> Rep Reliability x
from :: forall x. Reliability -> Rep Reliability x
$cto :: forall x. Rep Reliability x -> Reliability
to :: forall x. Rep Reliability x -> Reliability
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
(EndPointAddress -> EndPointAddress -> Bool)
-> (EndPointAddress -> EndPointAddress -> Bool)
-> Eq EndPointAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndPointAddress -> EndPointAddress -> Bool
== :: EndPointAddress -> EndPointAddress -> Bool
$c/= :: EndPointAddress -> EndPointAddress -> Bool
/= :: EndPointAddress -> EndPointAddress -> Bool
Eq, Eq EndPointAddress
Eq EndPointAddress =>
(EndPointAddress -> EndPointAddress -> Ordering)
-> (EndPointAddress -> EndPointAddress -> Bool)
-> (EndPointAddress -> EndPointAddress -> Bool)
-> (EndPointAddress -> EndPointAddress -> Bool)
-> (EndPointAddress -> EndPointAddress -> Bool)
-> (EndPointAddress -> EndPointAddress -> EndPointAddress)
-> (EndPointAddress -> EndPointAddress -> EndPointAddress)
-> Ord 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
$ccompare :: EndPointAddress -> EndPointAddress -> Ordering
compare :: EndPointAddress -> EndPointAddress -> Ordering
$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
>= :: EndPointAddress -> EndPointAddress -> Bool
$cmax :: EndPointAddress -> EndPointAddress -> EndPointAddress
max :: EndPointAddress -> EndPointAddress -> EndPointAddress
$cmin :: EndPointAddress -> EndPointAddress -> EndPointAddress
min :: EndPointAddress -> EndPointAddress -> EndPointAddress
Ord, Typeable, Typeable EndPointAddress
Typeable EndPointAddress =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EndPointAddress -> c EndPointAddress)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EndPointAddress)
-> (EndPointAddress -> Constr)
-> (EndPointAddress -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> EndPointAddress -> EndPointAddress)
-> (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 u.
    (forall d. Data d => d -> u) -> EndPointAddress -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EndPointAddress -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EndPointAddress -> m EndPointAddress)
-> Data EndPointAddress
EndPointAddress -> Constr
EndPointAddress -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EndPointAddress -> c EndPointAddress
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EndPointAddress -> c EndPointAddress
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EndPointAddress
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EndPointAddress
$ctoConstr :: EndPointAddress -> Constr
toConstr :: EndPointAddress -> Constr
$cdataTypeOf :: EndPointAddress -> DataType
dataTypeOf :: EndPointAddress -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EndPointAddress)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EndPointAddress)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EndPointAddress)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EndPointAddress)
$cgmapT :: (forall b. Data b => b -> b) -> EndPointAddress -> EndPointAddress
gmapT :: (forall b. Data b => b -> b) -> EndPointAddress -> EndPointAddress
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EndPointAddress -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EndPointAddress -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EndPointAddress -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EndPointAddress -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EndPointAddress -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EndPointAddress -> m EndPointAddress
Data, Eq EndPointAddress
Eq EndPointAddress =>
(Int -> EndPointAddress -> Int)
-> (EndPointAddress -> Int) -> Hashable EndPointAddress
Int -> EndPointAddress -> Int
EndPointAddress -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EndPointAddress -> Int
hashWithSalt :: Int -> EndPointAddress -> Int
$chash :: EndPointAddress -> Int
hash :: EndPointAddress -> Int
Hashable)

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

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

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

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

instance Binary MulticastAddress

instance Show MulticastAddress where
  show :: MulticastAddress -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (MulticastAddress -> ByteString) -> MulticastAddress -> String
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 = Maybe Int
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
[TransportError error] -> ShowS
TransportError error -> String
(Int -> TransportError error -> ShowS)
-> (TransportError error -> String)
-> ([TransportError error] -> ShowS)
-> Show (TransportError error)
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
$cshowsPrec :: forall error. Show error => Int -> TransportError error -> ShowS
showsPrec :: Int -> TransportError error -> ShowS
$cshow :: forall error. Show error => TransportError error -> String
show :: TransportError error -> String
$cshowList :: forall error. Show error => [TransportError error] -> ShowS
showList :: [TransportError error] -> ShowS
Show, Typeable, (forall x. TransportError error -> Rep (TransportError error) x)
-> (forall x. Rep (TransportError error) x -> TransportError error)
-> Generic (TransportError error)
forall x. Rep (TransportError error) x -> TransportError error
forall x. TransportError error -> Rep (TransportError error) x
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
$cfrom :: forall error x.
TransportError error -> Rep (TransportError error) x
from :: forall x. TransportError error -> Rep (TransportError error) x
$cto :: forall error x.
Rep (TransportError error) x -> TransportError error
to :: forall x. Rep (TransportError error) x -> TransportError error
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 error -> error -> Bool
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
(Int -> NewEndPointErrorCode -> ShowS)
-> (NewEndPointErrorCode -> String)
-> ([NewEndPointErrorCode] -> ShowS)
-> Show NewEndPointErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewEndPointErrorCode -> ShowS
showsPrec :: Int -> NewEndPointErrorCode -> ShowS
$cshow :: NewEndPointErrorCode -> String
show :: NewEndPointErrorCode -> String
$cshowList :: [NewEndPointErrorCode] -> ShowS
showList :: [NewEndPointErrorCode] -> ShowS
Show, Typeable, NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
(NewEndPointErrorCode -> NewEndPointErrorCode -> Bool)
-> (NewEndPointErrorCode -> NewEndPointErrorCode -> Bool)
-> Eq NewEndPointErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
== :: NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
$c/= :: NewEndPointErrorCode -> NewEndPointErrorCode -> Bool
/= :: 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
(Int -> ConnectErrorCode -> ShowS)
-> (ConnectErrorCode -> String)
-> ([ConnectErrorCode] -> ShowS)
-> Show ConnectErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectErrorCode -> ShowS
showsPrec :: Int -> ConnectErrorCode -> ShowS
$cshow :: ConnectErrorCode -> String
show :: ConnectErrorCode -> String
$cshowList :: [ConnectErrorCode] -> ShowS
showList :: [ConnectErrorCode] -> ShowS
Show, Typeable, ConnectErrorCode -> ConnectErrorCode -> Bool
(ConnectErrorCode -> ConnectErrorCode -> Bool)
-> (ConnectErrorCode -> ConnectErrorCode -> Bool)
-> Eq ConnectErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectErrorCode -> ConnectErrorCode -> Bool
== :: ConnectErrorCode -> ConnectErrorCode -> Bool
$c/= :: ConnectErrorCode -> ConnectErrorCode -> Bool
/= :: 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
(Int -> NewMulticastGroupErrorCode -> ShowS)
-> (NewMulticastGroupErrorCode -> String)
-> ([NewMulticastGroupErrorCode] -> ShowS)
-> Show NewMulticastGroupErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewMulticastGroupErrorCode -> ShowS
showsPrec :: Int -> NewMulticastGroupErrorCode -> ShowS
$cshow :: NewMulticastGroupErrorCode -> String
show :: NewMulticastGroupErrorCode -> String
$cshowList :: [NewMulticastGroupErrorCode] -> ShowS
showList :: [NewMulticastGroupErrorCode] -> ShowS
Show, Typeable, NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
(NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool)
-> (NewMulticastGroupErrorCode
    -> NewMulticastGroupErrorCode -> Bool)
-> Eq NewMulticastGroupErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
== :: NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
$c/= :: NewMulticastGroupErrorCode -> NewMulticastGroupErrorCode -> Bool
/= :: 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
(Int -> ResolveMulticastGroupErrorCode -> ShowS)
-> (ResolveMulticastGroupErrorCode -> String)
-> ([ResolveMulticastGroupErrorCode] -> ShowS)
-> Show ResolveMulticastGroupErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolveMulticastGroupErrorCode -> ShowS
showsPrec :: Int -> ResolveMulticastGroupErrorCode -> ShowS
$cshow :: ResolveMulticastGroupErrorCode -> String
show :: ResolveMulticastGroupErrorCode -> String
$cshowList :: [ResolveMulticastGroupErrorCode] -> ShowS
showList :: [ResolveMulticastGroupErrorCode] -> ShowS
Show, Typeable, ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
(ResolveMulticastGroupErrorCode
 -> ResolveMulticastGroupErrorCode -> Bool)
-> (ResolveMulticastGroupErrorCode
    -> ResolveMulticastGroupErrorCode -> Bool)
-> Eq ResolveMulticastGroupErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
== :: ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
$c/= :: ResolveMulticastGroupErrorCode
-> ResolveMulticastGroupErrorCode -> Bool
/= :: 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
(Int -> SendErrorCode -> ShowS)
-> (SendErrorCode -> String)
-> ([SendErrorCode] -> ShowS)
-> Show SendErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SendErrorCode -> ShowS
showsPrec :: Int -> SendErrorCode -> ShowS
$cshow :: SendErrorCode -> String
show :: SendErrorCode -> String
$cshowList :: [SendErrorCode] -> ShowS
showList :: [SendErrorCode] -> ShowS
Show, Typeable, SendErrorCode -> SendErrorCode -> Bool
(SendErrorCode -> SendErrorCode -> Bool)
-> (SendErrorCode -> SendErrorCode -> Bool) -> Eq SendErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SendErrorCode -> SendErrorCode -> Bool
== :: SendErrorCode -> SendErrorCode -> Bool
$c/= :: SendErrorCode -> SendErrorCode -> Bool
/= :: 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
(Int -> EventErrorCode -> ShowS)
-> (EventErrorCode -> String)
-> ([EventErrorCode] -> ShowS)
-> Show EventErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventErrorCode -> ShowS
showsPrec :: Int -> EventErrorCode -> ShowS
$cshow :: EventErrorCode -> String
show :: EventErrorCode -> String
$cshowList :: [EventErrorCode] -> ShowS
showList :: [EventErrorCode] -> ShowS
Show, Typeable, EventErrorCode -> EventErrorCode -> Bool
(EventErrorCode -> EventErrorCode -> Bool)
-> (EventErrorCode -> EventErrorCode -> Bool) -> Eq EventErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventErrorCode -> EventErrorCode -> Bool
== :: EventErrorCode -> EventErrorCode -> Bool
$c/= :: EventErrorCode -> EventErrorCode -> Bool
/= :: EventErrorCode -> EventErrorCode -> Bool
Eq, (forall x. EventErrorCode -> Rep EventErrorCode x)
-> (forall x. Rep EventErrorCode x -> EventErrorCode)
-> Generic EventErrorCode
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
$cfrom :: forall x. EventErrorCode -> Rep EventErrorCode x
from :: forall x. EventErrorCode -> Rep EventErrorCode x
$cto :: forall x. Rep EventErrorCode x -> EventErrorCode
to :: forall x. Rep EventErrorCode x -> EventErrorCode
Generic)

instance Binary EventErrorCode