{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Asynchronous messaging interface to the Hydra Network, e.g to other Hydra nodes.
--
-- Concrete implementations are provided by submodules. Import those instead of
-- this one if interested in actually configuring and running a real network
-- layer.
--
-- Incoming and outgoing messages are modelled as 'Message' data type.
module Hydra.Network (
  module Hydra.Network,
  IP,
  PortNumber,
) where

import Hydra.Prelude hiding (show)

import Cardano.Ledger.Orphans ()
import Data.Aeson (FromJSONKeyFunction (FromJSONKeyTextParser), ToJSONKey (..))
import Data.Aeson.Types (FromJSONKey (..), toJSONKeyText)
import Data.IP (IP)
import Data.Text (pack, unpack)
import Data.Text qualified as T
import Hydra.CBOR.Orphans ()
import Hydra.Cardano.Api (Key (SigningKey))
import Hydra.Tx (Party)
import Hydra.Tx.Crypto (HydraKey)
import Hydra.Tx.Secret (Secret)
import Network.Socket (PortNumber)
import Text.Read (Read (readsPrec))
import Text.Show (Show (show))

-- * Hydra network interface

-- | Interface from the application to the network layer.
newtype Network m msg = Network
  { forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast :: msg -> m ()
  -- ^ Send a `msg` to the whole configured hydra network including ourselves.
  }

-- | Interface from network layer to the application.
-- XXX: Reliably delivering a message in the crash-recovery fault model is
-- tricky. According to "Introduction to Reliable and Secure Distributed
-- Programming" section "2.2.4 Crashes with recoveries" explains that storing to
-- stable storage and just pointing to stored events is a better way.
data NetworkCallback msg m = NetworkCallback
  { forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: msg -> m ()
  -- ^ The given `msg` was received from the network.
  , forall msg (m :: * -> *).
NetworkCallback msg m -> Connectivity -> m ()
onConnectivity :: Connectivity -> m ()
  -- ^ The given `Connectivity` event was observed by network.
  }

-- | A type tying both inbound and outbound messages sending in a single /Component/.
--
-- A `NetworkComponent` can have different inbound and outbound message types.
type NetworkComponent m inbound outbound a = NetworkCallback inbound m -> (Network m outbound -> m a) -> m a

-- * Types used by concrete implementations

data WhichEtcd = EmbeddedEtcd | SystemEtcd
  deriving stock (WhichEtcd -> WhichEtcd -> Bool
(WhichEtcd -> WhichEtcd -> Bool)
-> (WhichEtcd -> WhichEtcd -> Bool) -> Eq WhichEtcd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhichEtcd -> WhichEtcd -> Bool
== :: WhichEtcd -> WhichEtcd -> Bool
$c/= :: WhichEtcd -> WhichEtcd -> Bool
/= :: WhichEtcd -> WhichEtcd -> Bool
Eq, Int -> WhichEtcd -> ShowS
[WhichEtcd] -> ShowS
WhichEtcd -> String
(Int -> WhichEtcd -> ShowS)
-> (WhichEtcd -> String)
-> ([WhichEtcd] -> ShowS)
-> Show WhichEtcd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhichEtcd -> ShowS
showsPrec :: Int -> WhichEtcd -> ShowS
$cshow :: WhichEtcd -> String
show :: WhichEtcd -> String
$cshowList :: [WhichEtcd] -> ShowS
showList :: [WhichEtcd] -> ShowS
Show, (forall x. WhichEtcd -> Rep WhichEtcd x)
-> (forall x. Rep WhichEtcd x -> WhichEtcd) -> Generic WhichEtcd
forall x. Rep WhichEtcd x -> WhichEtcd
forall x. WhichEtcd -> Rep WhichEtcd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WhichEtcd -> Rep WhichEtcd x
from :: forall x. WhichEtcd -> Rep WhichEtcd x
$cto :: forall x. Rep WhichEtcd x -> WhichEtcd
to :: forall x. Rep WhichEtcd x -> WhichEtcd
Generic)
  deriving anyclass ([WhichEtcd] -> Value
[WhichEtcd] -> Encoding
WhichEtcd -> Bool
WhichEtcd -> Value
WhichEtcd -> Encoding
(WhichEtcd -> Value)
-> (WhichEtcd -> Encoding)
-> ([WhichEtcd] -> Value)
-> ([WhichEtcd] -> Encoding)
-> (WhichEtcd -> Bool)
-> ToJSON WhichEtcd
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: WhichEtcd -> Value
toJSON :: WhichEtcd -> Value
$ctoEncoding :: WhichEtcd -> Encoding
toEncoding :: WhichEtcd -> Encoding
$ctoJSONList :: [WhichEtcd] -> Value
toJSONList :: [WhichEtcd] -> Value
$ctoEncodingList :: [WhichEtcd] -> Encoding
toEncodingList :: [WhichEtcd] -> Encoding
$comitField :: WhichEtcd -> Bool
omitField :: WhichEtcd -> Bool
ToJSON, Maybe WhichEtcd
Value -> Parser [WhichEtcd]
Value -> Parser WhichEtcd
(Value -> Parser WhichEtcd)
-> (Value -> Parser [WhichEtcd])
-> Maybe WhichEtcd
-> FromJSON WhichEtcd
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser WhichEtcd
parseJSON :: Value -> Parser WhichEtcd
$cparseJSONList :: Value -> Parser [WhichEtcd]
parseJSONList :: Value -> Parser [WhichEtcd]
$comittedField :: Maybe WhichEtcd
omittedField :: Maybe WhichEtcd
FromJSON)

instance ToCBOR WhichEtcd where
  toCBOR :: WhichEtcd -> Encoding
toCBOR = WhichEtcd -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance FromCBOR WhichEtcd where
  fromCBOR :: forall s. Decoder s WhichEtcd
fromCBOR = Decoder s WhichEtcd
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR

-- | Configuration for a `Node` network layer.
data NetworkConfiguration = NetworkConfiguration
  { NetworkConfiguration -> String
persistenceDir :: FilePath
  -- ^ Persistence directory
  , NetworkConfiguration -> Secret (SigningKey HydraKey)
signingKey :: Secret (SigningKey HydraKey)
  -- ^ This node's signing key. This is used to sign messages sent to peers.
  , NetworkConfiguration -> [Party]
otherParties :: [Party]
  -- ^ The list of peers `Party` known to this node.
  , NetworkConfiguration -> Host
listen :: Host
  -- ^ Address to listen on for incoming connections.
  , NetworkConfiguration -> Host
advertise :: Host
  -- ^ Address to advertise to peers.
  , NetworkConfiguration -> [Host]
peers :: [Host]
  -- ^ Addresses and ports of remote peers.
  , NetworkConfiguration -> NodeId
nodeId :: NodeId
  -- ^ This node's id.
  , NetworkConfiguration -> WhichEtcd
whichEtcd :: WhichEtcd
  -- ^ Whether to use the system etcd (on the path) or the embedded one.
  }

-- ** IP (Orphans)

deriving anyclass instance ToJSON IP
deriving anyclass instance FromJSON IP

-- ** PortNumber (Orphans)

readPort :: MonadFail m => String -> m PortNumber
readPort :: forall (m :: * -> *). MonadFail m => String -> m PortNumber
readPort String
s =
  case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe String
s of
    Maybe Integer
Nothing -> String -> m PortNumber
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot read port"
    Just Integer
n
      | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
minPort Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxPort -> PortNumber -> m PortNumber
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PortNumber -> m PortNumber) -> PortNumber -> m PortNumber
forall a b. (a -> b) -> a -> b
$ Integer -> PortNumber
forall a. Num a => Integer -> a
fromInteger Integer
n
      | Bool
