{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Defines the different NTC and NTN versions for the HardFork Combinator.

module Ouroboros.Consensus.HardFork.Combinator.NetworkVersion (
    EraNodeToClientVersion (..)
  , HardForkNodeToClientVersion (..)
  , HardForkNodeToNodeVersion (..)
  , HardForkSpecificNodeToClientVersion (..)
  , HardForkSpecificNodeToNodeVersion (..)
  , isHardForkNodeToClientEnabled
  , isHardForkNodeToNodeEnabled
  ) where

import           Data.SOP.Constraint
import           Data.SOP.Strict
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.TypeFamilyWrappers

{-------------------------------------------------------------------------------
  Versioning
-------------------------------------------------------------------------------}

-- | Versioning of the specific additions made by the HFC to the @NodeToNode@
-- protocols, e.g., the era tag.
data HardForkSpecificNodeToNodeVersion =
    HardForkSpecificNodeToNodeVersion1
  deriving (HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
(HardForkSpecificNodeToNodeVersion
 -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> Eq HardForkSpecificNodeToNodeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
== :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c/= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
/= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
Eq, Eq HardForkSpecificNodeToNodeVersion
Eq HardForkSpecificNodeToNodeVersion =>
(HardForkSpecificNodeToNodeVersion
 -> HardForkSpecificNodeToNodeVersion -> Ordering)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion -> Bool)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion)
-> Ord HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Ordering
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
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 :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Ordering
compare :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Ordering
$c< :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
< :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c<= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
<= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c> :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
> :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$c>= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
>= :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion -> Bool
$cmax :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
max :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
$cmin :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
min :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
Ord, Int -> HardForkSpecificNodeToNodeVersion -> ShowS
[HardForkSpecificNodeToNodeVersion] -> ShowS
HardForkSpecificNodeToNodeVersion -> String
(Int -> HardForkSpecificNodeToNodeVersion -> ShowS)
-> (HardForkSpecificNodeToNodeVersion -> String)
-> ([HardForkSpecificNodeToNodeVersion] -> ShowS)
-> Show HardForkSpecificNodeToNodeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HardForkSpecificNodeToNodeVersion -> ShowS
showsPrec :: Int -> HardForkSpecificNodeToNodeVersion -> ShowS
$cshow :: HardForkSpecificNodeToNodeVersion -> String
show :: HardForkSpecificNodeToNodeVersion -> String
$cshowList :: [HardForkSpecificNodeToNodeVersion] -> ShowS
showList :: [HardForkSpecificNodeToNodeVersion] -> ShowS
Show, Int -> HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion -> Int
HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
(HardForkSpecificNodeToNodeVersion
 -> HardForkSpecificNodeToNodeVersion)
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion)
-> (Int -> HardForkSpecificNodeToNodeVersion)
-> (HardForkSpecificNodeToNodeVersion -> Int)
-> (HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> (HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> HardForkSpecificNodeToNodeVersion
    -> [HardForkSpecificNodeToNodeVersion])
-> Enum HardForkSpecificNodeToNodeVersion
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 :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
succ :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
$cpred :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
pred :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
$ctoEnum :: Int -> HardForkSpecificNodeToNodeVersion
toEnum :: Int -> HardForkSpecificNodeToNodeVersion
$cfromEnum :: HardForkSpecificNodeToNodeVersion -> Int
fromEnum :: HardForkSpecificNodeToNodeVersion -> Int
$cenumFrom :: HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
enumFrom :: HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
$cenumFromThen :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
enumFromThen :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
$cenumFromTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
enumFromTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
$cenumFromThenTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
enumFromThenTo :: HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> [HardForkSpecificNodeToNodeVersion]
Enum, HardForkSpecificNodeToNodeVersion
HardForkSpecificNodeToNodeVersion
-> HardForkSpecificNodeToNodeVersion
-> Bounded HardForkSpecificNodeToNodeVersion
forall a. a -> a -> Bounded a
$cminBound :: HardForkSpecificNodeToNodeVersion
minBound :: HardForkSpecificNodeToNodeVersion
$cmaxBound :: HardForkSpecificNodeToNodeVersion
maxBound :: HardForkSpecificNodeToNodeVersion
Bounded)

-- | Versioning of the specific additions made by the HFC to the @NodeToClient@
-- protocols, e.g., the era tag or the hard-fork specific queries.
data HardForkSpecificNodeToClientVersion =
    -- | Include the Genesis window in 'EraParams'.
    HardForkSpecificNodeToClientVersion3
  deriving (HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
(HardForkSpecificNodeToClientVersion
 -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> Eq HardForkSpecificNodeToClientVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
== :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c/= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
/= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
Eq, Eq HardForkSpecificNodeToClientVersion
Eq HardForkSpecificNodeToClientVersion =>
(HardForkSpecificNodeToClientVersion
 -> HardForkSpecificNodeToClientVersion -> Ordering)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion -> Bool)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion)
