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

module Ouroboros.Network.NodeToClient.Version
  ( NodeToClientVersion (..)
  , NodeToClientVersionData (..)
  , nodeToClientCodecCBORTerm
  , nodeToClientVersionCodec
  ) where

import Codec.CBOR.Term qualified as CBOR
import Control.DeepSeq
import Data.Bits (clearBit, setBit, testBit)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Typeable (Typeable)
import GHC.Generics
import Ouroboros.Network.CodecCBORTerm
import Ouroboros.Network.Handshake.Acceptable (Accept (..), Acceptable (..))
import Ouroboros.Network.Handshake.Queryable (Queryable (..))
import Ouroboros.Network.Magic


-- | Enumeration of node to client protocol versions.
--
data NodeToClientVersion
    = NodeToClientV_9
    -- ^ enabled @CardanoNodeToClientVersion7@, i.e., Alonzo
    | NodeToClientV_10
    -- ^ added 'GetChainBlockNo' and 'GetChainPoint' queries
    | NodeToClientV_11
    -- ^ added 'GetRewardInfoPools` Block query
    | NodeToClientV_12
    -- ^ added 'LocalTxMonitor' mini-protocol
    | NodeToClientV_13
    -- ^ enabled @CardanoNodeToClientVersion9@, i.e., Babbage
    | NodeToClientV_14
    -- ^ added @GetPoolDistr@, @GetPoolState@, @GetSnapshots@
    | NodeToClientV_15
    -- ^ added `query` to NodeToClientVersionData
    | NodeToClientV_16
    -- ^ add @ImmutableTip@ to @LocalStateQuery@, enabled
    -- @CardanoNodeToClientVersion11@, i.e., Conway and
    -- @GetStakeDelegDeposits@.
    | NodeToClientV_17
    -- ^ add @GetProposals@ and @GetRatifyState@ queries
  deriving (NodeToClientVersion -> NodeToClientVersion -> Bool
(NodeToClientVersion -> NodeToClientVersion -> Bool)
-> (NodeToClientVersion -> NodeToClientVersion -> Bool)
-> Eq NodeToClientVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeToClientVersion -> NodeToClientVersion -> Bool
== :: NodeToClientVersion -> NodeToClientVersion -> Bool
$c/= :: NodeToClientVersion -> NodeToClientVersion -> Bool
/= :: NodeToClientVersion -> NodeToClientVersion -> Bool
Eq, Eq NodeToClientVersion
Eq NodeToClientVersion =>
(NodeToClientVersion -> NodeToClientVersion -> Ordering)
-> (NodeToClientVersion -> NodeToClientVersion -> Bool)
-> (NodeToClientVersion -> NodeToClientVersion -> Bool)
-> (NodeToClientVersion -> NodeToClientVersion -> Bool)
-> (NodeToClientVersion -> NodeToClientVersion -> Bool)
-> (NodeToClientVersion
    -> NodeToClientVersion -> NodeToClientVersion)
-> (NodeToClientVersion
    -> NodeToClientVersion -> NodeToClientVersion)
-> Ord NodeToClientVersion
NodeToClientVersion -> NodeToClientVersion -> Bool
NodeToClientVersion -> NodeToClientVersion -> Ordering
NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
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 :: NodeToClientVersion -> NodeToClientVersion -> Ordering
compare :: NodeToClientVersion -> NodeToClientVersion -> Ordering
$c< :: NodeToClientVersion -> NodeToClientVersion -> Bool
< :: NodeToClientVersion -> NodeToClientVersion -> Bool
$c<= :: NodeToClientVersion -> NodeToClientVersion -> Bool
<= :: NodeToClientVersion -> NodeToClientVersion -> Bool
$c> :: NodeToClientVersion -> NodeToClientVersion -> Bool
> :: NodeToClientVersion -> NodeToClientVersion -> Bool
$c>= :: NodeToClientVersion -> NodeToClientVersion -> Bool
>= :: NodeToClientVersion -> NodeToClientVersion -> Bool
$cmax :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
max :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
$cmin :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
min :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
Ord, Int -> NodeToClientVersion
NodeToClientVersion -> Int
NodeToClientVersion -> [NodeToClientVersion]
NodeToClientVersion -> NodeToClientVersion
NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
NodeToClientVersion
-> NodeToClientVersion
-> NodeToClientVersion
-> [NodeToClientVersion]
(NodeToClientVersion -> NodeToClientVersion)
-> (NodeToClientVersion -> NodeToClientVersion)
-> (Int -> NodeToClientVersion)
-> (NodeToClientVersion -> Int)
-> (NodeToClientVersion -> [NodeToClientVersion])
-> (NodeToClientVersion
    -> NodeToClientVersion -> [NodeToClientVersion])
-> (NodeToClientVersion
    -> NodeToClientVersion -> [NodeToClientVersion])
-> (NodeToClientVersion
    -> NodeToClientVersion
    -> NodeToClientVersion
    -> [NodeToClientVersion])
-> Enum NodeToClientVersion
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 :: NodeToClientVersion -> NodeToClientVersion
succ :: NodeToClientVersion -> NodeToClientVersion
$cpred :: NodeToClientVersion -> NodeToClientVersion
pred :: NodeToClientVersion -> NodeToClientVersion
$ctoEnum :: Int -> NodeToClientVersion
toEnum :: Int -> NodeToClientVersion
$cfromEnum :: NodeToClientVersion -> Int
fromEnum :: NodeToClientVersion -> Int
$cenumFrom :: NodeToClientVersion -> [NodeToClientVersion]
enumFrom :: NodeToClientVersion -> [NodeToClientVersion]
$cenumFromThen :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
enumFromThen :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
$cenumFromTo :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
enumFromTo :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
$cenumFromThenTo :: NodeToClientVersion
-> NodeToClientVersion
-> NodeToClientVersion
-> [NodeToClientVersion]
enumFromThenTo :: NodeToClientVersion
-> NodeToClientVersion
-> NodeToClientVersion
-> [NodeToClientVersion]
Enum, NodeToClientVersion
NodeToClientVersion
-> NodeToClientVersion -> Bounded NodeToClientVersion
forall a. a -> a -> Bounded a
$cminBound :: NodeToClientVersion
minBound :: NodeToClientVersion
$cmaxBound :: NodeToClientVersion
maxBound :: NodeToClientVersion
Bounded, Int -> NodeToClientVersion -> ShowS
[NodeToClientVersion] -> ShowS
NodeToClientVersion -> String
(Int -> NodeToClientVersion -> ShowS)
-> (NodeToClientVersion -> String)
-> ([NodeToClientVersion] -> ShowS)
-> Show NodeToClientVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeToClientVersion -> ShowS
showsPrec :: Int -> NodeToClientVersion -> ShowS
$cshow :: NodeToClientVersion -> String
show :: NodeToClientVersion -> String
$cshowList :: [NodeToClientVersion] -> ShowS
showList :: [NodeToClientVersion] -> ShowS
Show, Typeable, (forall x. NodeToClientVersion -> Rep NodeToClientVersion x)
-> (forall x. Rep NodeToClientVersion x -> NodeToClientVersion)
-> Generic NodeToClientVersion
forall x. Rep NodeToClientVersion x -> NodeToClientVersion
forall x. NodeToClientVersion -> Rep NodeToClientVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeToClientVersion -> Rep NodeToClientVersion x
from :: forall x. NodeToClientVersion -> Rep NodeToClientVersion x
$cto :: forall x. Rep NodeToClientVersion x -> NodeToClientVersion
to :: forall x. Rep NodeToClientVersion x -> NodeToClientVersion
Generic, NodeToClientVersion -> ()
(NodeToClientVersion -> ()) -> NFData NodeToClientVersion
forall a. (a -> ()) -> NFData a
$crnf :: NodeToClientVersion -> ()
rnf :: NodeToClientVersion -> ()
NFData)