otherwise ->
          String -> m PortNumber
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m PortNumber) -> String -> m PortNumber
forall a b. (a -> b) -> a -> b
$
            String
"readPort: "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
n
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not within valid port range: ("
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
minPort
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
maxPort
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
 where
  maxPort :: Integer
maxPort = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
forall a. Bounded a => a
maxBound :: Word16)
  minPort :: Integer
minPort = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
forall a. Bounded a => a
minBound :: Word16)

instance ToJSON PortNumber where
  toJSON :: PortNumber -> Value
toJSON = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value)
-> (PortNumber -> Integer) -> PortNumber -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortNumber -> Integer
forall a. Integral a => a -> Integer
toInteger

instance FromJSON PortNumber where
  parseJSON :: Value -> Parser PortNumber
parseJSON = (Integer -> PortNumber) -> Parser Integer -> Parser PortNumber
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> PortNumber
forall a. Num a => Integer -> a
fromInteger (Parser Integer -> Parser PortNumber)
-> (Value -> Parser Integer) -> Value -> Parser PortNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON

-- ** NodeId

newtype NodeId = NodeId {NodeId -> Text
nodeId :: Text}
  deriving stock ((forall x. NodeId -> Rep NodeId x)
-> (forall x. Rep NodeId x -> NodeId) -> Generic NodeId
forall x. Rep NodeId x -> NodeId
forall x. NodeId -> Rep NodeId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeId -> Rep NodeId x
from :: forall x. NodeId -> Rep NodeId x
$cto :: forall x. Rep NodeId x -> NodeId
to :: forall x. Rep NodeId x -> NodeId
Generic)
  deriving newtype (NodeId -> NodeId -> Bool
(NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool) -> Eq NodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
/= :: NodeId -> NodeId -> Bool
Eq, Int -> NodeId -> ShowS
[NodeId] -> ShowS
NodeId -> String
(Int -> NodeId -> ShowS)
-> (NodeId -> String) -> ([NodeId] -> ShowS) -> Show NodeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeId -> ShowS
showsPrec :: Int -> NodeId -> ShowS
$cshow :: NodeId -> String
show :: NodeId -> String
$cshowList :: [NodeId] -> ShowS
showList :: [NodeId] -> ShowS
Show, String -> NodeId
(String -> NodeId) -> IsString NodeId
forall a. (String -> a) -> IsString a
$cfromString :: String -> NodeId
fromString :: String -> NodeId
IsString, ReadPrec [NodeId]
ReadPrec NodeId
Int -> ReadS NodeId
ReadS [NodeId]
(Int -> ReadS NodeId)
-> ReadS [NodeId]
-> ReadPrec NodeId
-> ReadPrec [NodeId]
-> Read NodeId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NodeId
readsPrec :: Int -> ReadS NodeId
$creadList :: ReadS [NodeId]
readList :: ReadS [NodeId]
$creadPrec :: ReadPrec NodeId
readPrec :: ReadPrec NodeId
$creadListPrec :: ReadPrec [NodeId]
readListPrec :: ReadPrec [NodeId]
Read, Eq NodeId
Eq NodeId =>
(NodeId -> NodeId -> Ordering)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> Ord NodeId
NodeId -> NodeId -> Bool
NodeId -> NodeId -> Ordering
NodeId -> NodeId -> NodeId
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 :: NodeId -> NodeId -> Ordering
compare :: NodeId -> NodeId -> Ordering
$c< :: NodeId -> NodeId -> Bool
< :: NodeId -> NodeId -> Bool
$c<= :: NodeId -> NodeId -> Bool
<= :: NodeId -> NodeId -> Bool
$c> :: NodeId -> NodeId -> Bool
> :: NodeId -> NodeId -> Bool
$c>= :: NodeId -> NodeId -> Bool
>= :: NodeId -> NodeId -> Bool
$cmax :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
min :: NodeId -> NodeId -> NodeId
Ord, [NodeId] -> Value
[NodeId] -> Encoding
NodeId -> Bool
NodeId -> Value
NodeId -> Encoding
(NodeId -> Value)
-> (NodeId -> Encoding)
-> ([NodeId] -> Value)
-> ([NodeId] -> Encoding)
-> (NodeId -> Bool)
-> ToJSON NodeId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NodeId -> Value
toJSON :: NodeId -> Value
$ctoEncoding :: NodeId -> Encoding
toEncoding :: NodeId -> Encoding
$ctoJSONList :: [NodeId] -> Value
toJSONList :: [NodeId] -> Value
$ctoEncodingList :: [NodeId] -> Encoding
toEncodingList :: [NodeId] -> Encoding
$comitField :: NodeId -> Bool
omitField :: NodeId -> Bool
ToJSON, Maybe NodeId
Value -> Parser [NodeId]
Value -> Parser NodeId
(Value -> Parser NodeId)
-> (Value -> Parser [NodeId]) -> Maybe NodeId -> FromJSON NodeId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser NodeId
parseJSON :: Value -> Parser NodeId
$cparseJSONList :: Value -> Parser [NodeId]
parseJSONList :: Value -> Parser [NodeId]
$comittedField :: Maybe NodeId
omittedField :: Maybe NodeId
FromJSON)

