{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}
{-# LANGUAGE NamedFieldPuns #-}

module Ouroboros.Network.NodeToNode.Version
  ( NodeToNodeVersion (..)
  , NodeToNodeVersionData (..)
  , DiffusionMode (..)
  , ConnectionMode (..)
  , nodeToNodeVersionCodec
  , nodeToNodeCodecCBORTerm
  , isPipeliningEnabled
  ) where

import Data.Text (Text)
import Data.Text qualified as T
import Data.Typeable (Typeable)

import Codec.CBOR.Term qualified as CBOR

import Control.DeepSeq
import GHC.Generics
import Ouroboros.Network.BlockFetch.ConsensusInterface
           (WhetherReceivingTentativeBlocks (..))
import Ouroboros.Network.CodecCBORTerm
import Ouroboros.Network.Handshake.Acceptable (Accept (..), Acceptable (..))
import Ouroboros.Network.Handshake.Queryable (Queryable (..))
import Ouroboros.Network.Magic
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))

-- | Enumeration of node to node protocol versions.
--
data NodeToNodeVersion
    = NodeToNodeV_7
    -- ^ Changes:
    --
    -- * new 'KeepAlive' codec
    -- * Enable @CardanoNodeToNodeVersion5@, i.e., Alonzo
    | NodeToNodeV_8
    -- ^ Changes:
    --
    -- * Enable block diffusion pipelining in ChainSync and BlockFetch logic.
    | NodeToNodeV_9
    -- ^ Changes:
    --
    -- * Enable @CardanoNodeToNodeVersion6@, i.e., Babbage
    | NodeToNodeV_10
    -- ^ Changes:
    --
    -- * Enable full duplex connections.
    | NodeToNodeV_11
    -- ^ Changes:
    --
    -- * Adds a new extra parameter to handshake: PeerSharing
    --   This version is needed to support the new  Peer Sharing miniprotocol
    --   older versions that are negotiated will appear as not participating
    --   in Peer Sharing to newer versions.
    -- * Adds `query` to NodeToClientVersionData.
    | NodeToNodeV_12
    -- ^ No changes.
    --
    -- (In the past, this enabled Conway, but the negotiated 'NodeToNodeVersion'
    -- no longer en-/disables eras.)
    | NodeToNodeV_13
    -- ^ Changes:
    --
    -- * Removed PeerSharingPrivate constructor
    -- * Fixed Codec to disable PeerSharing with buggy versions 11 and 12.
    -- * Disable PeerSharing with InitiatorOnly nodes, since they do not run
    --   peer sharing server side and can not reply to requests.
  deriving (NodeToNodeVersion -> NodeToNodeVersion -> Bool
(NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> Eq NodeToNodeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
== :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c/= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
/= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
Eq, Eq NodeToNodeVersion
Eq NodeToNodeVersion =>
(NodeToNodeVersion -> NodeToNodeVersion -> Ordering)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion)
-> (NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion)
-> Ord NodeToNodeVersion
NodeToNodeVersion -> NodeToNodeVersion -> Bool
NodeToNodeVersion -> NodeToNodeVersion -> Ordering
NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
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 :: NodeToNodeVersion -> NodeToNodeVersion -> Ordering
compare :: NodeToNodeVersion -> NodeToNodeVersion -> Ordering
$c< :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
< :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c<= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
<= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c> :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
> :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c>= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
>= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$cmax :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
max :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
$cmin :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
min :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
Ord, Int -> NodeToNodeVersion
NodeToNodeVersion -> Int
NodeToNodeVersion -> [NodeToNodeVersion]
NodeToNodeVersion -> NodeToNodeVersion
NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
(NodeToNodeVersion -> NodeToNodeVersion)
-> (NodeToNodeVersion -> NodeToNodeVersion)
-> (Int -> NodeToNodeVersion)
-> (NodeToNodeVersion -> Int)
-> (NodeToNodeVersion -> [NodeToNodeVersion])
-> (NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion])
-> (NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion])
-> (NodeToNodeVersion
    -> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion])