-- | We set 16ths bit to distinguish `NodeToNodeVersion` and
-- `NodeToClientVersion`.  This way connecting wrong protocol suite will fail
-- during `Handshake` negotiation
--
-- This is done in backward compatible way, so `NodeToClientV_1` encoding is not
-- changed.
--
nodeToClientVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec = CodecCBORTerm { NodeToClientVersion -> Term
encodeTerm :: NodeToClientVersion -> Term
encodeTerm :: NodeToClientVersion -> Term
encodeTerm, Term -> Either (Text, Maybe Int) NodeToClientVersion
decodeTerm :: Term -> Either (Text, Maybe Int) NodeToClientVersion
decodeTerm :: Term -> Either (Text, Maybe Int) NodeToClientVersion
decodeTerm }
    where
      encodeTerm :: NodeToClientVersion -> Term
encodeTerm NodeToClientVersion
NodeToClientV_9  = Int -> Term
CBOR.TInt (Int
9  Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_10 = Int -> Term
CBOR.TInt (Int
10 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_11 = Int -> Term
CBOR.TInt (Int
11 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_12 = Int -> Term
CBOR.TInt (Int
12 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_13 = Int -> Term
CBOR.TInt (Int
13 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_14 = Int -> Term
CBOR.TInt (Int
14 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_15 = Int -> Term
CBOR.TInt (Int
15 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_16 = Int -> Term
CBOR.TInt (Int
16 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
      encodeTerm NodeToClientVersion
NodeToClientV_17 = Int -> Term
CBOR.TInt (Int
17 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)

      decodeTerm :: Term -> Either (Text, Maybe Int) NodeToClientVersion
decodeTerm (CBOR.TInt Int
tag) =
       case ( Int
tag Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`clearBit` Int
nodeToClientVersionBit
            , Int
tag Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit`  Int
nodeToClientVersionBit
            ) of
        (Int
9, Bool
True)  -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_9
        (Int
10, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_10
        (Int
11, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_11
        (Int
12, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_12
        (Int
13, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_13
        (Int
14, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_14
        (Int
15, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_15
        (Int
16, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_16
        (Int
17, Bool
True) -> NodeToClientVersion -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. b -> Either a b
Right NodeToClientVersion
NodeToClientV_17
        (Int
n, Bool
_)     -> (Text, Maybe Int) -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. a -> Either a b
Left ( String -> Text
T.pack String
"decode NodeToClientVersion: unknown 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
tag)
                            , Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
      decodeTerm Term
_  = (Text, Maybe Int) -> Either (Text, Maybe Int) NodeToClientVersion
forall a b. a -> Either a b
Left ( String -> Text
T.pack String
"decode NodeToClientVersion: unexpected term"
                           , Maybe Int
forall a. Maybe a
Nothing)

      -- The 16th bit to distinguish `NodeToNodeVersion` and `NodeToClientVersion`.
      nodeToClientVersionBit :: Int
      nodeToClientVersionBit :: Int
nodeToClientVersionBit = Int
15


-- | Version data for NodeToClient protocol v1
--
data NodeToClientVersionData = NodeToClientVersionData
  { NodeToClientVersionData -> NetworkMagic
networkMagic :: !NetworkMagic
  , NodeToClientVersionData -> Bool
query        :: !Bool
  }
  deriving (NodeToClientVersionData -> NodeToClientVersionData -> Bool
(NodeToClientVersionData -> NodeToClientVersionData -> Bool)
-> (NodeToClientVersionData -> NodeToClientVersionData -> Bool)
-> Eq NodeToClientVersionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeToClientVersionData -> NodeToClientVersionData -> Bool
== :: NodeToClientVersionData -> NodeToClientVersionData -> Bool
$c/= :: NodeToClientVersionData -> NodeToClientVersionData -> Bool
/= :: NodeToClientVersionData -> NodeToClientVersionData -> Bool
Eq, Int -> NodeToClientVersionData -> ShowS
[NodeToClientVersionData] -> ShowS
NodeToClientVersionData -> String
(Int -> NodeToClientVersionData -> ShowS)
-> (NodeToClientVersionData -> String)
-> ([NodeToClientVersionData] -> ShowS)
-> Show NodeToClientVersionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeToClientVersionData -> ShowS
showsPrec :: Int -> NodeToClientVersionData -> ShowS
$cshow :: NodeToClientVersionData -> String
show :: NodeToClientVersionData -> String
$cshowList :: [NodeToClientVersionData] -> ShowS
showList :: [NodeToClientVersionData] -> ShowS
Show, Typeable)

instance Acceptable NodeToClientVersionData where
    acceptableVersion :: NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
acceptableVersion NodeToClientVersionData
local NodeToClientVersionData
remote
      | NodeToClientVersionData -> NetworkMagic
networkMagic NodeToClientVersionData
local NetworkMagic -> NetworkMagic -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToClientVersionData -> NetworkMagic
networkMagic NodeToClientVersionData
remote
      = NodeToClientVersionData -> Accept NodeToClientVersionData
forall vData. vData -> Accept vData
Accept NodeToClientVersionData
          { networkMagic :: NetworkMagic
networkMagic  = NodeToClientVersionData -> NetworkMagic
networkMagic NodeToClientVersionData
local
          , query :: Bool
query         = NodeToClientVersionData -> Bool
query NodeToClientVersionData
local Bool -> Bool -> Bool
|| NodeToClientVersionData -> Bool
query NodeToClientVersionData
remote
          }
      | Bool
otherwise =  Text -> Accept NodeToClientVersionData
forall vData. Text -> Accept vData
Refuse (Text -> Accept NodeToClientVersionData)
-> Text -> Accept NodeToClientVersionData
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]
++ NodeToClientVersionData -> String
forall a. Show a => a -> String
show NodeToClientVersionData
local
                                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeToClientVersionData -> String
forall a. Show a => a -> String
show NodeToClientVersionData
remote

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

nodeToClientCodecCBORTerm :: NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm :: NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm NodeToClientVersion
v = CodecCBORTerm {NodeToClientVersionData -> Term
encodeTerm :: NodeToClientVersionData -> Term
encodeTerm :: NodeToClientVersionData -> Term
encodeTerm, Term -> Either Text NodeToClientVersionData
decodeTerm :: Term -> Either Text NodeToClientVersionData
decodeTerm :: Term -> Either Text NodeToClientVersionData
decodeTerm}
    where
      encodeTerm :: NodeToClientVersionData -> CBOR.Term
      encodeTerm :: NodeToClientVersionData -> Term
encodeTerm NodeToClientVersionData { NetworkMagic
networkMagic :: NodeToClientVersionData -> NetworkMagic
networkMagic :: NetworkMagic
networkMagic, Bool
query :: NodeToClientVersionData -> Bool
query :: Bool
query }
        | NodeToClientVersion
v NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_15
        = [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 Bool
query]
        | Bool
otherwise
        = 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)

      decodeTerm :: CBOR.Term -> Either Text NodeToClientVersionData
      decodeTerm :: Term -> Either Text NodeToClientVersionData
decodeTerm (CBOR.TList [CBOR.TInt Int
x, CBOR.TBool Bool
query])
        | NodeToClientVersion
v NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_15
        = Int -> Bool -> Either Text NodeToClientVersionData
decoder Int
x Bool
query
      decodeTerm (CBOR.TInt Int
x)
        | NodeToClientVersion
v NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
< NodeToClientVersion
NodeToClientV_15
        = Int -> Bool -> Either Text NodeToClientVersionData
decoder Int
x Bool
False
      decodeTerm Term
t
        = Text -> Either Text NodeToClientVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToClientVersionData)
-> Text -> Either Text NodeToClientVersionData
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

      decoder :: Int -> Bool -> Either Text NodeToClientVersionData
      decoder :: Int -> Bool -> Either Text NodeToClientVersionData
decoder Int
x 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 = NodeToClientVersionData -> Either Text NodeToClientVersionData
forall a b. b -> Either a b
Right (NetworkMagic -> Bool -> NodeToClientVersionData
NodeToClientVersionData (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Word32 -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) Bool
query)
                      | Bool
otherwise                 = Text -> Either Text NodeToClientVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToClientVersionData)
-> Text -> Either Text NodeToClientVersionData
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