Add script support when making hot key authorization certificates

IntersectMBO · Mar 11, 2024 · a394707 · a394707
1 parent 1ef5226
commit a394707
Show file tree

Hide file tree

Showing 2 changed files with 10 additions and 6 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs
@@ -410,19 +410,17 @@ makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards vcre
 data CommitteeHotKeyAuthorizationRequirements era where
   CommitteeHotKeyAuthorizationRequirements
     :: ConwayEraOnwards era
-    -> Ledger.KeyHash Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-    -> Ledger.KeyHash Ledger.HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
+    -> Ledger.Credential Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
+    -> Ledger.Credential Ledger.HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
     -> CommitteeHotKeyAuthorizationRequirements era
 
 makeCommitteeHotKeyAuthorizationCertificate :: ()
   => CommitteeHotKeyAuthorizationRequirements era
   -> Certificate era
-makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequirements cOnwards coldKeyHash hotKeyHash) =
+makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequirements cOnwards coldKeyCredential hotKeyCredential) =
   ConwayCertificate cOnwards
     . Ledger.ConwayTxCertGov
-    $ Ledger.ConwayAuthCommitteeHotKey
-        (Ledger.KeyHashObj coldKeyHash)
-        (Ledger.KeyHashObj hotKeyHash)
+    $ Ledger.ConwayAuthCommitteeHotKey coldKeyCredential hotKeyCredential
 
 data CommitteeColdkeyResignationRequirements era where
   CommitteeColdkeyResignationRequirements

diff --git a/cardano-api/internal/Cardano/Api/Monad/Error.hs b/cardano-api/internal/Cardano/Api/Monad/Error.hs
@@ -13,6 +13,7 @@ module Cardano.Api.Monad.Error
   , modifyError
   , handleIOExceptionsWith
   , handleIOExceptionsLiftWith
+  , hoistIOEither
 
   , module Control.Monad.Except
   , module Control.Monad.IO.Class
@@ -81,3 +82,8 @@ liftExceptT :: MonadTransError e t m
             -> t m a
 liftExceptT = modifyError id
 
+
+hoistIOEither :: MonadIOTransError e t m
+              => IO (Either e a)
+              -> t m a
+hoistIOEither = liftExceptT . ExceptT . liftIO