-> Enum NodeToNodeVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NodeToNodeVersion -> NodeToNodeVersion
succ :: NodeToNodeVersion -> NodeToNodeVersion
$cpred :: NodeToNodeVersion -> NodeToNodeVersion
pred :: NodeToNodeVersion -> NodeToNodeVersion
$ctoEnum :: Int -> NodeToNodeVersion
toEnum :: Int -> NodeToNodeVersion
$cfromEnum :: NodeToNodeVersion -> Int
fromEnum :: NodeToNodeVersion -> Int
$cenumFrom :: NodeToNodeVersion -> [NodeToNodeVersion]
enumFrom :: NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromThen :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromThen :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromTo :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromTo :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromThenTo :: NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromThenTo :: NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
Enum, NodeToNodeVersion
NodeToNodeVersion -> NodeToNodeVersion -> Bounded NodeToNodeVersion
forall a. a -> a -> Bounded a
$cminBound :: NodeToNodeVersion
minBound :: NodeToNodeVersion
$cmaxBound :: NodeToNodeVersion
maxBound :: NodeToNodeVersion
Bounded, Int -> NodeToNodeVersion -> ShowS
[NodeToNodeVersion] -> ShowS
NodeToNodeVersion -> String
(Int -> NodeToNodeVersion -> ShowS)
-> (NodeToNodeVersion -> String)
-> ([NodeToNodeVersion] -> ShowS)
-> Show NodeToNodeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeToNodeVersion -> ShowS
showsPrec :: Int -> NodeToNodeVersion -> ShowS
$cshow :: NodeToNodeVersion -> String
show :: NodeToNodeVersion -> String
$cshowList :: [NodeToNodeVersion] -> ShowS
showList :: [NodeToNodeVersion] -> ShowS
Show, Typeable, (forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x)
-> (forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion)
-> Generic NodeToNodeVersion
forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion
forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x
from :: forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x
$cto :: forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion
to :: forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion
Generic, NodeToNodeVersion -> ()
(NodeToNodeVersion -> ()) -> NFData NodeToNodeVersion
forall a. (a -> ()) -> NFData a
$crnf :: NodeToNodeVersion -> ()
rnf :: NodeToNodeVersion -> ()
NFData)

nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec = CodecCBORTerm { NodeToNodeVersion -> Term
encodeTerm :: NodeToNodeVersion -> Term
encodeTerm :: NodeToNodeVersion -> Term
encodeTerm, Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm :: Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm :: Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm }
  where
    encodeTerm :: NodeToNodeVersion -> Term
encodeTerm NodeToNodeVersion
NodeToNodeV_7  = Int -> Term
CBOR.TInt Int
7
    encodeTerm NodeToNodeVersion
NodeToNodeV_8  = Int -> Term
CBOR.TInt Int
8
    encodeTerm NodeToNodeVersion
NodeToNodeV_9  = Int -> Term
CBOR.TInt Int
9
    encodeTerm NodeToNodeVersion
NodeToNodeV_10 = Int -> Term
CBOR.TInt Int
10
    encodeTerm NodeToNodeVersion
NodeToNodeV_11 = Int -> Term
CBOR.TInt Int
11
    encodeTerm NodeToNodeVersion
NodeToNodeV_12 = Int -> Term
CBOR.TInt Int
12
    encodeTerm NodeToNodeVersion
NodeToNodeV_13 = Int -> Term
CBOR.TInt Int
13

    decodeTerm :: Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm (CBOR.TInt Int
7) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_7
    decodeTerm (CBOR.TInt Int
8) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_8
    decodeTerm (CBOR.TInt Int
9) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_9
    decodeTerm (CBOR.TInt Int
10) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_10
    decodeTerm (CBOR.TInt Int
11) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_11
    decodeTerm (CBOR.TInt Int
12) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_12
    decodeTerm (CBOR.TInt Int
13) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_13
    decodeTerm (CBOR.TInt Int
n) = (Text, Maybe Int) -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. a -> Either a b
Left ( String -> Text
T.pack String
"decode NodeToNodeVersion: unknonw tag: "
                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
                                    , Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
                                    )
    decodeTerm Term
_ = (Text, Maybe Int) -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. a -> Either a b
Left ( String -> Text
T.pack String
"decode NodeToNodeVersion: unexpected term"
                        , Maybe Int
forall a. Maybe a
Nothing)



