{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# 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 Data.Map.Strict as Map
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

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           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
$cto :: forall x. Rep (BlockConfig ByronBlock) x -> BlockConfig ByronBlock
$cfrom :: forall x. BlockConfig ByronBlock -> Rep (BlockConfig ByronBlock) x
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
showTypeOf :: Proxy (BlockConfig ByronBlock) -> String
$cshowTypeOf :: Proxy (BlockConfig ByronBlock) -> String
wNoThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> BlockConfig ByronBlock -> IO (Maybe ThunkInfo)
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
$cto :: forall x. Rep (CodecConfig ByronBlock) x -> CodecConfig ByronBlock
$cfrom :: forall x. CodecConfig ByronBlock -> Rep (CodecConfig ByronBlock) x
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
showTypeOf :: Proxy (CodecConfig ByronBlock) -> String
$cshowTypeOf :: Proxy (CodecConfig ByronBlock) -> String
wNoThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CodecConfig ByronBlock -> IO (Maybe ThunkInfo)
NoThunks)

mkByronCodecConfig :: CC.Genesis.Config -> CodecConfig ByronBlock
mkByronCodecConfig :: Config -> CodecConfig ByronBlock
mkByronCodecConfig Config
cfg = ByronCodecConfig :: EpochSlots -> CodecConfig ByronBlock
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
$cto :: forall x.
Rep (StorageConfig ByronBlock) x -> StorageConfig ByronBlock
$cfrom :: forall x.
StorageConfig ByronBlock -> Rep (StorageConfig ByronBlock) x
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
showTypeOf :: Proxy (StorageConfig ByronBlock) -> String
$cshowTypeOf :: Proxy (StorageConfig ByronBlock) -> String
wNoThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> StorageConfig ByronBlock -> IO (Maybe ThunkInfo)
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 {
      configGenesisData :: GenesisData
CC.Genesis.configGenesisData = (Config -> GenesisData
CC.Genesis.configGenesisData Config
cfg) {
          gdAvvmDistr :: GenesisAvvmBalances
CC.Genesis.gdAvvmDistr = Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances
CC.Genesis.GenesisAvvmBalances Map CompactRedeemVerificationKey Lovelace
forall k a. Map k a
Map.empty
        }
    }