{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.ThreadNet.Infra.Byron.ProtocolInfo
  ( mkLeaderCredentials
  , mkProtocolByron
  , theProposedProtocolVersion
  , theProposedSoftwareVersion
  ) where

import qualified Cardano.Chain.Common as Common
import qualified Cardano.Chain.Delegation as Delegation
import qualified Cardano.Chain.Genesis as Genesis
import qualified Cardano.Chain.Update as Update
import qualified Cardano.Crypto as Crypto
import Data.Foldable (find)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import GHC.Stack (HasCallStack)
import Ouroboros.Consensus.Block.Forging (BlockForging)
import Ouroboros.Consensus.Byron.Crypto.DSIGN
  ( ByronDSIGN
  , SignKeyDSIGN (..)
  )
import Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import Ouroboros.Consensus.Byron.Node
import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo (..))
import Ouroboros.Consensus.NodeId (CoreNodeId (..))
import Ouroboros.Consensus.Protocol.PBFT

mkProtocolByron ::
  forall m.
  (Monad m, HasCallStack) =>
  PBftParams ->
  CoreNodeId ->
  Genesis.Config ->
  Genesis.GeneratedSecrets ->
  -- | We return the signing key which is needed in some tests, because it
  -- cannot easily be extracted from the 'ProtocolInfo'.
  (ProtocolInfo ByronBlock, [BlockForging m ByronBlock], SignKeyDSIGN ByronDSIGN)
mkProtocolByron :: forall (m :: * -> *).
(Monad m, HasCallStack) =>
PBftParams
-> CoreNodeId
-> Config
-> GeneratedSecrets
-> (ProtocolInfo ByronBlock, [BlockForging m ByronBlock],
    SignKeyDSIGN ByronDSIGN)
mkProtocolByron PBftParams
params CoreNodeId
coreNodeId Config
genesisConfig GeneratedSecrets
genesisSecrets =
  (ProtocolInfo ByronBlock
protocolInfo, [BlockForging m ByronBlock]
blockForging, SignKeyDSIGN ByronDSIGN
signingKey)
 where
  leaderCredentials :: ByronLeaderCredentials
  leaderCredentials :: ByronLeaderCredentials
leaderCredentials =
    HasCallStack =>
Config -> GeneratedSecrets -> CoreNodeId -> ByronLeaderCredentials
Config -> GeneratedSecrets -> CoreNodeId -> ByronLeaderCredentials
mkLeaderCredentials
      Config
genesisConfig
      GeneratedSecrets
genesisSecrets
      CoreNodeId
coreNodeId

  signingKey :: SignKeyDSIGN ByronDSIGN
  signingKey :: SignKeyDSIGN ByronDSIGN
signingKey = SigningKey -> SignKeyDSIGN ByronDSIGN
SignKeyByronDSIGN (ByronLeaderCredentials -> SigningKey
blcSignKey ByronLeaderCredentials
leaderCredentials)

  PBftParams{PBftSignatureThreshold
pbftSignatureThreshold :: PBftSignatureThreshold
pbftSignatureThreshold :: PBftParams -> PBftSignatureThreshold
pbftSignatureThreshold} = PBftParams
params

  protocolInfo :: ProtocolInfo ByronBlock
  protocolInfo :: ProtocolInfo ByronBlock
protocolInfo = ProtocolParamsByron -> ProtocolInfo ByronBlock
protocolInfoByron ProtocolParamsByron
protocolParams

  blockForging :: [BlockForging m ByronBlock]
  blockForging :: [BlockForging m ByronBlock]
blockForging = ProtocolParamsByron -> [BlockForging m ByronBlock]
forall (m :: * -> *).
Monad m =>
ProtocolParamsByron -> [BlockForging m ByronBlock]
blockForgingByron ProtocolParamsByron
protocolParams

  protocolParams :: ProtocolParamsByron
  protocolParams :: ProtocolParamsByron
protocolParams =
    ProtocolParamsByron
      { byronGenesis :: Config
byronGenesis = Config
genesisConfig
      , byronPbftSignatureThreshold :: Maybe PBftSignatureThreshold
byronPbftSignatureThreshold = PBftSignatureThreshold -> Maybe PBftSignatureThreshold
forall a. a -> Maybe a
Just (PBftSignatureThreshold -> Maybe PBftSignatureThreshold)
-> PBftSignatureThreshold -> Maybe PBftSignatureThreshold
forall a b. (a -> b) -> a -> b
$ PBftSignatureThreshold
pbftSignatureThreshold
      , byronProtocolVersion :: ProtocolVersion
byronProtocolVersion = ProtocolVersion
theProposedProtocolVersion
      , byronSoftwareVersion :: SoftwareVersion
byronSoftwareVersion = SoftwareVersion
theProposedSoftwareVersion
      , byronLeaderCredentials :: Maybe ByronLeaderCredentials
byronLeaderCredentials = ByronLeaderCredentials -> Maybe ByronLeaderCredentials
forall a. a -> Maybe a
Just ByronLeaderCredentials
leaderCredentials
      }

mkLeaderCredentials ::
  HasCallStack =>
  Genesis.Config ->
  Genesis.GeneratedSecrets ->
  CoreNodeId ->
  ByronLeaderCredentials
