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

module Test.ThreadNet.Infra.Byron.Genesis
  ( byronPBftParams
  , generateGenesisConfig
  ) where

import qualified Cardano.Chain.Common as Common
import qualified Cardano.Chain.Genesis as Genesis
import qualified Cardano.Chain.Update as Update
import qualified Cardano.Crypto as Crypto
import Cardano.Ledger.BaseTypes (unNonZero)
import Control.Monad.Except (runExceptT)
import Ouroboros.Consensus.BlockchainTime
import Ouroboros.Consensus.Byron.Ledger.Conversions
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Protocol.PBFT
import qualified Test.Cardano.Chain.Genesis.Dummy as Dummy
import Test.Util.Time

{-------------------------------------------------------------------------------
  Generating the genesis configuration
-------------------------------------------------------------------------------}

byronPBftParams :: SecurityParam -> NumCoreNodes -> PBftParams
byronPBftParams :: SecurityParam -> NumCoreNodes -> PBftParams
byronPBftParams SecurityParam
paramK NumCoreNodes
numCoreNodes =
  PBftParams
    { pbftNumNodes :: NumCoreNodes
pbftNumNodes = NumCoreNodes
numCoreNodes
    , pbftSecurityParam :: SecurityParam
pbftSecurityParam = SecurityParam
paramK
    , pbftSignatureThreshold :: PBftSignatureThreshold
pbftSignatureThreshold = Double -> PBftSignatureThreshold
PBftSignatureThreshold (Double -> PBftSignatureThreshold)
-> Double -> PBftSignatureThreshold
forall a b. (a -> b) -> a -> b
$ (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Num a => a
n) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Num a => a
k) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
epsilon
    -- crucially: @floor (k * t) >= ceil (k / n)@
    }
 where
  epsilon :: Double
epsilon = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10000 -- avoid problematic floating point round-off
  n :: Num a => a
  n :: forall a. Num a => a
n = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x where NumCoreNodes Word64
x = NumCoreNodes
numCoreNodes

  k :: Num a => a
  k :: forall a. Num a => a
k = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x where x :: Word64
x = NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64) -> NonZero Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ SecurityParam -> NonZero Word64
maxRollbacks SecurityParam
paramK

-- Instead of using 'Dummy.dummyConfig', which hard codes the number of rich
-- men (= CoreNodes for us) to 4, we generate a dummy config with the given
-- number of rich men.
generateGenesisConfig ::
  SlotLength ->
  PBftParams ->
  (Genesis.Config, Genesis.GeneratedSecrets)
generateGenesisConfig :: SlotLength -> PBftParams -> (Config, GeneratedSecrets)
generateGenesisConfig SlotLength
slotLen PBftParams
params =
  (GenesisDataGenerationError -> (Config, GeneratedSecrets))
-> ((Config, GeneratedSecrets) -> (Config, GeneratedSecrets))
-> Either GenesisDataGenerationError (Config, GeneratedSecrets)
-> (Config, GeneratedSecrets)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> (Config, GeneratedSecrets)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Config, GeneratedSecrets))
-> (GenesisDataGenerationError -> [Char])
-> GenesisDataGenerationError
-> (Config, GeneratedSecrets)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenesisDataGenerationError -> [Char]
forall a. Show a => a -> [Char]
show) (Config, GeneratedSecrets) -> (Config, GeneratedSecrets)
forall a. a -> a
id (Either GenesisDataGenerationError (Config, GeneratedSecrets)
 -> (Config, GeneratedSecrets))
-> Either GenesisDataGenerationError (Config, GeneratedSecrets)
-> (Config, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$
    ByteString
-> MonadPseudoRandom
     ChaChaDRG
     (Either GenesisDataGenerationError (Config, GeneratedSecrets))
-> Either GenesisDataGenerationError (Config, GeneratedSecrets)
forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
Crypto.deterministic ByteString
"this is fake entropy for testing" (MonadPseudoRandom
   ChaChaDRG
   (Either GenesisDataGenerationError (Config, GeneratedSecrets))
 -> Either GenesisDataGenerationError (Config, GeneratedSecrets))
-> MonadPseudoRandom
     ChaChaDRG
     (Either GenesisDataGenerationError (Config, GeneratedSecrets))
-> Either GenesisDataGenerationError (Config, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$
      ExceptT
  GenesisDataGenerationError
  (MonadPseudoRandom ChaChaDRG)
  (Config, GeneratedSecrets)
-> MonadPseudoRandom
     ChaChaDRG
     (Either GenesisDataGenerationError (Config, GeneratedSecrets))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   GenesisDataGenerationError
   (MonadPseudoRandom ChaChaDRG)
   (Config, GeneratedSecrets)
 -> MonadPseudoRandom
      ChaChaDRG
      (Either GenesisDataGenerationError (Config, GeneratedSecrets)))
-> ExceptT
     GenesisDataGenerationError
     (MonadPseudoRandom ChaChaDRG)
     (Config, GeneratedSecrets)
-> MonadPseudoRandom
     ChaChaDRG
     (Either GenesisDataGenerationError (Config, GeneratedSecrets))
forall a b. (a -> b) -> a -> b
$
        UTCTime
-> GenesisSpec
-> ExceptT
     GenesisDataGenerationError
     (MonadPseudoRandom ChaChaDRG)
     (Config, GeneratedSecrets)
forall (m :: * -> *).
MonadRandom m =>
UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError m (Config, GeneratedSecrets)
Genesis.generateGenesisConfigWithEntropy UTCTime
dawnOfTime GenesisSpec
spec
 where
  PBftParams{NumCoreNodes
pbftNumNodes :: PBftParams -> NumCoreNodes
pbftNumNodes :: NumCoreNodes
pbftNumNodes, SecurityParam
pbftSecurityParam :: PBftParams -> SecurityParam
pbftSecurityParam :: SecurityParam
pbftSecurityParam} = PBftParams
params
  NumCoreNodes Word64
numCoreNodes = NumCoreNodes
pbftNumNodes

  spec :: Genesis.GenesisSpec
  spec :: GenesisSpec
spec =
    GenesisSpec
Dummy.dummyGenesisSpec
      { Genesis.gsInitializer =
          Dummy.dummyGenesisInitializer
            { Genesis.giTestBalance =
                (Genesis.giTestBalance Dummy.dummyGenesisInitializer)
                  { -- The nodes are the richmen
                    Genesis.tboRichmen = fromIntegral numCoreNodes
                  }
            }
      , Genesis.gsK = Common.BlockCount $ unNonZero $ maxRollbacks pbftSecurityParam
      , Genesis.gsProtocolParameters =
          gsProtocolParameters
            { Update.ppSlotDuration = toByronSlotLength slotLen
            }
      }
   where
    gsProtocolParameters :: ProtocolParameters
gsProtocolParameters = GenesisSpec -> ProtocolParameters
Genesis.gsProtocolParameters GenesisSpec
Dummy.dummyGenesisSpec