module Ouroboros.Consensus.ByronSpec.Ledger.Forge (forgeByronSpecBlock) where

import qualified Byron.Spec.Chain.STS.Block as Spec
import qualified Byron.Spec.Ledger.Core as Spec
import qualified Byron.Spec.Ledger.Update as Spec
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.ByronSpec.Ledger.Accessors
import           Ouroboros.Consensus.ByronSpec.Ledger.Block
import           Ouroboros.Consensus.ByronSpec.Ledger.Conversions
import qualified Ouroboros.Consensus.ByronSpec.Ledger.GenTx as GenTx
import           Ouroboros.Consensus.ByronSpec.Ledger.Ledger
import           Ouroboros.Consensus.ByronSpec.Ledger.Mempool
import           Ouroboros.Consensus.ByronSpec.Ledger.Orphans ()

{-------------------------------------------------------------------------------
  Forging
-------------------------------------------------------------------------------}

forgeByronSpecBlock :: BlockNo
                    -> SlotNo
                    -> Ticked (LedgerState ByronSpecBlock)
                    -> [Validated (GenTx ByronSpecBlock)]
                    -> Spec.VKey
                    -> ByronSpecBlock
forgeByronSpecBlock :: BlockNo
-> SlotNo
-> Ticked (LedgerState ByronSpecBlock)
-> [Validated (GenTx ByronSpecBlock)]
-> VKey
-> ByronSpecBlock
forgeByronSpecBlock BlockNo
curBlockNo SlotNo
curSlotNo (TickedByronSpecLedgerState Maybe SlotNo
_ State CHAIN
st) [Validated (GenTx ByronSpecBlock)]
txs VKey
vkey =
    ByronSpecBlock {
        byronSpecBlock :: Block
byronSpecBlock     = Block
block
      , byronSpecBlockNo :: BlockNo
byronSpecBlockNo   = BlockNo
curBlockNo
      , byronSpecBlockHash :: Hash
byronSpecBlockHash = BlockHeader -> Hash
Spec.bhHash (BlockHeader -> Hash) -> BlockHeader -> Hash
forall a b. (a -> b) -> a -> b
$ Block -> BlockHeader
Spec._bHeader Block
block
      }
  where
    ([DCert]
ds, [Tx]
ts, [UProp]
us, [Vote]
vs) =
        [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
GenTx.partition
          ((Validated (GenTx ByronSpecBlock) -> ByronSpecGenTx)
-> [Validated (GenTx ByronSpecBlock)] -> [ByronSpecGenTx]
forall a b. (a -> b) -> [a] -> [b]
map (GenTx ByronSpecBlock -> ByronSpecGenTx
unByronSpecGenTx (GenTx ByronSpecBlock -> ByronSpecGenTx)
-> (Validated (GenTx ByronSpecBlock) -> GenTx ByronSpecBlock)
-> Validated (GenTx ByronSpecBlock)
-> ByronSpecGenTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx ByronSpecBlock) -> GenTx ByronSpecBlock
forgetValidatedByronSpecGenTx) [Validated (GenTx ByronSpecBlock)]
txs)

    -- TODO: Don't take protocol version from ledger state
    -- <https://github.com/IntersectMBO/ouroboros-network/issues/1495>
    block :: Spec.Block
    block :: Block
block = Hash
-> Slot
-> VKey
-> ProtVer
-> [DCert]
-> Maybe UProp
-> [Vote]
-> [Tx]
-> Block
Spec.mkBlock
              (GetChainState Hash
getChainStateHash State CHAIN
st)
              (SlotNo -> Slot
toByronSpecSlotNo SlotNo
curSlotNo)
              VKey
vkey
              (UPIState -> ProtVer
Spec.protocolVersion (UPIState -> ProtVer) -> UPIState -> ProtVer
forall a b. (a -> b) -> a -> b
$ GetChainState UPIState
getChainStateUPIState State CHAIN
st)
              [DCert]
ds
              (case [UProp]
us of
                 []  -> Maybe UProp
forall a. Maybe a
Nothing
                 [UProp
u] -> UProp -> Maybe UProp
forall a. a -> Maybe a
Just UProp
u
                 [UProp]
_   -> [Char] -> Maybe UProp
forall a. HasCallStack => [Char] -> a
error [Char]
"forgeByronSpecBlock: multiple update proposals")
              [Vote]
vs
              [Tx]
ts