{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Byron.Ledger.Config (
    -- * Block config
    BlockConfig (..)
  , byronEpochSlots
  , byronGenesisHash
  , byronProtocolMagic
  , byronProtocolMagicId
    -- * Codec config
  , CodecConfig (..)
  , mkByronCodecConfig
    -- * Storage config
  , StorageConfig (..)
    -- * Compact genesis config
  , compactGenesisConfig
  ) where

import qualified Cardano.Chain.Genesis as CC.Genesis
import qualified Cardano.Chain.Slotting as CC.Slot
import qualified Cardano.Chain.Update as CC.Update
import qualified Cardano.Crypto as Crypto
import qualified Data.Map.Strict as Map
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger.Block

{-------------------------------------------------------------------------------
  Block config
-------------------------------------------------------------------------------}

-- | Extended configuration we need for Byron
data instance BlockConfig ByronBlock = ByronConfig {
      -- | Genesis configuration
      BlockConfig ByronBlock -> Config
byronGenesisConfig   :: !CC.Genesis.Config

      -- | Node protocol version
      --
      -- NOTE: This is /static/ for the node, and may not correspond to what's
      -- on the chain. It's the protocol supported by /this/ node; to change it,
      -- you'd have to change the software.
    , BlockConfig ByronBlock -> ProtocolVersion
byronProtocolVersion :: !CC.Update.ProtocolVersion

      -- | Node software version
      --
      -- Like 'byronProtocolVersion', this is independent from the chain.
    , BlockConfig ByronBlock -> SoftwareVersion
byronSoftwareVersion :: !CC.Update.SoftwareVersion
    }
  deriving ((forall x.
 BlockConfig ByronBlock -> Rep (BlockConfig ByronBlock) x)
-> (forall x.
    Rep (BlockConfig ByronBlock) x -> BlockConfig ByronBlock)
-> Generic (BlockConfig ByronBlock)
forall x. Rep (BlockConfig ByronBlock) x -> BlockConfig ByronBlock
forall x. BlockConfig ByronBlock -> Rep (BlockConfig ByronBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockConfig ByronBlock -> Rep (BlockConfig ByronBlock) x
from :: forall x. BlockConfig ByronBlock -> Rep (BlockConfig ByronBlock) x
$cto :: forall x. Rep (BlockConfig ByronBlock) x -> BlockConfig ByronBlock
to :: forall x. Rep (BlockConfig ByronBlock) x -> BlockConfig ByronBlock
Generic, Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
Proxy (BlockConfig ByronBlock) -> String
(Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo))
-> (Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo))
-> (Proxy (BlockConfig ByronBlock) -> String)
-> NoThunks (BlockConfig ByronBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (BlockConfig ByronBlock) -> String
showTypeOf :: Proxy (BlockConfig ByronBlock) -> String
NoThunks)

byronGenesisHash :: BlockConfig ByronBlock -> CC.Genesis.GenesisHash
byronGenesisHash :: BlockConfig ByronBlock -> GenesisHash
byronGenesisHash = Config -> GenesisHash
CC.Genesis.configGenesisHash (Config -> GenesisHash)
-> (BlockConfig ByronBlock -> Config)
-> BlockConfig ByronBlock
-> GenesisHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> Config
byronGenesisConfig

byronProtocolMagicId :: BlockConfig ByronBlock -> Crypto.ProtocolMagicId
byronProtocolMagicId :: BlockConfig ByronBlock -> ProtocolMagicId
byronProtocolMagicId = AProtocolMagic () -> ProtocolMagicId
forall a. AProtocolMagic a -> ProtocolMagicId
Crypto.getProtocolMagicId (AProtocolMagic () -> ProtocolMagicId)
-> (BlockConfig ByronBlock -> AProtocolMagic ())
-> BlockConfig ByronBlock
-> ProtocolMagicId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> AProtocolMagic ()
byronProtocolMagic

byronProtocolMagic :: BlockConfig ByronBlock -> Crypto.ProtocolMagic
byronProtocolMagic :: BlockConfig ByronBlock -> AProtocolMagic ()
byronProtocolMagic = Config -> AProtocolMagic ()
CC.Genesis.configProtocolMagic (Config -> AProtocolMagic ())
-> (BlockConfig ByronBlock -> Config)
-> BlockConfig ByronBlock
-> AProtocolMagic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> Config
byronGenesisConfig

byronEpochSlots :: BlockConfig ByronBlock -> CC.Slot.EpochSlots
byronEpochSlots :: BlockConfig ByronBlock -> EpochSlots
byronEpochSlots = Config -> EpochSlots
CC.Genesis.configEpochSlots (Config -> EpochSlots)
-> (BlockConfig ByronBlock -> Config)
-> BlockConfig ByronBlock
-> EpochSlots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> Config
byronGenesisConfig

{-------------------------------------------------------------------------------
  Codec config
-------------------------------------------------------------------------------}

newtype instance CodecConfig ByronBlock = ByronCodecConfig {
      CodecConfig ByronBlock -> EpochSlots
getByronEpochSlots :: CC.Slot.EpochSlots
    }
  deriving ((forall x.
 CodecConfig ByronBlock -> Rep (CodecConfig ByronBlock) x)
-> (forall x.
    Rep (CodecConfig ByronBlock) x -> CodecConfig ByronBlock)
-> Generic (CodecConfig ByronBlock)
forall x. Rep (CodecConfig ByronBlock) x -> CodecConfig ByronBlock
forall x. CodecConfig ByronBlock -> Rep (CodecConfig ByronBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CodecConfig ByronBlock -> Rep (CodecConfig ByronBlock) x
from :: forall x. CodecConfig ByronBlock -> Rep (CodecConfig ByronBlock) x
$cto :: forall x. Rep (CodecConfig ByronBlock) x -> CodecConfig ByronBlock
to :: forall x. Rep (CodecConfig ByronBlock) x -> CodecConfig ByronBlock
Generic, Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
Proxy (CodecConfig ByronBlock) -> String
(Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo))
-> (Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig ByronBlock) -> String)
-> NoThunks (CodecConfig ByronBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CodecConfig ByronBlock) -> String
showTypeOf :: Proxy (CodecConfig ByronBlock) -> String
NoThunks)

