|
1 | 1 | {-# LANGUAGE DataKinds #-}
|
2 | 2 | {-# LANGUAGE GADTs #-}
|
| 3 | +{-# LANGUAGE NamedFieldPuns #-} |
3 | 4 | {-# LANGUAGE OverloadedStrings #-}
|
4 | 5 | {-# LANGUAGE RankNTypes #-}
|
5 | 6 | {-# LANGUAGE ScopedTypeVariables #-}
|
@@ -47,14 +48,17 @@ import qualified Data.Aeson.KeyMap as KeyMapAeson
|
47 | 48 | import Data.Bifunctor
|
48 | 49 | import qualified Data.Default.Class as DefaultClass
|
49 | 50 | import qualified Data.Map.Strict as Map
|
| 51 | +import Data.Maybe |
50 | 52 | import Data.Proxy
|
51 | 53 | import Data.Ratio
|
52 | 54 | import Data.Scientific
|
53 | 55 | import Data.Text (Text)
|
54 | 56 | import qualified Data.Text as Text
|
55 | 57 | import Data.Time (UTCTime)
|
| 58 | +import Data.Typeable |
56 | 59 | import qualified Data.Vector as Vector
|
57 | 60 | import Data.Word
|
| 61 | +import GHC.Stack |
58 | 62 | import Lens.Micro
|
59 | 63 | import Numeric.Natural
|
60 | 64 |
|
@@ -440,21 +444,31 @@ defaultShelleyGenesis
|
440 | 444 | :: UTCTime
|
441 | 445 | -> CardanoTestnetOptions
|
442 | 446 | -> Api.ShelleyGenesis StandardCrypto
|
443 |
| -defaultShelleyGenesis startTime testnetOptions = |
444 |
| - let testnetMagic = cardanoTestnetMagic testnetOptions |
445 |
| - slotLength = cardanoSlotLength testnetOptions |
446 |
| - epochLength = cardanoEpochLength testnetOptions |
447 |
| - maxLovelaceLovelaceSupply = cardanoMaxSupply testnetOptions |
448 |
| - pVer = eraToProtocolVersion $ cardanoNodeEra testnetOptions |
| 447 | +defaultShelleyGenesis startTime testnetOptions = do |
| 448 | + let CardanoTestnetOptions |
| 449 | + { cardanoTestnetMagic = testnetMagic |
| 450 | + , cardanoSlotLength = slotLength |
| 451 | + , cardanoEpochLength = epochLength |
| 452 | + , cardanoMaxSupply = maxLovelaceLovelaceSupply |
| 453 | + , cardanoActiveSlotsCoeff |
| 454 | + , cardanoNodeEra |
| 455 | + } = testnetOptions |
| 456 | + -- f |
| 457 | + activeSlotsCoeff = round (cardanoActiveSlotsCoeff * 100) % 100 |
| 458 | + -- make security param k satisfy: epochLength = 10 * k / f |
| 459 | + securityParam = fromIntegral epochLength * cardanoActiveSlotsCoeff / 10 |
| 460 | + pVer = eraToProtocolVersion cardanoNodeEra |
449 | 461 | protocolParams = Api.sgProtocolParams Api.shelleyGenesisDefaults
|
450 | 462 | protocolParamsWithPVer = protocolParams & ppProtocolVersionL' .~ pVer
|
451 |
| - in Api.shelleyGenesisDefaults |
452 |
| - { Api.sgNetworkMagic = fromIntegral testnetMagic |
453 |
| - , Api.sgSlotLength = secondsToNominalDiffTimeMicro $ realToFrac slotLength |
| 463 | + Api.shelleyGenesisDefaults |
| 464 | + { Api.sgActiveSlotsCoeff = unsafeBoundedRational activeSlotsCoeff |
454 | 465 | , Api.sgEpochLength = EpochSize $ fromIntegral epochLength
|
455 | 466 | , Api.sgMaxLovelaceSupply = maxLovelaceLovelaceSupply
|
456 |
| - , Api.sgSystemStart = startTime |
| 467 | + , Api.sgNetworkMagic = fromIntegral testnetMagic |
457 | 468 | , Api.sgProtocolParams = protocolParamsWithPVer
|
| 469 | + , Api.sgSecurityParam = round securityParam |
| 470 | + , Api.sgSlotLength = secondsToNominalDiffTimeMicro $ realToFrac slotLength |
| 471 | + , Api.sgSystemStart = startTime |
458 | 472 | }
|
459 | 473 |
|
460 | 474 |
|
@@ -522,3 +536,11 @@ plutusV3SpendingScript =
|
522 | 536 | , ",\"cborHex\": \"484701010022280001\""
|
523 | 537 | , "}"
|
524 | 538 | ]
|
| 539 | + |
| 540 | +-- FIXME: move to cardano-api |
| 541 | +unsafeBoundedRational :: forall r. (HasCallStack, Typeable r, BoundedRational r) |
| 542 | + => Rational |
| 543 | + -> r |
| 544 | +unsafeBoundedRational x = fromMaybe (error errMessage) $ boundRational x |
| 545 | + where |
| 546 | + errMessage = show (typeRep (Proxy @r)) <> " is out of bounds: " <> show x |
0 commit comments