diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs index 061aa7cc2d7..2ffa014351c 100644 --- 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 index eb778c72c0e..968b3c9cd0c 100644 --- 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 index e759d2b9f9f..d42c8870ce3 100644 --- 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 index 0f5ebce6eef..37b61e9fb34 100644 --- 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 index 01d7792f5f7..c8d7060fd71 100644 --- 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.