instance ToCBOR NodeId where
  toCBOR :: NodeId -> Encoding
toCBOR = NodeId -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance FromCBOR NodeId where
  fromCBOR :: forall s. Decoder s NodeId
fromCBOR = Decoder s NodeId
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR

-- ** Host

-- REVIEW(SN): This is also used in hydra-tui
data Host = Host
  { Host -> Text
hostname :: Text
  , Host -> PortNumber
port :: PortNumber
  }
  deriving stock (Eq Host
Eq Host =>
(Host -> Host -> Ordering)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Host)
-> (Host -> Host -> Host)
-> Ord Host
Host -> Host -> Bool
Host -> Host -> Ordering
Host -> Host -> Host
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 :: Host -> Host -> Ordering
compare :: Host -> Host -> Ordering
$c< :: Host -> Host -> Bool
< :: Host -> Host -> Bool
$c<= :: Host -> Host -> Bool
<= :: Host -> Host -> Bool
$c> :: Host -> Host -> Bool
> :: Host -> Host -> Bool
$c>= :: Host -> Host -> Bool
>= :: Host -> Host -> Bool
$cmax :: Host -> Host -> Host
max :: Host -> Host -> Host
$cmin :: Host -> Host -> Host
min :: Host -> Host -> Host
Ord, (forall x. Host -> Rep Host x)
-> (forall x. Rep Host x -> Host) -> Generic Host
forall x. Rep Host x -> Host
forall x. Host -> Rep Host x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Host -> Rep Host x
from :: forall x. Host -> Rep Host x
$cto :: forall x. Rep Host x -> Host
to :: forall x. Rep Host x -> Host
Generic, Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
/= :: Host -> Host -> Bool
Eq)
  deriving anyclass ([Host] -> Value
[Host] -> Encoding
Host -> Bool
Host -> Value
Host -> Encoding
(Host -> Value)
-> (Host -> Encoding)
-> ([Host] -> Value)
-> ([Host] -> Encoding)
-> (Host -> Bool)
-> ToJSON Host
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Host -> Value
toJSON :: Host -> Value
$ctoEncoding :: Host -> Encoding
toEncoding :: Host -> Encoding
$ctoJSONList :: [Host] -> Value
toJSONList :: [Host] -> Value
$ctoEncodingList :: [Host] -> Encoding
toEncodingList :: [Host] -> Encoding
$comitField :: Host -> Bool
omitField :: Host -> Bool
ToJSON, Maybe Host
Value -> Parser [Host]
Value -> Parser Host
(Value -> Parser Host)
-> (Value -> Parser [Host]) -> Maybe Host -> FromJSON Host
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Host
parseJSON :: Value -> Parser Host
$cparseJSONList :: Value -> Parser [Host]
parseJSONList :: Value -> Parser [Host]
$comittedField :: Maybe Host
omittedField :: Maybe Host
FromJSON)

