Add support for script-based CC members

IntersectMBO · Mar 18, 2024 · 1db4aa2 · 1db4aa2
1 parent 299fa40
commit 1db4aa2
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 27 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
@@ -37,10 +37,9 @@ import           Cardano.Ledger.Keys (KeyRole (ColdCommitteeRole))
 
 import           Data.ByteString (ByteString)
 import           Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe)
-import qualified Data.Set as Set
 import           Data.Word
+import           GHC.Exts (IsList (..))
 
 data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era)
 
@@ -54,8 +53,8 @@ data GovernanceAction era
       (StrictMaybe (Shelley.ScriptHash StandardCrypto))
   | ProposeNewCommittee
       (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era)))
-      [Hash CommitteeColdKey] -- ^ Old constitutional committee
-      (Map (Hash CommitteeColdKey) EpochNo) -- ^ New committee members with epoch number when each of them expires
+      [L.Credential ColdCommitteeRole StandardCrypto] -- ^ Old constitutional committee
+      (Map (L.Credential ColdCommitteeRole StandardCrypto) EpochNo) -- ^ New committee members with epoch number when each of them expires
       Rational -- ^ Quorum of the committee that is necessary for a successful vote
   | InfoAct
   | TreasuryWithdrawal
@@ -85,8 +84,8 @@ toGovernanceAction sbe =
     ProposeNewCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor ->
       Gov.UpdateCommittee
         prevGovId -- previous governance action id
-        (Set.fromList $ map toCommitteeMember oldCommitteeMembers) -- members to remove
-        (Map.mapKeys toCommitteeMember newCommitteeMembers) -- members to add
+        (fromList oldCommitteeMembers) -- members to remove
+        newCommitteeMembers -- members to add
         (fromMaybe (error $ mconcat ["toGovernanceAction: the given quorum "
                                   , show quor
                                   , " was outside of the unit interval!"
@@ -95,7 +94,7 @@ toGovernanceAction sbe =
     InfoAct ->
       Gov.InfoAction
     TreasuryWithdrawal withdrawals govPol ->
-      let m = Map.fromList [(L.RewardAcnt nw (toShelleyStakeCredential sc), l) | (nw,sc,l) <- withdrawals]
+      let m = fromList [(L.RewardAcnt nw (toShelleyStakeCredential sc), l) | (nw,sc,l) <- withdrawals]
       in Gov.TreasuryWithdrawals m govPol
     InitiateHardfork prevGovId pVer ->
       Gov.HardForkInitiation prevGovId pVer
@@ -119,14 +118,14 @@ fromGovernanceAction = \case
     InitiateHardfork prevGovId pVer
   Gov.TreasuryWithdrawals withdrawlMap govPolicy ->
     let res = [ (L.getRwdNetwork rwdAcnt, fromShelleyStakeCredential (L.getRwdCred rwdAcnt), coin)
-              | (rwdAcnt, coin) <- Map.toList withdrawlMap
+              | (rwdAcnt, coin) <- toList withdrawlMap
               ]
     in TreasuryWithdrawal res govPolicy
   Gov.UpdateCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor ->
     ProposeNewCommittee
       prevGovId
-      (map fromCommitteeMember $ Set.toList oldCommitteeMembers)
-      (Map.mapKeys fromCommitteeMember newCommitteeMembers)
+      (toList oldCommitteeMembers)
+      newCommitteeMembers
       (unboundRational quor)
   Gov.InfoAction ->
     InfoAct
@@ -215,16 +214,3 @@ createAnchor url anchorData =
     , anchorDataHash = hashAnchorData $ Ledger.AnchorData anchorData
     }
 
--- ----------------------------------------------------------------------------
--- TODO conversions that likely need to live elsewhere and may even deserve
--- additional wrapper types
-
-toCommitteeMember :: Hash CommitteeColdKey -> L.Credential ColdCommitteeRole StandardCrypto
-toCommitteeMember (CommitteeColdKeyHash keyhash) = L.KeyHashObj keyhash
-
-fromCommitteeMember :: L.Credential ColdCommitteeRole StandardCrypto -> Hash CommitteeColdKey
-fromCommitteeMember = \case
-  L.KeyHashObj keyhash -> CommitteeColdKeyHash keyhash
-  L.ScriptHashObj _scripthash -> error "TODO script committee members not yet supported"
-
-
diff --git a/cardano-api/internal/Cardano/Api/Keys/Class.hs b/cardano-api/internal/Cardano/Api/Keys/Class.hs
@@ -20,6 +20,7 @@ import           Cardano.Api.SerialiseTextEnvelope
 import qualified Cardano.Crypto.DSIGN.Class as Crypto
 import qualified Cardano.Crypto.Seed as Crypto
 
+import           Control.Monad.IO.Class
 import           Data.Kind (Type)
 import qualified System.Random as Random
 import           System.Random (StdGen)
@@ -68,19 +69,25 @@ class (Eq (VerificationKey keyrole),
 -- For KES we can then override it to keep the seed and key in mlocked memory at all times.
 -- | Generate a 'SigningKey' using a seed from operating system entropy.
 --
-generateSigningKey :: Key keyrole => AsType keyrole -> IO (SigningKey keyrole)
+generateSigningKey
+  :: MonadIO m
+  => Key keyrole
+  => AsType keyrole
+  -> m (SigningKey keyrole)
 generateSigningKey keytype = do
-    seed <- Crypto.readSeedFromSystemEntropy seedSize
+    seed <- liftIO $ Crypto.readSeedFromSystemEntropy seedSize
     return $! deterministicSigningKey keytype seed
   where
     seedSize = deterministicSigningKeySeedSize keytype
 
 
 generateInsecureSigningKey
-  :: (Key keyrole, SerialiseAsRawBytes (SigningKey keyrole))
+  :: MonadIO m
+  => Key keyrole
+  => SerialiseAsRawBytes (SigningKey keyrole)
   => StdGen
   -> AsType keyrole
-  -> IO (SigningKey keyrole, StdGen)
+  -> m (SigningKey keyrole, StdGen)
 generateInsecureSigningKey g keytype = do
   let (bs, g') = Random.genByteString (fromIntegral $ deterministicSigningKeySeedSize keytype) g
   case deserialiseFromRawBytes (AsSigningKey keytype) bs of