{-# LANGUAGE NamedFieldPuns #-}

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

import           Data.Bits (clearBit, setBit, testBit)
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 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
  deriving (NodeToClientVersion -> NodeToClientVersion -> Bool
(NodeToClientVersion -> NodeToClientVersion -> Bool)
-> (NodeToClientVersion -> NodeToClientVersion -> Bool)
-> Eq NodeToClientVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeToClientVersion -> NodeToClientVersion -> Bool
$c/= :: NodeToClientVersion -> NodeToClientVersion -> Bool
== :: NodeToClientVersion -> NodeToClientVersion -> Bool
$c== :: 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
min :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
$cmin :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
max :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
$cmax :: NodeToClientVersion -> NodeToClientVersion -> NodeToClientVersion
>= :: NodeToClientVersion -> NodeToClientVersion -> Bool
$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
compare :: NodeToClientVersion -> NodeToClientVersion -> Ordering
$ccompare :: NodeToClientVersion -> NodeToClientVersion -> Ordering
$cp1Ord :: Eq 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
enumFromThenTo :: NodeToClientVersion
-> NodeToClientVersion
-> NodeToClientVersion
-> [NodeToClientVersion]
$cenumFromThenTo :: NodeToClientVersion
-> NodeToClientVersion
-> NodeToClientVersion
-> [NodeToClientVersion]
enumFromTo :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
$cenumFromTo :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
enumFromThen :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
$cenumFromThen :: NodeToClientVersion -> NodeToClientVersion -> [NodeToClientVersion]
enumFrom :: NodeToClientVersion -> [NodeToClientVersion]
$cenumFrom :: NodeToClientVersion -> [NodeToClientVersion]
fromEnum :: NodeToClientVersion -> Int
$cfromEnum :: NodeToClientVersion -> Int
toEnum :: Int -> NodeToClientVersion
$ctoEnum :: Int -> NodeToClientVersion
pred :: NodeToClientVersion -> NodeToClientVersion
$cpred :: NodeToClientVersion -> NodeToClientVersion
succ :: NodeToClientVersion -> NodeToClientVersion
$csucc :: NodeToClientVersion -> NodeToClientVersion
Enum, NodeToClientVersion
NodeToClientVersion
-> NodeToClientVersion -> Bounded NodeToClientVersion
forall a. a -> a -> Bounded a
maxBound :: NodeToClientVersion
$cmaxBound :: NodeToClientVersion
minBound :: NodeToClientVersion
$cminBound :: 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
showList :: [NodeToClientVersion] -> ShowS
$cshowList :: [NodeToClientVersion] -> ShowS
show :: NodeToClientVersion -> String
$cshow :: NodeToClientVersion -> String
showsPrec :: Int -> NodeToClientVersion -> ShowS
$cshowsPrec :: Int -> NodeToClientVersion -> ShowS
Show, Typeable)

-- | 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 :: forall fail a.
(a -> Term) -> (Term -> Either fail a) -> CodecCBORTerm fail a
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)

      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
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)


nodeToClientVersionBit :: Int
nodeToClientVersionBit :: Int
nodeToClientVersionBit = Int
15


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

instance Acceptable NodeToClientVersionData where
    acceptableVersion :: NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
acceptableVersion NodeToClientVersionData
local NodeToClientVersionData
remote
      | NodeToClientVersionData
local NodeToClientVersionData -> NodeToClientVersionData -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToClientVersionData
remote
      = NodeToClientVersionData -> Accept NodeToClientVersionData
forall vData. vData -> Accept vData
Accept NodeToClientVersionData
local
      | 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

nodeToClientCodecCBORTerm :: NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm :: NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm NodeToClientVersion
_ = CodecCBORTerm :: forall fail a.
(a -> Term) -> (Term -> Either fail a) -> CodecCBORTerm fail a
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 :: NetworkMagic
networkMagic :: NodeToClientVersionData -> NetworkMagic
networkMagic } =
        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.TInt Int
x) | 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 -> NodeToClientVersionData
NodeToClientVersionData (NetworkMagic -> NodeToClientVersionData)
-> NetworkMagic -> NodeToClientVersionData
forall a b. (a -> b) -> a -> b
$ 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
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
      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