mkByronCodecConfig :: CC.Genesis.Config -> CodecConfig ByronBlock
mkByronCodecConfig :: Config -> CodecConfig ByronBlock
mkByronCodecConfig Config
cfg = ByronCodecConfig {
      getByronEpochSlots :: EpochSlots
getByronEpochSlots = Config -> EpochSlots
CC.Genesis.configEpochSlots Config
cfg
    }

{-------------------------------------------------------------------------------
  Storage config
-------------------------------------------------------------------------------}

newtype instance StorageConfig ByronBlock = ByronStorageConfig {
      -- | We need the 'BlockConfig' to be able to forge an EBB in
      -- 'nodeInitChainDB'.
      StorageConfig ByronBlock -> BlockConfig ByronBlock
getByronBlockConfig :: BlockConfig ByronBlock
    }
  deriving ((forall x.
 StorageConfig ByronBlock -> Rep (StorageConfig ByronBlock) x)
-> (forall x.
    Rep (StorageConfig ByronBlock) x -> StorageConfig ByronBlock)
-> Generic (StorageConfig ByronBlock)
forall x.
Rep (StorageConfig ByronBlock) x -> StorageConfig ByronBlock
forall x.
StorageConfig ByronBlock -> Rep (StorageConfig ByronBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
StorageConfig ByronBlock -> Rep (StorageConfig ByronBlock) x
from :: forall x.
StorageConfig ByronBlock -> Rep (StorageConfig ByronBlock) x
$cto :: forall x.
Rep (StorageConfig ByronBlock) x -> StorageConfig ByronBlock
to :: forall x.
Rep (StorageConfig ByronBlock) x -> StorageConfig ByronBlock
Generic, Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
Proxy (StorageConfig ByronBlock) -> String
(Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo))
-> (Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig ByronBlock) -> String)
-> NoThunks (StorageConfig ByronBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (StorageConfig ByronBlock) -> String
showTypeOf :: Proxy (StorageConfig ByronBlock) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Compact genesis config
-------------------------------------------------------------------------------}

-- | Byron's genesis config contains the AVVM balances, of which there are +14k
-- in mainnet's genesis config. These balances are only used to create the
-- initial ledger state, there is no reason to keep them in memory afterwards.
--
-- This function empties the 'gdAvvmDistr' field in the genesis config. As we
-- keep Byron's genesis config in memory (even in later eras), this can save us
-- a bit of memory.
compactGenesisConfig :: CC.Genesis.Config -> CC.Genesis.Config
compactGenesisConfig :: Config -> Config
compactGenesisConfig Config
cfg = Config
cfg {
      CC.Genesis.configGenesisData = (CC.Genesis.configGenesisData cfg) {
          CC.Genesis.gdAvvmDistr = CC.Genesis.GenesisAvvmBalances Map.empty
        }
    }