add DefineDRepKey Action

IntersectMBO · Nov 26, 2024 · a29d6a9 · a29d6a9
1 parent 4e8f32a
commit a29d6a9
Show file tree

Hide file tree

Showing 5 changed files with 36 additions and 8 deletions.
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs
@@ -35,7 +35,7 @@ import qualified Data.Text as Text (unpack)
 -- the cases' fields to functions with very similar names to the
 -- constructors.
 action :: Action -> ActionM ()
-action a = case a of
+action = \case
   SetNetworkId val -> setEnvNetworkId val
   SetSocketPath val -> setEnvSocketPath val
   InitWallet name -> initWallet name
@@ -44,8 +44,9 @@ action a = case a of
   ReadSigningKey name filePath -> readSigningKey name filePath
   ReadDRepKeys filepath -> readDRepKeys filepath
   ReadStakeKeys filepath -> readStakeCredentials filepath
+  DefineDRepKey drepKey -> defineDRepCredential drepKey
   DefineSigningKey name descr -> defineSigningKey name descr
-  DefineStakeKey k -> defineStakeCrendential k
+  DefineStakeKey k -> defineStakeCredential k
   AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName
   Delay t -> delay t
   Submit era submitMode txParams generator -> submitAction era submitMode generator txParams

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs
@@ -72,6 +72,26 @@ instance FromJSON (SigningKey PaymentKey) where
       Right k   -> pure k
       Left err  -> fail $ show err
 
+-- FIXME: workaround instance
+instance ToJSON (SigningKey DRepKey) where
+  toJSON = toJSON . serialiseToTextEnvelope Nothing
+instance FromJSON (SigningKey DRepKey) where
+  parseJSON o = do
+    te <- parseJSON o
+    case deserialiseFromTextEnvelope (AsSigningKey AsDRepKey) te of
+      Right k   -> pure k
+      Left err  -> fail $ show err
+
+-- FIXME: workaround instance
+instance ToJSON (VerificationKey DRepKey) where
+  toJSON = toJSON . serialiseToTextEnvelope Nothing
+instance FromJSON (VerificationKey DRepKey) where
+  parseJSON o = do
+    te <- parseJSON o
+    case deserialiseFromTextEnvelope (AsVerificationKey AsDRepKey) te of
+      Right k   -> pure k
+      Left err  -> fail $ show err
+
 -- FIXME: workaround instance
 instance ToJSON (VerificationKey StakeKey) where
   toJSON = toJSON . serialiseToTextEnvelope Nothing

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -94,8 +94,11 @@ readSigningKey name filePath =
 defineSigningKey :: String -> SigningKey PaymentKey -> ActionM ()
 defineSigningKey = setEnvKeys
 
-defineStakeCrendential :: VerificationKey StakeKey -> ActionM ()
-defineStakeCrendential = setEnvStakeCredentials . (: []) . StakeCredentialByKey . verificationKeyHash
+defineDRepCredential :: SigningKey DRepKey -> ActionM ()
+defineDRepCredential = setEnvDRepKeys . (: [])
+
+defineStakeCredential :: VerificationKey StakeKey -> ActionM ()
+defineStakeCredential = setEnvStakeCredentials . (: []) . StakeCredentialByKey . verificationKeyHash
 
 readDRepKeys :: FilePath -> ActionM ()
 readDRepKeys ncFile = do

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs
@@ -126,8 +126,8 @@ testScriptVoting protocolFile submitMode =
 
   , DefineStakeKey stakeKey
 
-  -- TODO: manually inject an (unnamed) DRep key into the Env by means of a new Action constructor
-  -- DefineDRepKey _drepKey
+  -- manually inject an (unnamed) DRep key into the Env by means of an Action constructor
+  , DefineDRepKey drepKey
 
   , Submit era submitMode txParams
       EmptyStream
@@ -150,8 +150,8 @@ testScriptVoting protocolFile submitMode =
           , teRawCBOR = "X \vl1~\182\201v(\152\250A\202\157h0\ETX\248h\153\171\SI/m\186\242D\228\NAK\182(&\162"
           }
 
-    _drepKey :: SigningKey DRepKey
-    _drepKey = fromRight (error "could not parse hardcoded drep key") $
+    drepKey :: SigningKey DRepKey
+    drepKey = error "could not parse hardcoded drep key" `fromRight`
       parseDRepKeyBase16 "5820aa7f780a2dcd099762ebc31a43860c1373970c2e2062fcd02cceefe682f39ed8"
 
     stakeKey :: VerificationKey StakeKey

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs
@@ -93,6 +93,8 @@ data Action where
   ReadStakeKeys       :: !FilePath -> Action
   -- | 'DefineSigningKey' is just a 'Map.insert' on the state variable.
   DefineSigningKey   :: !String -> !(SigningKey PaymentKey) -> Action
+  -- | inject a singleton DRepCredential into the environment
+  DefineDRepKey      :: !(SigningKey DRepKey) -> Action
   -- | inject a singleton StakeCredential into the environment
   DefineStakeKey      :: !(VerificationKey StakeKey) -> Action
   -- | 'AddFund' is mostly a wrapper around
@@ -131,6 +133,8 @@ data Action where
   deriving (Show, Eq)
 deriving instance Generic Action
 
+deriving instance Eq (SigningKey DRepKey)
+
 -- | 'Generator' is interpreted by
 -- 'Cardano.Bencmarking.Script.Core.evalGenerator' as a series of
 -- transactions, albeit in the form of precursors to UTxO's.