-- | The flag which indicates whether the node runs only initiator or both
-- initiator or responder node.
--
-- This data structure has two proposes:
--
-- * instruct the diffusion layer if it should listen on incoming connections;
--
-- * it is communicated via 'NodeToNodeVersionData' during handshake
--   negotiation. In non-p2p mode we always send 'InitiatorOnlyDiffusionMode',
--   in p2p mode we send exactly what the diffusion is given.  In non-p2p mode
--   every connection outbound port is ephemeral, the remote side cannot connect
--   to it, however in p2p mode the outbound port is actually the port on which
--   the node is listening (if it runs in 'InitiatorAndResponderDiffusionMode').
--
data DiffusionMode
    = InitiatorOnlyDiffusionMode
    | InitiatorAndResponderDiffusionMode
  deriving (Typeable, DiffusionMode -> DiffusionMode -> Bool
(DiffusionMode -> DiffusionMode -> Bool)
-> (DiffusionMode -> DiffusionMode -> Bool) -> Eq DiffusionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiffusionMode -> DiffusionMode -> Bool
== :: DiffusionMode -> DiffusionMode -> Bool
$c/= :: DiffusionMode -> DiffusionMode -> Bool
/= :: DiffusionMode -> DiffusionMode -> Bool
Eq, Eq DiffusionMode
Eq DiffusionMode =>
(DiffusionMode -> DiffusionMode -> Ordering)
-> (DiffusionMode -> DiffusionMode -> Bool)
-> (DiffusionMode -> DiffusionMode -> Bool)
-> (DiffusionMode -> DiffusionMode -> Bool)
-> (DiffusionMode -> DiffusionMode -> Bool)
-> (DiffusionMode -> DiffusionMode -> DiffusionMode)
-> (DiffusionMode -> DiffusionMode -> DiffusionMode)
-> Ord DiffusionMode
DiffusionMode -> DiffusionMode -> Bool
DiffusionMode -> DiffusionMode -> Ordering
DiffusionMode -> DiffusionMode -> DiffusionMode
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 :: DiffusionMode -> DiffusionMode -> Ordering
compare :: DiffusionMode -> DiffusionMode -> Ordering
$c< :: DiffusionMode -> DiffusionMode -> Bool
< :: DiffusionMode -> DiffusionMode -> Bool
$c<= :: DiffusionMode -> DiffusionMode -> Bool
<= :: DiffusionMode -> DiffusionMode -> Bool
$c> :: DiffusionMode -> DiffusionMode -> Bool
> :: DiffusionMode -> DiffusionMode -> Bool
$c>= :: DiffusionMode -> DiffusionMode -> Bool
>= :: DiffusionMode -> DiffusionMode -> Bool
$cmax :: DiffusionMode -> DiffusionMode -> DiffusionMode
max :: DiffusionMode -> DiffusionMode -> DiffusionMode
$cmin :: DiffusionMode -> DiffusionMode -> DiffusionMode
min :: DiffusionMode -> DiffusionMode -> DiffusionMode
Ord, Int -> DiffusionMode -> ShowS
[DiffusionMode] -> ShowS
DiffusionMode -> String
(Int -> DiffusionMode -> ShowS)
-> (DiffusionMode -> String)
-> ([DiffusionMode] -> ShowS)
-> Show DiffusionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiffusionMode -> ShowS
showsPrec :: Int -> DiffusionMode -> ShowS
$cshow :: DiffusionMode -> String
show :: DiffusionMode -> String
$cshowList :: [DiffusionMode] -> ShowS
showList :: [DiffusionMode] -> ShowS
Show)