instance ToCBOR Host where
  toCBOR :: Host -> Encoding
toCBOR = Host -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance FromCBOR Host where
  fromCBOR :: forall s. Decoder s Host
fromCBOR = Decoder s Host
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR

instance Show Host where
  show :: Host -> String
show = Host -> String
showHost

instance Read Host where
  readsPrec :: Int -> ReadS Host
readsPrec Int
_ String
s = case String -> Maybe Host
forall (m :: * -> *). MonadFail m => String -> m Host
readHost String
s of
    Just Host
h -> [(Host
h, String
"")]
    Maybe Host
Nothing -> []

instance ToJSONKey Host where
  toJSONKey :: ToJSONKeyFunction Host
toJSONKey = (Host -> Text) -> ToJSONKeyFunction Host
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
T.pack (String -> Text) -> (Host -> String) -> Host -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> String
forall a. Show a => a -> String
show)

instance FromJSONKey Host where
  fromJSONKey :: FromJSONKeyFunction Host
fromJSONKey = (Text -> Parser Host) -> FromJSONKeyFunction Host
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (String -> Parser Host
forall (m :: * -> *). MonadFail m => String -> m Host
readHost (String -> Parser Host) -> (Text -> String) -> Text -> Parser Host
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

showHost :: Host -> String
showHost :: Host -> String
showHost Host{Text
$sel:hostname:Host :: Host -> Text
hostname :: Text
hostname, PortNumber
$sel:port:Host :: Host -> PortNumber
port :: PortNumber
port} =
  Text -> String
unpack Text
hostname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PortNumber -> String
forall a. Show a => a -> String
show PortNumber
port

readHost :: MonadFail m => String -> m Host
readHost :: forall (m :: * -> *). MonadFail m => String -> m Host
readHost String
s =
  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (ShowS
forall a. [a] -> [a]
reverse String
s) of
    (String
p, Char
':' : String
h) -> Text -> PortNumber -> Host
Host (String -> Text
pack (ShowS
forall a. [a] -> [a]
reverse String
h)) (PortNumber -> Host) -> m PortNumber -> m Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m PortNumber
forall (m :: * -> *). MonadFail m => String -> m PortNumber
readPort (ShowS
forall a. [a] -> [a]
reverse String
p)
    (String, String)
_ -> String -> m Host
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Host) -> String -> m Host
forall a b. (a -> b) -> a -> b
$ String
"readHost: missing : in " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s

