{-# 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           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
1Double -> 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 SecurityParam Word64
x = 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 $ maxRollbacks pbftSecurityParam
        , Genesis.gsProtocolParameters = gsProtocolParameters
          { Update.ppSlotDuration = toByronSlotLength slotLen
          }
        }
      where
        gsProtocolParameters :: ProtocolParameters
gsProtocolParameters = GenesisSpec -> ProtocolParameters
Genesis.gsProtocolParameters GenesisSpec
Dummy.dummyGenesisSpec