{-# LANGUAGE NamedFieldPuns #-}

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

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

import qualified Codec.CBOR.Term as CBOR

import           Ouroboros.Network.CodecCBORTerm
import           Ouroboros.Network.Magic
import           Ouroboros.Network.Protocol.Handshake.Version (Accept (..),
                     Acceptable (..))


-- | 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.
    --   NOTE: This is an experimental protocol version, which is not yet
    --   released.  Until initial P2P version it must be kept as the last
    --   version, which allows us to keep it as an experimental version.
  deriving (NodeToNodeVersion -> NodeToNodeVersion -> Bool
(NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> Eq NodeToNodeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c/= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
== :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c== :: 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
min :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
$cmin :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
max :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
$cmax :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
>= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$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
compare :: NodeToNodeVersion -> NodeToNodeVersion -> Ordering
$ccompare :: NodeToNodeVersion -> NodeToNodeVersion -> Ordering
$cp1Ord :: Eq 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
enumFromThenTo :: NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromThenTo :: NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromTo :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromTo :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromThen :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromThen :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFrom :: NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFrom :: NodeToNodeVersion -> [NodeToNodeVersion]
fromEnum :: NodeToNodeVersion -> Int
$cfromEnum :: NodeToNodeVersion -> Int
toEnum :: Int -> NodeToNodeVersion
$ctoEnum :: Int -> NodeToNodeVersion
pred :: NodeToNodeVersion -> NodeToNodeVersion
$cpred :: NodeToNodeVersion -> NodeToNodeVersion
succ :: NodeToNodeVersion -> NodeToNodeVersion
$csucc :: NodeToNodeVersion -> NodeToNodeVersion
Enum, NodeToNodeVersion
NodeToNodeVersion -> NodeToNodeVersion -> Bounded NodeToNodeVersion
forall a. a -> a -> Bounded a
maxBound :: NodeToNodeVersion
$cmaxBound :: NodeToNodeVersion
minBound :: NodeToNodeVersion
$cminBound :: 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
showList :: [NodeToNodeVersion] -> ShowS
$cshowList :: [NodeToNodeVersion] -> ShowS
show :: NodeToNodeVersion -> String
$cshow :: NodeToNodeVersion -> String
showsPrec :: Int -> NodeToNodeVersion -> ShowS
$cshowsPrec :: Int -> NodeToNodeVersion -> ShowS
Show, Typeable)

nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec = CodecCBORTerm :: forall fail a.
(a -> Term) -> (Term -> Either fail a) -> CodecCBORTerm fail a
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

    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
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 wheather the node runs only initiator or both
-- initiator or responder node.   It does not however specify weather the node
-- is using duplex connections, this is implicit see 'NodeToNodeV_4'
--
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
/= :: DiffusionMode -> DiffusionMode -> Bool
$c/= :: DiffusionMode -> DiffusionMode -> Bool
== :: DiffusionMode -> DiffusionMode -> Bool
$c== :: DiffusionMode -> DiffusionMode -> Bool
Eq, 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
showList :: [DiffusionMode] -> ShowS
$cshowList :: [DiffusionMode] -> ShowS
show :: DiffusionMode -> String
$cshow :: DiffusionMode -> String
showsPrec :: Int -> DiffusionMode -> ShowS
$cshowsPrec :: Int -> DiffusionMode -> ShowS
Show)


-- | Version data for NodeToNode protocol
--
data NodeToNodeVersionData = NodeToNodeVersionData
  { NodeToNodeVersionData -> NetworkMagic
networkMagic  :: !NetworkMagic
  , NodeToNodeVersionData -> DiffusionMode
diffusionMode :: !DiffusionMode
  }
  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
showList :: [NodeToNodeVersionData] -> ShowS
$cshowList :: [NodeToNodeVersionData] -> ShowS
show :: NodeToNodeVersionData -> String
$cshow :: NodeToNodeVersionData -> String
showsPrec :: Int -> NodeToNodeVersionData -> ShowS
$cshowsPrec :: Int -> 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
/= :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
$c/= :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
== :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
$c== :: 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
    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 Bool -> Bool -> Bool
&& NodeToNodeVersionData -> DiffusionMode
diffusionMode NodeToNodeVersionData
remote DiffusionMode -> DiffusionMode -> Bool
forall a. Eq a => a -> a -> Bool
== DiffusionMode
InitiatorOnlyDiffusionMode
      = NodeToNodeVersionData -> Accept NodeToNodeVersionData
forall vData. vData -> Accept vData
Accept NodeToNodeVersionData
remote
      | NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
local NetworkMagic -> NetworkMagic -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
remote
      = NodeToNodeVersionData -> Accept NodeToNodeVersionData
forall vData. vData -> Accept vData
Accept NodeToNodeVersionData
local
      | 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


nodeToNodeCodecCBORTerm :: NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm :: NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm NodeToNodeVersion
_version
  = let encodeTerm :: NodeToNodeVersionData -> CBOR.Term
        encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm NodeToNodeVersionData { NetworkMagic
networkMagic :: NetworkMagic
networkMagic :: NodeToNodeVersionData -> NetworkMagic
networkMagic, DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode :: NodeToNodeVersionData -> 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 -> DiffusionMode -> NodeToNodeVersionData
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
                }
          | 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 :: forall fail a.
(a -> Term) -> (Term -> Either fail a) -> CodecCBORTerm fail a
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.
isPipeliningEnabled :: NodeToNodeVersion -> Bool
isPipeliningEnabled :: NodeToNodeVersion -> Bool
isPipeliningEnabled NodeToNodeVersion
v = NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_8