-- ** Connectivity & versions

data Connectivity
  = -- | Individual peer appeared alive on network.
    PeerConnected {Connectivity -> Host
peer :: Host}
  | -- | Individual peer disappeared from network (has not been seen active in a while).
    PeerDisconnected {peer :: Host}
  | -- | Connected to Hydra network.
    NetworkConnected
  | -- | Disconnected from Hydra network.
    NetworkDisconnected
  | VersionMismatch
      { Connectivity -> ProtocolVersion
ourVersion :: ProtocolVersion
      , Connectivity -> Maybe ProtocolVersion
theirVersion :: Maybe ProtocolVersion
      }
  | ClusterIDMismatch
      { Connectivity -> Text
clusterPeers :: Text
      }
  deriving stock ((forall x. Connectivity -> Rep Connectivity x)
-> (forall x. Rep Connectivity x -> Connectivity)
-> Generic Connectivity
forall x. Rep Connectivity x -> Connectivity
forall x. Connectivity -> Rep Connectivity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Connectivity -> Rep Connectivity x
from :: forall x. Connectivity -> Rep Connectivity x
$cto :: forall x. Rep Connectivity x -> Connectivity
to :: forall x. Rep Connectivity x -> Connectivity
Generic, Connectivity -> Connectivity -> Bool
(Connectivity -> Connectivity -> Bool)
-> (Connectivity -> Connectivity -> Bool) -> Eq Connectivity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Connectivity -> Connectivity -> Bool
== :: Connectivity -> Connectivity -> Bool
$c/= :: Connectivity -> Connectivity -> Bool
/= :: Connectivity -> Connectivity -> Bool
Eq, Int -> Connectivity -> ShowS
[Connectivity] -> ShowS
Connectivity -> String
(Int -> Connectivity -> ShowS)
-> (Connectivity -> String)
-> ([Connectivity] -> ShowS)
-> Show Connectivity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Connectivity -> ShowS
showsPrec :: Int -> Connectivity -> ShowS
$cshow :: Connectivity -> String
show :: Connectivity -> String
$cshowList :: [Connectivity] -> ShowS
showList :: [Connectivity] -> ShowS
Show)
  deriving anyclass ([Connectivity] -> Value
[Connectivity] -> Encoding
Connectivity -> Bool
Connectivity -> Value
Connectivity -> Encoding
(Connectivity -> Value)
-> (Connectivity -> Encoding)
-> ([Connectivity] -> Value)
-> ([Connectivity] -> Encoding)
-> (Connectivity -> Bool)
-> ToJSON Connectivity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Connectivity -> Value
toJSON :: Connectivity -> Value
$ctoEncoding :: Connectivity -> Encoding
toEncoding :: Connectivity -> Encoding
$ctoJSONList :: [Connectivity] -> Value
toJSONList :: [Connectivity] -> Value
$ctoEncodingList :: [Connectivity] -> Encoding
toEncodingList :: [Connectivity] -> Encoding
$comitField :: Connectivity -> Bool
omitField :: Connectivity -> Bool
ToJSON, Maybe Connectivity
Value -> Parser [Connectivity]
Value -> Parser Connectivity
(Value -> Parser Connectivity)
-> (Value -> Parser [Connectivity])
-> Maybe Connectivity
-> FromJSON Connectivity
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Connectivity
parseJSON :: Value -> Parser Connectivity
$cparseJSONList :: Value -> Parser [Connectivity]
parseJSONList :: Value -> Parser [Connectivity]
$comittedField :: Maybe Connectivity
omittedField :: Maybe Connectivity
FromJSON)

