{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Cardano.Chain.Update.ProtocolVersion
  ( ProtocolVersion (..),
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, enforceSize)
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting (bprint, shown)
import Formatting.Buildable (Buildable (..))
import NoThunks.Class (NoThunks (..))
import qualified Prelude

-- | Communication protocol version
data ProtocolVersion = ProtocolVersion
  { ProtocolVersion -> Word16
pvMajor :: !Word16,
    ProtocolVersion -> Word16
pvMinor :: !Word16,
    ProtocolVersion -> Word8
pvAlt :: !Word8
  }
  deriving (ProtocolVersion -> ProtocolVersion -> Bool
(ProtocolVersion -> ProtocolVersion -> Bool)
-> (ProtocolVersion -> ProtocolVersion -> Bool)
-> Eq ProtocolVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolVersion -> ProtocolVersion -> Bool
$c/= :: ProtocolVersion -> ProtocolVersion -> Bool
== :: ProtocolVersion -> ProtocolVersion -> Bool
$c== :: ProtocolVersion -> ProtocolVersion -> Bool
Eq, (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
$cto :: forall x. Rep ProtocolVersion x -> ProtocolVersion
$cfrom :: forall x. ProtocolVersion -> Rep ProtocolVersion x
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
min :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
$cmin :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
max :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
$cmax :: ProtocolVersion -> ProtocolVersion -> ProtocolVersion
>= :: ProtocolVersion -> ProtocolVersion -> Bool
$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
compare :: ProtocolVersion -> ProtocolVersion -> Ordering
$ccompare :: ProtocolVersion -> ProtocolVersion -> Ordering
$cp1Ord :: Eq ProtocolVersion
Ord)
  deriving anyclass (ProtocolVersion -> ()
(ProtocolVersion -> ()) -> NFData ProtocolVersion
forall a. (a -> ()) -> NFData a
rnf :: ProtocolVersion -> ()
$crnf :: ProtocolVersion -> ()
NFData, Context -> ProtocolVersion -> IO (Maybe ThunkInfo)
Proxy ProtocolVersion -> String
(Context -> ProtocolVersion -> IO (Maybe ThunkInfo))
-> (Context -> ProtocolVersion -> IO (Maybe ThunkInfo))
-> (Proxy ProtocolVersion -> String)
-> NoThunks ProtocolVersion
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ProtocolVersion -> String
$cshowTypeOf :: Proxy ProtocolVersion -> String
wNoThunks :: Context -> ProtocolVersion -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ProtocolVersion -> IO (Maybe ThunkInfo)
noThunks :: Context -> ProtocolVersion -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ProtocolVersion -> IO (Maybe ThunkInfo)
NoThunks)

instance Show ProtocolVersion where
  show :: ProtocolVersion -> String
show ProtocolVersion
pv =
    String -> Context -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [Word16 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (ProtocolVersion -> Word16
pvMajor ProtocolVersion
pv), Word16 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (ProtocolVersion -> Word16
pvMinor ProtocolVersion
pv), Word8 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (ProtocolVersion -> Word8
pvAlt ProtocolVersion
pv)]

instance Buildable ProtocolVersion where
  build :: ProtocolVersion -> Builder
build = Format Builder (ProtocolVersion -> Builder)
-> ProtocolVersion -> Builder
forall a. Format Builder a -> a
bprint Format Builder (ProtocolVersion -> Builder)
forall a r. Show a => Format r (a -> r)
shown

-- Used for debugging purposes only
instance ToJSON ProtocolVersion

instance ToCBOR ProtocolVersion where
  toCBOR :: ProtocolVersion -> Encoding
toCBOR ProtocolVersion
pv =
    Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolVersion -> Word16
pvMajor ProtocolVersion
pv) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolVersion -> Word16
pvMinor ProtocolVersion
pv)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
        (ProtocolVersion -> Word8
pvAlt ProtocolVersion
pv)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ProtocolVersion -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
f Proxy ProtocolVersion
pv =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word16 -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
f (ProtocolVersion -> Word16
pvMajor (ProtocolVersion -> Word16)
-> Proxy ProtocolVersion -> Proxy Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ProtocolVersion
pv)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word16 -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
f (ProtocolVersion -> Word16
pvMinor (ProtocolVersion -> Word16)
-> Proxy ProtocolVersion -> Proxy Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ProtocolVersion
pv)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word8 -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
f (ProtocolVersion -> Word8
pvAlt (ProtocolVersion -> Word8) -> Proxy ProtocolVersion -> Proxy Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ProtocolVersion
pv)

instance FromCBOR ProtocolVersion where
  fromCBOR :: Decoder s ProtocolVersion
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ProtocolVersion" Int
3
    Word16 -> Word16 -> Word8 -> ProtocolVersion
ProtocolVersion (Word16 -> Word16 -> Word8 -> ProtocolVersion)
-> Decoder s Word16
-> Decoder s (Word16 -> Word8 -> ProtocolVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word16
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Word16 -> Word8 -> ProtocolVersion)
-> Decoder s Word16 -> Decoder s (Word8 -> ProtocolVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word16
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Word8 -> ProtocolVersion)
-> Decoder s Word8 -> Decoder s ProtocolVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word8
forall a s. FromCBOR a => Decoder s a
fromCBOR