reset me

IntersectMBO · Nov 28, 2022 · a6f35d8 · a6f35d8
1 parent 569c241
commit a6f35d8
Showing 1 changed file with 88 additions and 23 deletions.
diff --git a/marconi/test/EpochStakepoolSize.hs b/marconi/test/EpochStakepoolSize.hs
@@ -9,20 +9,17 @@ import Control.Concurrent qualified as IO
 import Control.Concurrent.Async qualified as IO
 import Control.Monad (forever, void)
 import Control.Monad.IO.Class (liftIO)
+import Data.Aeson ((.=))
+import Data.Aeson qualified as J
 import Data.ByteString.Lazy qualified as BL
 import Data.Function ((&))
 import Data.Map qualified as Map
-
-import Data.Aeson ((.=))
-import Data.Aeson qualified as J
 import Streaming.Prelude qualified as S
 import System.Directory qualified as IO
 import System.Environment qualified as IO
 
-
 import Hedgehog (Property, (===))
 import Hedgehog.Extras.Test qualified as HE
-
 import Test.Base qualified as H
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import Test.Tasty.Hedgehog (testPropertyNamed)
@@ -180,54 +177,121 @@ test = H.integration . HE.runFinallies . TN.workspace "chairman" $ \tempAbsPath
   -- vrf.vkey	VRF verification key
   -- vrf.skey	VRF signing key
 
+  -- cardano-cli stake-pool metadata-hash --pool-metadata-file
   HE.lbsWriteFile (tempAbsPath </> "poolMetadata.json") . J.encode $ J.object
     -- [ "heavyDelThd" .= J.toJSON @String "300000000000"
     [ "name" .= id @String "TestPool"
     , "description" .= id @String "The pool that tests all the pools"
     , "ticker" .= id @String "TEST"
     , "homepage" .= id @String "https://teststakepool.com"
     ]
-  -- cardano-cli stake-pool metadata-hash --pool-metadata-file
   lbs <- HE.lbsReadFile (tempAbsPath </> "poolMetadata.json")
   (_poolMetadata, poolMetadataHash) <- HE.leftFail $ C.validateAndHashStakePoolMetadata $ BL.toStrict lbs
   p2 "poolMetadataHash" poolMetadataHash
   p2 "poolMetadataHash" _poolMetadata
+
   -- cardano-cli stake-pool registration-certificate
 
+  coldSKey :: C.SigningKey C.StakePoolKey <- liftIO $ C.generateSigningKey C.AsStakePoolKey
+  let coldVKey = C.getVerificationKey coldSKey :: C.VerificationKey C.StakePoolKey
+      coldVKeyHash = C.verificationKeyHash coldVKey
 
+  skeyVrf :: C.SigningKey C.VrfKey <- liftIO $ C.generateSigningKey C.AsVrfKey
+  let vkeyVrf = C.getVerificationKey skeyVrf :: C.VerificationKey C.VrfKey
 
+  let stakepoolRegCert :: C.Certificate
+      stakepoolRegCert = makeStakePoolRegistrationCert_
+        coldVKey -- stakePoolVerKey; :: C.VerificationKey C.StakePoolKey; node key-gen
+        vkeyVrf -- vrfVerKey -> C.VerificationKey C.VrfKey
+        0 -- pldg -> C.Lovelace
+        0 -- pCost -> C.Lovelace
+        0 -- pMrgn -> Rational
+        stakeVKey -- rwdStakeVerKey -> C.VerificationKey C.StakeKey -- TODO correct key used?
+        [] -- sPoolOwnerVkeys -> [C.VerificationKey C.StakeKey]
+        [] -- relays -> [C.StakePoolRelay]
+        (Just $ C.StakePoolMetadataReference "" poolMetadataHash) -- -> Maybe C.StakePoolMetadataReference
+        networkId -- -> C.NetworkId
 
+  -- cardano-cli stake-address delegation-certificate
+  -- file:/home/iog/src/cardano-node/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs::150
+  let delegCert = C.makeStakeAddressDelegationCertificate stakeCredential coldVKeyHash
+
+
+  -- here https://developers.cardano.org/docs/stake-pool-course/handbook/register-stake-pool-metadata/#submit-the-pool-certificate-and-delegation-certificate-to-the-blockchain
+
+  do
+    let
+      fee = 0
+      tx = (TN.emptyTxBodyContent fee pparams)
+        { C.txIns = [(txIn, C.BuildTxWith $ C.KeyWitness C.KeyWitnessForSpending)]
+        , C.txOuts = [outAddress genesisAddress $ totalLovelace - fee]
+        , C.txCertificates = C.TxCertificates C.CertificatesInAlonzoEra
+          [stakepoolRegCert, delegCert]
+          (C.BuildTxWith mempty) -- BuildTxWith build (Map StakeCredential (Witness WitCtxStake era))
+        }
+    txBody :: C.TxBody C.AlonzoEra <- HE.leftFail $ C.makeTransactionBody tx
+    TN.submitTx con $ C.signShelleyTransaction txBody
+      [ C.WitnessGenesisUTxOKey genesisSKey
+      , C.WitnessStakeKey stakeSKey
+      , C.WitnessStakePoolKey coldSKey
+      ]
 
   -- HE.threadDelay 1000000
   -- cardano-cli stake-pool id
 
-  -- * Generate Stake Pool Keys
-
   -- void $ liftIO $ forever $ do
   --   stakeMap <- IO.readChan chan
   --   putStrLn "got event, done"
   --   print stakeMap
 
-  {- Process:
-    - register  a stakepool: done in testnet
-    - generate a staking address for a user
-    - stake the user's lovelace to that pool, let's call this event "stake1" (referred to below)
-    - wait for the turn of epoch
-    - stake to another pool (or unstake?), let's call this event "stake2"
-    - wait for the turn of next epoch: observe event "stake1" realize: stake appears in indexer
-    - wait for the turn of next epoch: observe "stake2" realize: stake appears in another pool (or disappears from pool1 if it was just unstaked)
-  -}
-
   HE.threadDelay 1000_000_000
   True === True
 
 
+-- | This is a pure version of `runStakePoolRegistrationCert` defined in /cardano-node/cardano-cli/src/Cardano/CLI/Shelley/Run/Pool.hs::60
+makeStakePoolRegistrationCert_
+  :: C.VerificationKey C.StakePoolKey
+  -> C.VerificationKey C.VrfKey
+  -> C.Lovelace
+  -> C.Lovelace
+  -> Rational
+  -> C.VerificationKey C.StakeKey
+  -> [C.VerificationKey C.StakeKey]
+  -> [C.StakePoolRelay]
+  -> Maybe C.StakePoolMetadataReference
+  -> C.NetworkId
+  -> C.Certificate
+makeStakePoolRegistrationCert_ stakePoolVerKey vrfVerKey pldg pCost pMrgn rwdStakeVerKey sPoolOwnerVkeys relays mbMetadata network = let
+  -- Pool verification key
+  stakePoolId' = C.verificationKeyHash stakePoolVerKey
+  -- VRF verification key
+  vrfKeyHash' = C.verificationKeyHash vrfVerKey
+  -- Pool reward account
+  stakeCred = C.StakeCredentialByKey (C.verificationKeyHash rwdStakeVerKey)
+  rewardAccountAddr = C.makeStakeAddress network stakeCred
+  -- Pool owner(s)
+  stakePoolOwners' = map C.verificationKeyHash sPoolOwnerVkeys
+  stakePoolParams =
+    C.StakePoolParameters
+      { C.stakePoolId = stakePoolId'
+      , C.stakePoolVRF = vrfKeyHash'
+      , C.stakePoolCost = pCost
+      , C.stakePoolMargin = pMrgn
+      , C.stakePoolRewardAccount = rewardAccountAddr
+      , C.stakePoolPledge = pldg
+      , C.stakePoolOwners = stakePoolOwners'
+      , C.stakePoolRelays = relays
+      , C.stakePoolMetadata = mbMetadata
+      }
+  in C.makeStakePoolRegistrationCertificate stakePoolParams
+
+outAddress :: C.Address C.ShelleyAddr -> C.Lovelace -> C.TxOut ctx C.AlonzoEra
 outAddress address lovelace =
-        C.TxOut
-          (C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraAlonzo) address)
-          (C.TxOutValue C.MultiAssetInAlonzoEra $ C.lovelaceToValue lovelace)
-          C.TxOutDatumNone
-          C.ReferenceScriptNone
+  C.TxOut
+    (C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraAlonzo) address)
+    (C.TxOutValue C.MultiAssetInAlonzoEra $ C.lovelaceToValue lovelace)
+    C.TxOutDatumNone
+    C.ReferenceScriptNone
 
 hot :: IO ()
 hot = defaultMain tests
@@ -237,4 +301,5 @@ printEpochNo = S.chain $ \e -> do
   TN.p2 "" $ EpochStakepoolSize.getEpochNo e
   -- IO.writeChan chan e
 
+u :: a
 u = undefined