instance ToCBOR Connectivity where
  toCBOR :: Connectivity -> Encoding
toCBOR = Connectivity -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance FromCBOR Connectivity where
  fromCBOR :: forall s. Decoder s Connectivity
fromCBOR = Decoder s Connectivity
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR

newtype ProtocolVersion = ProtocolVersion Natural
  deriving stock (ProtocolVersion -> ProtocolVersion -> Bool
(ProtocolVersion -> ProtocolVersion -> Bool)
-> (ProtocolVersion -> ProtocolVersion -> Bool)
-> Eq ProtocolVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolVersion -> ProtocolVersion -> Bool
== :: ProtocolVersion -> ProtocolVersion -> Bool
$c/= :: ProtocolVersion -> ProtocolVersion -> Bool
/= :: ProtocolVersion -> ProtocolVersion -> Bool
Eq, Int -> ProtocolVersion -> ShowS
[ProtocolVersion] -> ShowS
ProtocolVersion -> String
(Int -> ProtocolVersion -> ShowS)
-> (ProtocolVersion -> String)
-> ([ProtocolVersion] -> ShowS)
-> Show ProtocolVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolVersion -> ShowS
showsPrec :: Int -> ProtocolVersion -> ShowS
$cshow :: ProtocolVersion -> String
show :: ProtocolVersion -> String
$cshowList :: [ProtocolVersion] -> ShowS
showList :: [ProtocolVersion] -> ShowS
Show, (forall x. ProtocolVersion -> Rep ProtocolVersion x)
-> (forall x. Rep ProtocolVersion x -> ProtocolVersion)
-> Generic ProtocolVersion
forall x. Rep ProtocolVersion x -> ProtocolVersion
forall x. ProtocolVersion -> Rep ProtocolVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProtocolVersion -> Rep ProtocolVersion x
from :: forall x. ProtocolVersion -> Rep ProtocolVersion x
$cto :: forall x. Rep ProtocolVersion x -> ProtocolVersion
to :: forall x. Rep ProtocolVersion x -> ProtocolVersion
Generic, Eq ProtocolVersion
Eq ProtocolVersion =>
(ProtocolVersion -> ProtocolVersion -> Ordering)
-> (ProtocolVersion -> ProtocolVersion -> Bool)
-> (ProtocolVersion -> ProtocolVersion -> Bool)
-> (ProtocolVersion -> ProtocolVersion -> Bool)
-> (ProtocolVersion -> ProtocolVersion -> Bool)
-> (ProtocolVersion -> ProtocolVersion -> ProtocolVersion)
-> (ProtocolVersion -> ProtocolVersion -> ProtocolVersion)
-> Ord ProtocolVersion
ProtocolVersion -> ProtocolVersion -> Bool
ProtocolVersion -> ProtocolVersion -> Ordering
ProtocolVersion -> ProtocolVersion -> ProtocolVersion
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 :: ProtocolVersion -> ProtocolVersion -> Ordering
compare :: ProtocolVersion -> ProtocolVersion -> Ordering
$c< :: ProtocolVersion -> ProtocolVersion -> Bool
< :: ProtocolVersion -> ProtocolVersion -> Bool
$c<= :: ProtocolVersion -> ProtocolVersion -> Bool
<= :: ProtocolVersion -> ProtocolVersion -> Bool
$c> :: ProtocolVersion -> ProtocolVersion -> Bool
> :: ProtocolVersion -> ProtocolVersion -> Bool
$c>= :: ProtocolVersion -> ProtocolVersion -> Bool
>= :: ProtocolVersion -> ProtocolVersion -> Bool
$cmax :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
max :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
$cmin :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
min :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
Ord)
  deriving anyclass ([ProtocolVersion] -> Value
[ProtocolVersion] -> Encoding
ProtocolVersion -> Bool
ProtocolVersion -> Value
ProtocolVersion -> Encoding
(ProtocolVersion -> Value)
-> (ProtocolVersion -> Encoding)
-> ([ProtocolVersion] -> Value)
-> ([ProtocolVersion] -> Encoding)
-> (ProtocolVersion -> Bool)
-> ToJSON ProtocolVersion
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ProtocolVersion -> Value
toJSON :: ProtocolVersion -> Value
$ctoEncoding :: ProtocolVersion -> Encoding
toEncoding :: ProtocolVersion -> Encoding
$ctoJSONList :: [ProtocolVersion] -> Value
toJSONList :: [ProtocolVersion] -> Value
$ctoEncodingList :: [ProtocolVersion] -> Encoding
toEncodingList :: [ProtocolVersion] -> Encoding
$comitField :: ProtocolVersion -> Bool
omitField :: ProtocolVersion -> Bool
ToJSON, Maybe ProtocolVersion
Value -> Parser [ProtocolVersion]
Value -> Parser ProtocolVersion
(Value -> Parser ProtocolVersion)
-> (Value -> Parser [ProtocolVersion])
-> Maybe ProtocolVersion
-> FromJSON ProtocolVersion
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ProtocolVersion
parseJSON :: Value -> Parser ProtocolVersion
$cparseJSONList :: Value -> Parser [ProtocolVersion]
parseJSONList :: Value -> Parser [ProtocolVersion]
$comittedField :: Maybe ProtocolVersion
omittedField :: Maybe ProtocolVersion
FromJSON)

instance ToCBOR ProtocolVersion where
  toCBOR :: ProtocolVersion -> Encoding
toCBOR = ProtocolVersion -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance FromCBOR ProtocolVersion where
  fromCBOR :: forall s. Decoder s ProtocolVersion
fromCBOR = Decoder s ProtocolVersion
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR