diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index 4baf425a66..05abca7a41 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -408,19 +408,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 index edd710fe53..2cb37486c1 100644 --- 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 @@ -34,7 +35,7 @@ import Data.Bifunctor (first) type MonadTransError e t m = (Monad m, MonadTrans t, MonadError e (t m)) -- -- | Same as 'MonadTransError', but with also 'MonadIO' constraint -type MonadIOTransError e t m = (MonadIO m, MonadIO (t m), MonadTrans t, MonadError e (t m)) +type MonadIOTransError e t m = (MonadIO m, MonadIO (t m), MonadCatch m, MonadTrans t, MonadError e (t m)) -- | Modify an 'ExceptT' error and lift it to 'MonadError' transformer stack. -- @@ -69,10 +70,9 @@ handleIOExceptionsWith f act = liftEither . first f =<< try act handleIOExceptionsLiftWith :: MonadIOTransError e' t m => Exception e - => MonadCatch m => (e -> e') -- ^ mapping function -> m a -- ^ action that can throw - -> t m a -- ^ action with caucht error lifted into 'MonadError' stack + -> t m a -- ^ action with caught error lifted into 'MonadError' stack handleIOExceptionsLiftWith f act = liftEither =<< lift (first f <$> try act) -- | Lift 'ExceptT' into 'MonadTransError' @@ -81,3 +81,9 @@ liftExceptT :: MonadTransError e t m -> t m a liftExceptT = modifyError id + +-- | Lift an 'IO' action that returns 'Either' into 'MonadIOTransError' +hoistIOEither :: MonadIOTransError e t m + => IO (Either e a) + -> t m a +hoistIOEither = liftExceptT . ExceptT . liftIO