{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Cardano.ByronHFC (ByronBlockHFC) where

import qualified Data.Map.Strict as Map
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger
import           Ouroboros.Consensus.Byron.Node ()
import           Ouroboros.Consensus.Cardano.CanHardFork
import           Ouroboros.Consensus.Cardano.Node ()
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.Degenerate
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Storage.Serialisation

{-------------------------------------------------------------------------------
  Synonym for convenience
-------------------------------------------------------------------------------}

-- | Byron as the single era in the hard fork combinator
type ByronBlockHFC = HardForkBlock '[ByronBlock]

{-------------------------------------------------------------------------------
  NoHardForks instance
-------------------------------------------------------------------------------}

instance NoHardForks ByronBlock where
  getEraParams :: TopLevelConfig ByronBlock -> EraParams
getEraParams TopLevelConfig ByronBlock
cfg =
      Config -> EraParams
byronEraParamsNeverHardForks (BlockConfig ByronBlock -> Config
byronGenesisConfig (TopLevelConfig ByronBlock -> BlockConfig ByronBlock
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock TopLevelConfig ByronBlock
cfg))
  toPartialLedgerConfig :: forall (proxy :: * -> *).
proxy ByronBlock
-> LedgerConfig ByronBlock -> PartialLedgerConfig ByronBlock
toPartialLedgerConfig proxy ByronBlock
_ LedgerConfig ByronBlock
cfg = ByronPartialLedgerConfig {
        byronLedgerConfig :: LedgerConfig ByronBlock
byronLedgerConfig    = LedgerConfig ByronBlock
cfg
      , byronTriggerHardFork :: TriggerHardFork
byronTriggerHardFork = TriggerHardFork
TriggerHardForkNotDuringThisExecution
      }

{-------------------------------------------------------------------------------
  SupportedNetworkProtocolVersion instance
-------------------------------------------------------------------------------}

-- | Forward to the ByronBlock instance. Only supports
-- 'HardForkNodeToNodeDisabled', which is compatible with nodes running with
-- 'ByronBlock'.
instance SupportedNetworkProtocolVersion ByronBlockHFC where
  supportedNodeToNodeVersions :: Proxy ByronBlockHFC
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC)
supportedNodeToNodeVersions Proxy ByronBlockHFC
_ =
      (BlockNodeToNodeVersion ByronBlock
 -> BlockNodeToNodeVersion ByronBlockHFC)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map BlockNodeToNodeVersion ByronBlock
-> BlockNodeToNodeVersion ByronBlockHFC
BlockNodeToNodeVersion ByronBlock
-> HardForkNodeToNodeVersion '[ByronBlock]
forall x (xs1 :: [*]).
BlockNodeToNodeVersion x -> HardForkNodeToNodeVersion (x : xs1)
HardForkNodeToNodeDisabled (Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
 -> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC))
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC)
forall a b. (a -> b) -> a -> b
$
      Proxy ByronBlock
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)

  supportedNodeToClientVersions :: Proxy ByronBlockHFC
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC)
supportedNodeToClientVersions Proxy ByronBlockHFC
_ =
      (BlockNodeToClientVersion ByronBlock
 -> BlockNodeToClientVersion ByronBlockHFC)
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map BlockNodeToClientVersion ByronBlock
-> BlockNodeToClientVersion ByronBlockHFC
BlockNodeToClientVersion ByronBlock
-> HardForkNodeToClientVersion '[ByronBlock]
forall x (xs1 :: [*]).
BlockNodeToClientVersion x -> HardForkNodeToClientVersion (x : xs1)
HardForkNodeToClientDisabled (Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
 -> Map
      NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC))
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC)
forall a b. (a -> b) -> a -> b
$
      Proxy ByronBlock
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)

  latestReleasedNodeVersion :: Proxy ByronBlockHFC
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion = Proxy ByronBlockHFC
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault

{-------------------------------------------------------------------------------
  SerialiseHFC instance
-------------------------------------------------------------------------------}

-- | Forward to the ByronBlock instance, this means we don't add an era
-- wrapper around blocks on disk. This makes sure we're compatible with the
-- existing Byron blocks.
instance SerialiseHFC '[ByronBlock] where
  encodeDiskHfcBlock :: CodecConfig ByronBlockHFC -> ByronBlockHFC -> Encoding
encodeDiskHfcBlock (DegenCodecConfig CodecConfig ByronBlock
ccfg) (DegenBlock ByronBlock
b) =
      CodecConfig ByronBlock -> ByronBlock -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig ByronBlock
ccfg ByronBlock
b
  decodeDiskHfcBlock :: CodecConfig ByronBlockHFC
-> forall s. Decoder s (ByteString -> ByronBlockHFC)
decodeDiskHfcBlock (DegenCodecConfig CodecConfig ByronBlock
ccfg) =
      (ByronBlock -> ByronBlockHFC)
-> (ByteString -> ByronBlock) -> ByteString -> ByronBlockHFC
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronBlock -> ByronBlockHFC
forall b. NoHardForks b => b -> HardForkBlock '[b]
DegenBlock ((ByteString -> ByronBlock) -> ByteString -> ByronBlockHFC)
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlockHFC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig ByronBlock
-> forall s. Decoder s (ByteString -> ByronBlock)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig ByronBlock
ccfg
  reconstructHfcPrefixLen :: forall (proxy :: * -> *). proxy (Header ByronBlockHFC) -> PrefixLen
reconstructHfcPrefixLen proxy (Header ByronBlockHFC)
_ =
      Proxy (Header ByronBlock) -> PrefixLen
forall (proxy :: * -> *). proxy (Header ByronBlock) -> PrefixLen
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk) -> PrefixLen
reconstructPrefixLen (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Header ByronBlock))
  reconstructHfcNestedCtxt :: forall (proxy :: * -> *).
proxy (Header ByronBlockHFC)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) ByronBlockHFC
reconstructHfcNestedCtxt proxy (Header ByronBlockHFC)
_ ShortByteString
prefix SizeInBytes
blockSize =
      (forall a.
 NestedCtxt_ ByronBlock Header a
 -> NestedCtxt_ ByronBlockHFC Header a)
-> SomeSecond (NestedCtxt Header) ByronBlock
-> SomeSecond (NestedCtxt Header) ByronBlockHFC
forall blk (f :: * -> *) blk' (f' :: * -> *).
(forall a. NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a)
-> SomeSecond (NestedCtxt f) blk -> SomeSecond (NestedCtxt f') blk'
mapSomeNestedCtxt NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlockHFC Header a
forall a.
NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlockHFC Header a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ (SomeSecond (NestedCtxt Header) ByronBlock
 -> SomeSecond (NestedCtxt Header) ByronBlockHFC)
-> SomeSecond (NestedCtxt Header) ByronBlock
-> SomeSecond (NestedCtxt Header) ByronBlockHFC
forall a b. (a -> b) -> a -> b
$
        Proxy (Header ByronBlock)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) ByronBlock
forall (proxy :: * -> *).
proxy (Header ByronBlock)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) ByronBlock
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk)
-> ShortByteString -> SizeInBytes -> SomeSecond (NestedCtxt f) blk
reconstructNestedCtxt (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Header ByronBlock)) ShortByteString
prefix SizeInBytes
blockSize
  getHfcBinaryBlockInfo :: ByronBlockHFC -> BinaryBlockInfo
getHfcBinaryBlockInfo (DegenBlock ByronBlock
b) =
      ByronBlock -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo ByronBlock
b