-- | Version data for NodeToNode protocol
--
data NodeToNodeVersionData = NodeToNodeVersionData
  { NodeToNodeVersionData -> NetworkMagic
networkMagic  :: !NetworkMagic
  , NodeToNodeVersionData -> DiffusionMode
diffusionMode :: !DiffusionMode
  , NodeToNodeVersionData -> PeerSharing
peerSharing   :: !PeerSharing
  , NodeToNodeVersionData -> Bool
query         :: !Bool
  }
  deriving (Int -> NodeToNodeVersionData -> ShowS
[NodeToNodeVersionData] -> ShowS
NodeToNodeVersionData -> String
(Int -> NodeToNodeVersionData -> ShowS)
-> (NodeToNodeVersionData -> String)
-> ([NodeToNodeVersionData] -> ShowS)
-> Show NodeToNodeVersionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeToNodeVersionData -> ShowS
showsPrec :: Int -> NodeToNodeVersionData -> ShowS
$cshow :: NodeToNodeVersionData -> String
show :: NodeToNodeVersionData -> String
$cshowList :: [NodeToNodeVersionData] -> ShowS
showList :: [NodeToNodeVersionData] -> ShowS
Show, Typeable, NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
(NodeToNodeVersionData -> NodeToNodeVersionData -> Bool)
-> (NodeToNodeVersionData -> NodeToNodeVersionData -> Bool)
-> Eq NodeToNodeVersionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
== :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
$c/= :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
/= :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
Eq)
  -- 'Eq' instance is not provided, it is not what we need in version
  -- negotiation (see 'Acceptable' instance below).

instance Acceptable NodeToNodeVersionData where
    -- | Check that both side use the same 'networkMagic'.  Choose smaller one
    -- from both 'diffusionMode's, e.g. if one is running in 'InitiatorOnlyMode'
    -- agree on it. Agree on the same 'PeerSharing' value, if the negotiated
    -- diffusion mode is 'InitiatorAndResponder', otherwise default to
    -- 'PeerSharingDisabled'.
    acceptableVersion :: NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
acceptableVersion NodeToNodeVersionData
local NodeToNodeVersionData
remote
      | NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
local NetworkMagic -> NetworkMagic -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
remote
      = let acceptedDiffusionMode :: DiffusionMode
acceptedDiffusionMode = NodeToNodeVersionData -> DiffusionMode
diffusionMode NodeToNodeVersionData
local DiffusionMode -> DiffusionMode -> DiffusionMode
forall a. Ord a => a -> a -> a
`min` NodeToNodeVersionData -> DiffusionMode
diffusionMode NodeToNodeVersionData
remote
         in NodeToNodeVersionData -> Accept NodeToNodeVersionData
forall vData. vData -> Accept vData
Accept NodeToNodeVersionData
              { networkMagic :: NetworkMagic
networkMagic  = NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
local
              , diffusionMode :: DiffusionMode
diffusionMode = DiffusionMode
acceptedDiffusionMode
              , peerSharing :: PeerSharing
peerSharing   = case DiffusionMode
acceptedDiffusionMode of
                                  DiffusionMode
InitiatorAndResponderDiffusionMode ->
                                    NodeToNodeVersionData -> PeerSharing
peerSharing NodeToNodeVersionData
local PeerSharing -> PeerSharing -> PeerSharing
forall a. Semigroup a => a -> a -> a
<> NodeToNodeVersionData -> PeerSharing
peerSharing NodeToNodeVersionData
remote
                                  DiffusionMode
InitiatorOnlyDiffusionMode         ->
                                    PeerSharing
PeerSharingDisabled
              , query :: Bool
query         = NodeToNodeVersionData -> Bool
query NodeToNodeVersionData
local Bool -> Bool -> Bool
|| NodeToNodeVersionData -> Bool
query NodeToNodeVersionData
remote
              }
      | Bool
otherwise
      = Text -> Accept NodeToNodeVersionData
forall vData. Text -> Accept vData
Refuse (Text -> Accept NodeToNodeVersionData)
-> Text -> Accept NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"version data mismatch: "
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeToNodeVersionData -> String
forall a. Show a => a -> String
show NodeToNodeVersionData
local
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeToNodeVersionData -> String
forall a. Show a => a -> String
show NodeToNodeVersionData
remote

instance Queryable NodeToNodeVersionData where
    queryVersion :: NodeToNodeVersionData -> Bool
queryVersion = NodeToNodeVersionData -> Bool
query

nodeToNodeCodecCBORTerm :: NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm :: NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm NodeToNodeVersion
version
  | NodeToNodeVersion
version NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_13 =
    let encodeTerm :: NodeToNodeVersionData -> CBOR.Term
        encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm NodeToNodeVersionData { NetworkMagic
networkMagic :: NodeToNodeVersionData -> NetworkMagic
networkMagic :: NetworkMagic
networkMagic, DiffusionMode
diffusionMode :: NodeToNodeVersionData -> DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode, PeerSharing
peerSharing :: NodeToNodeVersionData -> PeerSharing
peerSharing :: PeerSharing
peerSharing, Bool
query :: NodeToNodeVersionData -> Bool
query :: Bool
query }
          = [Term] -> Term
CBOR.TList
              [ Int -> Term
CBOR.TInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> Word32
unNetworkMagic NetworkMagic
networkMagic)
              , Bool -> Term
CBOR.TBool (case DiffusionMode
diffusionMode of
                             DiffusionMode
InitiatorOnlyDiffusionMode         -> Bool
True
                             DiffusionMode
InitiatorAndResponderDiffusionMode -> Bool
False)
              , Int -> Term
CBOR.TInt (case PeerSharing
peerSharing of
                             PeerSharing
PeerSharingDisabled -> Int
0
                             PeerSharing
PeerSharingEnabled  -> Int
1)
              , Bool -> Term
CBOR.TBool Bool
query
              ]

        decodeTerm :: CBOR.Term -> Either Text NodeToNodeVersionData
        decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm (CBOR.TList [CBOR.TInt Int
x, CBOR.TBool Bool
diffusionMode, CBOR.TInt Int
peerSharing, CBOR.TBool Bool
query])
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
          , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffffffff
          , Just PeerSharing
ps <- case Int
peerSharing of
                        Int
0 -> PeerSharing -> Maybe PeerSharing
forall a. a -> Maybe a
Just PeerSharing
PeerSharingDisabled
                        Int
1 -> PeerSharing -> Maybe PeerSharing
forall a. a -> Maybe a
Just PeerSharing
PeerSharingEnabled
                        Int
_ -> Maybe PeerSharing
forall a. Maybe a
Nothing
          = NodeToNodeVersionData -> Either Text NodeToNodeVersionData
forall a b. b -> Either a b
Right
              NodeToNodeVersionData {
                  networkMagic :: NetworkMagic
networkMagic = Word32 -> NetworkMagic
NetworkMagic (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x),
                  diffusionMode :: DiffusionMode
diffusionMode = if Bool
diffusionMode
                                  then DiffusionMode
InitiatorOnlyDiffusionMode
                                  else DiffusionMode
InitiatorAndResponderDiffusionMode,
                  peerSharing :: PeerSharing
peerSharing = PeerSharing
ps,
                  query :: Bool
query = Bool
query
                }
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xffffffff
          = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"networkMagic out of bound: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
x
          | Bool
otherwise -- peerSharing < 0 || peerSharing > 1
          = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"peerSharing is out of bound: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
peerSharing
        decodeTerm Term
t
          = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"unknown encoding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
t
     in CodecCBORTerm { NodeToNodeVersionData -> Term
encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm, Term -> Either Text NodeToNodeVersionData
decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm }
  | NodeToNodeVersion
version NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_11
  , NodeToNodeVersion
version NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
<= NodeToNodeVersion
NodeToNodeV_12 =
    let encodeTerm :: NodeToNodeVersionData -> CBOR.Term
        encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm NodeToNodeVersionData { NetworkMagic
networkMagic :: NodeToNodeVersionData -> NetworkMagic
networkMagic :: NetworkMagic
networkMagic, DiffusionMode
diffusionMode :: NodeToNodeVersionData -> DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode, Bool
query :: NodeToNodeVersionData -> Bool
query :: Bool
query }
          = [Term] -> Term
CBOR.TList
              [ Int -> Term
CBOR.TInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> Word32
unNetworkMagic NetworkMagic
networkMagic)
              , Bool -> Term
CBOR.TBool (case DiffusionMode
diffusionMode of
                             DiffusionMode
InitiatorOnlyDiffusionMode         -> Bool
True
                             DiffusionMode
InitiatorAndResponderDiffusionMode -> Bool
False)
                              -- There's a bug in this versions where the
                              -- agreed PeerSharing value on the remote side
                              -- is whatever that got proposed, so we have to
                              -- disable peer sharing with such nodes to avoid
                              -- protocol violations
              , Int -> Term
CBOR.TInt Int
0 -- 0 corresponds to PeerSharingDisabled
              , Bool -> Term
CBOR.TBool Bool
query
              ]

        decodeTerm :: CBOR.Term -> Either Text NodeToNodeVersionData
        decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm (CBOR.TList [CBOR.TInt Int
x, CBOR.TBool Bool
diffusionMode, CBOR.TInt Int
_, CBOR.TBool Bool
query])
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
          , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffffffff
          = NodeToNodeVersionData -> Either Text NodeToNodeVersionData
forall a b. b -> Either a b
Right
              NodeToNodeVersionData {
                  networkMagic :: NetworkMagic
networkMagic = Word32 -> NetworkMagic
NetworkMagic (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x),
                  diffusionMode :: DiffusionMode
diffusionMode = if Bool
diffusionMode
                                  then DiffusionMode
InitiatorOnlyDiffusionMode
                                  else DiffusionMode
InitiatorAndResponderDiffusionMode,
                  peerSharing :: PeerSharing
peerSharing = PeerSharing
PeerSharingDisabled,
                  query :: Bool
query = Bool
query
                }
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xffffffff
          = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"networkMagic out of bound: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
x
        decodeTerm Term
t
          = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"unknown encoding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
t
     in CodecCBORTerm { NodeToNodeVersionData -> Term
encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm, Term -> Either Text NodeToNodeVersionData
decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm }
  | Bool
otherwise =
    let encodeTerm :: NodeToNodeVersionData -> CBOR.Term
        encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm NodeToNodeVersionData { NetworkMagic
networkMagic :: NodeToNodeVersionData -> NetworkMagic
networkMagic :: NetworkMagic
networkMagic, DiffusionMode
diffusionMode :: NodeToNodeVersionData -> DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode }
          = [Term] -> Term
CBOR.TList
                  [ Int -> Term
CBOR.TInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> Word32
unNetworkMagic NetworkMagic
networkMagic)
                  , Bool -> Term
CBOR.TBool (case DiffusionMode
diffusionMode of
                                 DiffusionMode
InitiatorOnlyDiffusionMode         -> Bool
True
                                 DiffusionMode
InitiatorAndResponderDiffusionMode -> Bool
False)
                  ]

        decodeTerm :: CBOR.Term -> Either Text NodeToNodeVersionData
        decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm (CBOR.TList [CBOR.TInt Int
x, CBOR.TBool Bool
diffusionMode])
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
          , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffffffff
          = NodeToNodeVersionData -> Either Text NodeToNodeVersionData
forall a b. b -> Either a b
Right
              NodeToNodeVersionData {
                  networkMagic :: NetworkMagic
networkMagic  = Word32 -> NetworkMagic
NetworkMagic (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
                , diffusionMode :: DiffusionMode
diffusionMode = if Bool
diffusionMode
                                  then DiffusionMode
InitiatorOnlyDiffusionMode
                                  else DiffusionMode
InitiatorAndResponderDiffusionMode
                  -- By default older versions do not participate in Peer
                  -- Sharing, since they do not support the new miniprotocol
                , peerSharing :: PeerSharing
peerSharing = PeerSharing
PeerSharingDisabled
                , query :: Bool
query = Bool
False
                }
          | Bool
otherwise
          = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"networkMagic out of bound: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
x
        decodeTerm Term
t
          = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"unknown encoding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
t
     in CodecCBORTerm { NodeToNodeVersionData -> Term
encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm, Term -> Either Text NodeToNodeVersionData
decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm }


data ConnectionMode = UnidirectionalMode | DuplexMode

-- | Check whether a version enabling diffusion pipelining has been
-- negotiated.
--
-- TODO: this ought to be defined in `ouroboros-consensus` or
-- `ouroboros-consensus-diffusion`
isPipeliningEnabled :: NodeToNodeVersion -> WhetherReceivingTentativeBlocks
isPipeliningEnabled :: NodeToNodeVersion -> WhetherReceivingTentativeBlocks
isPipeliningEnabled NodeToNodeVersion
v
  | NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_8 = WhetherReceivingTentativeBlocks
ReceivingTentativeBlocks
  | Bool
otherwise          = WhetherReceivingTentativeBlocks
NotReceivingTentativeBlocks