-> Ord HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Ordering
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
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 :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Ordering
compare :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Ordering
$c< :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
< :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c<= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
<= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c> :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
> :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$c>= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
>= :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion -> Bool
$cmax :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
max :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
$cmin :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
min :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
Ord, Int -> HardForkSpecificNodeToClientVersion -> ShowS
[HardForkSpecificNodeToClientVersion] -> ShowS
HardForkSpecificNodeToClientVersion -> String
(Int -> HardForkSpecificNodeToClientVersion -> ShowS)
-> (HardForkSpecificNodeToClientVersion -> String)
-> ([HardForkSpecificNodeToClientVersion] -> ShowS)
-> Show HardForkSpecificNodeToClientVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HardForkSpecificNodeToClientVersion -> ShowS
showsPrec :: Int -> HardForkSpecificNodeToClientVersion -> ShowS
$cshow :: HardForkSpecificNodeToClientVersion -> String
show :: HardForkSpecificNodeToClientVersion -> String
$cshowList :: [HardForkSpecificNodeToClientVersion] -> ShowS
showList :: [HardForkSpecificNodeToClientVersion] -> ShowS
Show, Int -> HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion -> Int
HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
(HardForkSpecificNodeToClientVersion
 -> HardForkSpecificNodeToClientVersion)
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion)
-> (Int -> HardForkSpecificNodeToClientVersion)
-> (HardForkSpecificNodeToClientVersion -> Int)
-> (HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> (HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> HardForkSpecificNodeToClientVersion
    -> [HardForkSpecificNodeToClientVersion])
-> Enum HardForkSpecificNodeToClientVersion
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 :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
succ :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
$cpred :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
pred :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
$ctoEnum :: Int -> HardForkSpecificNodeToClientVersion
toEnum :: Int -> HardForkSpecificNodeToClientVersion
$cfromEnum :: HardForkSpecificNodeToClientVersion -> Int
fromEnum :: HardForkSpecificNodeToClientVersion -> Int
$cenumFrom :: HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
enumFrom :: HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
$cenumFromThen :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
enumFromThen :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
$cenumFromTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
enumFromTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
$cenumFromThenTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
enumFromThenTo :: HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> [HardForkSpecificNodeToClientVersion]
Enum, HardForkSpecificNodeToClientVersion
HardForkSpecificNodeToClientVersion
-> HardForkSpecificNodeToClientVersion
-> Bounded HardForkSpecificNodeToClientVersion
forall a. a -> a -> Bounded a
$cminBound :: HardForkSpecificNodeToClientVersion
minBound :: HardForkSpecificNodeToClientVersion
$cmaxBound :: HardForkSpecificNodeToClientVersion
maxBound :: HardForkSpecificNodeToClientVersion
Bounded)

data HardForkNodeToNodeVersion xs where
  -- | Disable the HFC
  --
  -- This means that only the first era (@x@) is supported, and moreover, is
  -- compatible with serialisation used if the HFC would not be present at all.
  HardForkNodeToNodeDisabled ::
       BlockNodeToNodeVersion x
    -> HardForkNodeToNodeVersion (x ': xs)

  -- | Enable the HFC
  --
  -- Serialised values will always include tags inserted by the HFC to
  -- distinguish one era from another. We version the hard-fork specific parts
  -- with 'HardForkSpecificNodeToNodeVersion'.
  HardForkNodeToNodeEnabled ::
       HardForkSpecificNodeToNodeVersion
    -> NP WrapNodeToNodeVersion xs
    -> HardForkNodeToNodeVersion xs

data HardForkNodeToClientVersion xs where
  -- | Disable the HFC
  --
  -- See 'HardForkNodeToNodeDisabled'
  HardForkNodeToClientDisabled ::
       BlockNodeToClientVersion x
    -> HardForkNodeToClientVersion (x ': xs)

  -- | Enable the HFC
  --
  -- See 'HardForkNodeToNodeEnabled'
  HardForkNodeToClientEnabled ::
       HardForkSpecificNodeToClientVersion
    -> NP EraNodeToClientVersion xs
    -> HardForkNodeToClientVersion xs

data EraNodeToClientVersion blk =
    EraNodeToClientEnabled !(BlockNodeToClientVersion blk)
  | EraNodeToClientDisabled

deriving instance Show (BlockNodeToClientVersion blk) => Show (EraNodeToClientVersion blk)

deriving instance Eq (BlockNodeToClientVersion blk) => Eq (EraNodeToClientVersion blk)

deriving instance (All HasNetworkProtocolVersion xs, All (Compose Show WrapNodeToNodeVersion) xs) => Show (HardForkNodeToNodeVersion xs)
deriving instance (All HasNetworkProtocolVersion xs, All (Compose Show EraNodeToClientVersion) xs) => Show (HardForkNodeToClientVersion xs)

deriving instance (All HasNetworkProtocolVersion xs, All (Compose Eq WrapNodeToNodeVersion) xs) => Eq (HardForkNodeToNodeVersion xs)
deriving instance (All HasNetworkProtocolVersion xs, All (Compose Eq EraNodeToClientVersion) xs) => Eq (HardForkNodeToClientVersion xs)

instance ( All (Compose Show WrapNodeToNodeVersion) xs
         , All (Compose Eq WrapNodeToNodeVersion) xs
         , All (Compose Show EraNodeToClientVersion) xs
         , All (Compose Eq EraNodeToClientVersion) xs
         , All HasNetworkProtocolVersion xs)
    => HasNetworkProtocolVersion (HardForkBlock xs) where
  type BlockNodeToNodeVersion   (HardForkBlock xs) = HardForkNodeToNodeVersion   xs
  type BlockNodeToClientVersion (HardForkBlock xs) = HardForkNodeToClientVersion xs

isHardForkNodeToNodeEnabled :: HardForkNodeToNodeVersion xs -> Bool
isHardForkNodeToNodeEnabled :: forall (xs :: [*]). HardForkNodeToNodeVersion xs -> Bool
isHardForkNodeToNodeEnabled HardForkNodeToNodeEnabled {} = Bool
True
isHardForkNodeToNodeEnabled HardForkNodeToNodeVersion xs
_                            = Bool
False

isHardForkNodeToClientEnabled :: HardForkNodeToClientVersion xs -> Bool
isHardForkNodeToClientEnabled :: forall (xs :: [*]). HardForkNodeToClientVersion xs -> Bool
isHardForkNodeToClientEnabled HardForkNodeToClientEnabled {} = Bool
True
isHardForkNodeToClientEnabled HardForkNodeToClientVersion xs
_                              = Bool
False