Merge pull request #489 from IntersectMBO/mgalazyn/feature/script-bas…

…ed-cc-members

Add support for script-based CC members

cardano-api/internal/Cardano/Api/Certificate.hs

@@ -423,18 +423,18 @@ makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequire
 data CommitteeColdkeyResignationRequirements era where
   CommitteeColdkeyResignationRequirements
     :: ConwayEraOnwards era
-    -> Ledger.KeyHash Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
+    -> Ledger.Credential Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
     -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
     -> CommitteeColdkeyResignationRequirements era
 
 makeCommitteeColdkeyResignationCertificate :: ()
   => CommitteeColdkeyResignationRequirements era
   -> Certificate era
-makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyHash anchor) =
+makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyCred anchor) =
   ConwayCertificate cOnwards
     . Ledger.ConwayTxCertGov
     $ Ledger.ConwayResignCommitteeColdKey
-        (Ledger.KeyHashObj coldKeyHash)
+        coldKeyCred
         (noInlineMaybeToStrictMaybe anchor)
 
 data DRepUnregistrationRequirements era where

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"
-
-

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

cardano-api/internal/Cardano/Api/Keys/Shelley.hs

@@ -147,7 +147,7 @@ instance SerialiseAsBech32 (SigningKey PaymentKey) where
     bech32PrefixesPermitted _ = ["addr_sk"]
 
 newtype instance Hash PaymentKey =
-    PaymentKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto)
+    PaymentKeyHash { unPaymentKeyHash :: Shelley.KeyHash Shelley.Payment StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentKey)
@@ -294,7 +294,7 @@ instance SerialiseAsBech32 (SigningKey PaymentExtendedKey) where
 
 
 newtype instance Hash PaymentExtendedKey =
-    PaymentExtendedKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto)
+    PaymentExtendedKeyHash { unPaymentExtendedKeyHash :: Shelley.KeyHash Shelley.Payment StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentExtendedKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentExtendedKey)
@@ -400,7 +400,7 @@ instance SerialiseAsBech32 (SigningKey StakeKey) where
 
 
 newtype instance Hash StakeKey =
-    StakeKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
+    StakeKeyHash { unStakeKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash StakeKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeKey)
@@ -543,7 +543,7 @@ instance SerialiseAsBech32 (SigningKey StakeExtendedKey) where
 
 
 newtype instance Hash StakeExtendedKey =
-    StakeExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
+    StakeExtendedKeyHash { unStakeExtendedKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash StakeExtendedKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeExtendedKey)
@@ -640,7 +640,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisKey) where
 
 
 newtype instance Hash GenesisKey =
-    GenesisKeyHash (Shelley.KeyHash Shelley.Genesis StandardCrypto)
+    GenesisKeyHash { unGenesisKeyHash :: Shelley.KeyHash Shelley.Genesis StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisKey)
@@ -738,7 +738,7 @@ instance SerialiseAsRawBytes (SigningKey CommitteeHotKey) where
 
 
 newtype instance Hash CommitteeHotKey =
-    CommitteeHotKeyHash (Shelley.KeyHash Shelley.HotCommitteeRole StandardCrypto)
+    CommitteeHotKeyHash { unCommitteeHotKeyHash :: Shelley.KeyHash Shelley.HotCommitteeRole StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash CommitteeHotKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeHotKey)
@@ -846,7 +846,7 @@ instance SerialiseAsRawBytes (SigningKey CommitteeColdKey) where
 
 
 newtype instance Hash CommitteeColdKey =
-    CommitteeColdKeyHash (Shelley.KeyHash Shelley.ColdCommitteeRole StandardCrypto)
+    CommitteeColdKeyHash { unCommitteeColdKeyHash :: Shelley.KeyHash Shelley.ColdCommitteeRole StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash CommitteeColdKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeColdKey)
@@ -1251,7 +1251,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisExtendedKey) where
 
 
 newtype instance Hash GenesisExtendedKey =
-    GenesisExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
+    GenesisExtendedKeyHash { unGenesisExtendedKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisExtendedKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisExtendedKey)
@@ -1349,7 +1349,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisDelegateKey) where
 
 
 newtype instance Hash GenesisDelegateKey =
-    GenesisDelegateKeyHash (Shelley.KeyHash Shelley.GenesisDelegate StandardCrypto)
+    GenesisDelegateKeyHash { unGenesisDelegateKeyHash :: Shelley.KeyHash Shelley.GenesisDelegate StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisDelegateKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateKey)
@@ -1492,7 +1492,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisDelegateExtendedKey) where
 
 
 newtype instance Hash GenesisDelegateExtendedKey =
-    GenesisDelegateExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
+    GenesisDelegateExtendedKeyHash { unGenesisDelegateExtendedKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisDelegateExtendedKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateExtendedKey)
@@ -1589,7 +1589,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisUTxOKey) where
 
 
 newtype instance Hash GenesisUTxOKey =
-    GenesisUTxOKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto)
+    GenesisUTxOKeyHash { unGenesisUTxOKeyHash :: Shelley.KeyHash Shelley.Payment StandardCrypto }
   deriving stock (Eq, Ord)
   deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisUTxOKey)
   deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisUTxOKey)