module Ouroboros.Consensus.Byron.Ledger.Conversions (
    -- * From @cardano-ledger-byron@ to @ouroboros-consensus@
    fromByronBlockCount
  , fromByronBlockNo
  , fromByronEpochSlots
  , fromByronSlotLength
  , fromByronSlotNo
    -- * From @ouroboros-consensus@ to @cardano-ledger-byron@
  , toByronBlockCount
  , toByronSlotLength
  , toByronSlotNo
    -- * Extract info from the genesis config
  , genesisNumCoreNodes
  , genesisSecurityParam
  , genesisSlotLength
  ) where

import           Data.Coerce
import qualified Data.Set as Set
import           Numeric.Natural (Natural)

import qualified Cardano.Chain.Common as CC
import qualified Cardano.Chain.Genesis as Genesis
import qualified Cardano.Chain.Slotting as CC
import qualified Cardano.Chain.Update as CC

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime
import           Ouroboros.Consensus.Byron.Ledger.Orphans ()
import           Ouroboros.Consensus.Config.SecurityParam
import           Ouroboros.Consensus.Node.ProtocolInfo

{-------------------------------------------------------------------------------
  From @cardano-ledger-byron@ to @ouroboros-consensus@
-------------------------------------------------------------------------------}

fromByronSlotNo :: CC.SlotNumber -> SlotNo
fromByronSlotNo :: SlotNumber -> SlotNo
fromByronSlotNo = SlotNumber -> SlotNo
coerce

fromByronBlockNo :: CC.ChainDifficulty -> BlockNo
fromByronBlockNo :: ChainDifficulty -> BlockNo
fromByronBlockNo = ChainDifficulty -> BlockNo
coerce

fromByronBlockCount :: CC.BlockCount -> SecurityParam
fromByronBlockCount :: BlockCount -> SecurityParam
fromByronBlockCount (CC.BlockCount Word64
k) = Word64 -> SecurityParam
SecurityParam Word64
k

fromByronEpochSlots :: CC.EpochSlots -> EpochSize
fromByronEpochSlots :: EpochSlots -> EpochSize
fromByronEpochSlots (CC.EpochSlots Word64
n) = Word64 -> EpochSize
EpochSize Word64
n

fromByronSlotLength :: Natural -> SlotLength
fromByronSlotLength :: Natural -> SlotLength
fromByronSlotLength = Integer -> SlotLength
slotLengthFromMillisec
                    (Integer -> SlotLength)
-> (Natural -> Integer) -> Natural -> SlotLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Natural -> Integer)

{-------------------------------------------------------------------------------
  From @ouroboros-consensus@ to @cardano-ledger-byron@
-------------------------------------------------------------------------------}

toByronSlotNo :: SlotNo -> CC.SlotNumber
toByronSlotNo :: SlotNo -> SlotNumber
toByronSlotNo = SlotNo -> SlotNumber
coerce

toByronBlockCount :: SecurityParam -> CC.BlockCount
toByronBlockCount :: SecurityParam -> BlockCount
toByronBlockCount (SecurityParam Word64
k) = Word64 -> BlockCount
CC.BlockCount Word64
k

toByronSlotLength :: SlotLength -> Natural
toByronSlotLength :: SlotLength -> Natural
toByronSlotLength = (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Integer -> Natural)
                  (Integer -> Natural)
-> (SlotLength -> Integer) -> SlotLength -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotLength -> Integer
slotLengthToMillisec

{-------------------------------------------------------------------------------
  Extract info from genesis
-------------------------------------------------------------------------------}

genesisSecurityParam :: Genesis.Config -> SecurityParam
genesisSecurityParam :: Config -> SecurityParam
genesisSecurityParam =
      BlockCount -> SecurityParam
fromByronBlockCount
    (BlockCount -> SecurityParam)
-> (Config -> BlockCount) -> Config -> SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenesisData -> BlockCount
Genesis.gdK
    (GenesisData -> BlockCount)
-> (Config -> GenesisData) -> Config -> BlockCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GenesisData
Genesis.configGenesisData

genesisNumCoreNodes :: Genesis.Config -> NumCoreNodes
genesisNumCoreNodes :: Config -> NumCoreNodes
genesisNumCoreNodes =
      Word64 -> NumCoreNodes
NumCoreNodes
    (Word64 -> NumCoreNodes)
-> (Config -> Word64) -> Config -> NumCoreNodes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Int -> Word64) -> (Config -> Int) -> Config -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set KeyHash -> Int
forall a. Set a -> Int
Set.size
    (Set KeyHash -> Int) -> (Config -> Set KeyHash) -> Config -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenesisKeyHashes -> Set KeyHash
Genesis.unGenesisKeyHashes
    (GenesisKeyHashes -> Set KeyHash)
-> (Config -> GenesisKeyHashes) -> Config -> Set KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenesisData -> GenesisKeyHashes
Genesis.gdGenesisKeyHashes
    (GenesisData -> GenesisKeyHashes)
-> (Config -> GenesisData) -> Config -> GenesisKeyHashes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GenesisData
Genesis.configGenesisData

genesisSlotLength :: Genesis.Config -> Natural
genesisSlotLength :: Config -> Natural
genesisSlotLength =
      ProtocolParameters -> Natural
CC.ppSlotDuration
    (ProtocolParameters -> Natural)
-> (Config -> ProtocolParameters) -> Config -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> ProtocolParameters
Genesis.configProtocolParameters