mkLeaderCredentials :: HasCallStack =>
Config -> GeneratedSecrets -> CoreNodeId -> ByronLeaderCredentials
mkLeaderCredentials Config
genesisConfig GeneratedSecrets
genesisSecrets (CoreNodeId Word64
i) =
  (ByronLeaderCredentialsError -> ByronLeaderCredentials)
-> (ByronLeaderCredentials -> ByronLeaderCredentials)
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
-> ByronLeaderCredentials
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> ByronLeaderCredentials
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByronLeaderCredentials)
-> (ByronLeaderCredentialsError -> [Char])
-> ByronLeaderCredentialsError
-> ByronLeaderCredentials
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronLeaderCredentialsError -> [Char]
forall a. Show a => a -> [Char]
show) ByronLeaderCredentials -> ByronLeaderCredentials
forall a. a -> a
id (Either ByronLeaderCredentialsError ByronLeaderCredentials
 -> ByronLeaderCredentials)
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
-> ByronLeaderCredentials
forall a b. (a -> b) -> a -> b
$
    Config
-> SigningKey
-> Certificate
-> Text
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
mkByronLeaderCredentials
      Config
genesisConfig
      SigningKey
dlgKey
      Certificate
dlgCert
      Text
"ThreadNet"
 where
  dlgKey :: Crypto.SigningKey
  dlgKey :: SigningKey
dlgKey =
    SigningKey -> Maybe SigningKey -> SigningKey
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> SigningKey
forall a. HasCallStack => [Char] -> a
error [Char]
"dlgKey") (Maybe SigningKey -> SigningKey) -> Maybe SigningKey -> SigningKey
forall a b. (a -> b) -> a -> b
$
      (SigningKey -> Bool) -> [SigningKey] -> Maybe SigningKey
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SigningKey
sec -> Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
Delegation.delegateVK Certificate
dlgCert VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
== SigningKey -> VerificationKey
Crypto.toVerification SigningKey
sec) ([SigningKey] -> Maybe SigningKey)
-> [SigningKey] -> Maybe SigningKey
forall a b. (a -> b) -> a -> b
$
        GeneratedSecrets -> [SigningKey]
Genesis.gsRichSecrets GeneratedSecrets
genesisSecrets

  dlgCert :: Delegation.Certificate
  dlgCert :: Certificate
dlgCert = (KeyHash, Certificate) -> Certificate
forall a b. (a, b) -> b
snd ((KeyHash, Certificate) -> Certificate)
-> (KeyHash, Certificate) -> Certificate
forall a b. (a -> b) -> a -> b
$ Map KeyHash Certificate -> [(KeyHash, Certificate)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map KeyHash Certificate
dlgMap [(KeyHash, Certificate)] -> Int -> (KeyHash, Certificate)
forall a. HasCallStack => [a] -> Int -> a
!! (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)

  dlgMap :: Map Common.KeyHash Delegation.Certificate
  dlgMap :: Map KeyHash Certificate
dlgMap =
    GenesisDelegation -> Map KeyHash Certificate
Genesis.unGenesisDelegation (GenesisDelegation -> Map KeyHash Certificate)
-> GenesisDelegation -> Map KeyHash Certificate
forall a b. (a -> b) -> a -> b
$
      GenesisData -> GenesisDelegation
Genesis.gdHeavyDelegation (GenesisData -> GenesisDelegation)
-> GenesisData -> GenesisDelegation
forall a b. (a -> b) -> a -> b
$
        Config -> GenesisData
Genesis.configGenesisData Config
genesisConfig

-- | The protocol version proposed as part of the hard-fork smoke test
--
-- The initial Byron ledger state begins with protocol version @0.0.0@. In the
-- smoke test, if the proposal and votes are enabled, then we will be proposing
-- an update to @1.0.0@.
--
-- This value occurs in two crucial places: the proposal and also the
-- 'Byron.byronProtocolVersion' field of the static node config. See the
-- Haddock comment on 'mkProtocolByronAndHardForkTxs'.
theProposedProtocolVersion :: Update.ProtocolVersion
theProposedProtocolVersion :: ProtocolVersion
theProposedProtocolVersion = Word16 -> Word16 -> Word8 -> ProtocolVersion
Update.ProtocolVersion Word16
1 Word16
0 Word8
0

-- | The software version proposed as part of the hard-fork smoke test
--
-- We don't actually care about this for the smoke test, but we have to set it
-- both as part of the proposal and also as part of the node's static
-- configuration. Its use in the static configuration is legacy and does not
-- seem to affect anything; see Issue #1732.
--
-- The initial Byron ledger state begins with no recorded software versions.
-- For the addition of a new software version, the Byron ledger rules require
-- that it starts at 0 or 1.
theProposedSoftwareVersion :: Update.SoftwareVersion
theProposedSoftwareVersion :: SoftwareVersion
theProposedSoftwareVersion =
  ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Update.SoftwareVersion
    -- appnames must be ASCII and <= 12 characters
    (Text -> ApplicationName
Update.ApplicationName Text
"Dummy")
    NumSoftwareVersion
0