Skip to content

Commit

Permalink
Merge pull request #41 from input-output-hk/newhoggy/cip-1694-api
Browse files Browse the repository at this point in the history
CIP-1694 API - Part 1
  • Loading branch information
Jimbo4350 committed Jun 27, 2023
2 parents e0762e4 + 5ee7bfc commit f3469ab
Show file tree
Hide file tree
Showing 11 changed files with 898 additions and 43 deletions.
3 changes: 3 additions & 0 deletions cardano-api/cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -54,13 +54,16 @@ library internal
Cardano.Api.Convenience.Construction
Cardano.Api.Convenience.Query
Cardano.Api.DeserialiseAnyOf
Cardano.Api.DRepMetadata
Cardano.Api.EraCast
Cardano.Api.Eras
Cardano.Api.Error
Cardano.Api.Feature
Cardano.Api.Fees
Cardano.Api.Genesis
Cardano.Api.GenesisParameters
Cardano.Api.Governance.Actions.ProposalProcedure
Cardano.Api.Governance.Actions.VotingProcedure
Cardano.Api.Governance.Poll
Cardano.Api.Hash
Cardano.Api.HasTypeProxy
Expand Down
5 changes: 4 additions & 1 deletion cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -644,7 +644,8 @@ genTxBodyContent era = do
txUpdateProposal <- genTxUpdateProposal era
txMintValue <- genTxMintValue era
txScriptValidity <- genTxScriptValidity era

txGovernanceActions <- return TxGovernanceActionsNone -- TODO: Conway era
txVotes <- return TxVotesNone -- TODO: Conway era
pure $ TxBodyContent
{ Api.txIns
, Api.txInsCollateral
Expand All @@ -663,6 +664,8 @@ genTxBodyContent era = do
, Api.txUpdateProposal
, Api.txMintValue
, Api.txScriptValidity
, Api.txGovernanceActions
, Api.txVotes
}

genTxInsCollateral :: CardanoEra era -> Gen (TxInsCollateral era)
Expand Down
61 changes: 55 additions & 6 deletions cardano-api/internal/Cardano/Api/Certificate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,12 @@ module Cardano.Api.Certificate (
StakePoolRelay(..),
StakePoolMetadataReference(..),

makeCommitteeDelegationCertificate,
makeCommitteeHotKeyUnregistrationCertificate,

-- * Registering DReps
DRepMetadataReference(..),

-- * Special certificates
makeMIRCertificate,
makeGenesisKeyDelegationCertificate,
Expand All @@ -38,9 +44,8 @@ module Cardano.Api.Certificate (
) where

import Cardano.Api.Address
import Cardano.Api.Hash
import Cardano.Api.DRepMetadata
import Cardano.Api.HasTypeProxy
import Cardano.Api.Keys.Byron
import Cardano.Api.Keys.Praos
import Cardano.Api.Keys.Shelley
import Cardano.Api.SerialiseCBOR
Expand Down Expand Up @@ -87,9 +92,18 @@ data Certificate =
| StakePoolRetirementCertificate PoolId EpochNo

-- Special certificates
| GenesisKeyDelegationCertificate (Hash GenesisKey)
(Hash GenesisDelegateKey)
(Hash VrfKey)
| GenesisKeyDelegationCertificate
(Hash GenesisKey)
(Hash GenesisDelegateKey)
(Hash VrfKey)

| CommitteeDelegationCertificate
(Hash CommitteeColdKey)
(Hash CommitteeHotKey)

| CommitteeHotKeyDeregistrationCertificate
(Hash CommitteeColdKey)

| MIRCertificate MIRPot MIRTarget

deriving stock (Eq, Show)
Expand All @@ -109,11 +123,13 @@ instance HasTextEnvelope Certificate where
textEnvelopeType _ = "CertificateShelley"
textEnvelopeDefaultDescr cert = case cert of
StakeAddressRegistrationCertificate{} -> "Stake address registration"
StakeAddressDeregistrationCertificate{} -> "Stake address de-registration"
StakeAddressDeregistrationCertificate{} -> "Stake address deregistration"
StakeAddressPoolDelegationCertificate{} -> "Stake address stake pool delegation"
StakePoolRegistrationCertificate{} -> "Pool registration"
StakePoolRetirementCertificate{} -> "Pool retirement"
GenesisKeyDelegationCertificate{} -> "Genesis key delegation"
CommitteeDelegationCertificate{} -> "Constitution committee member key delegation"
CommitteeHotKeyDeregistrationCertificate{} -> "Constitution committee member hot key deregistration"
MIRCertificate{} -> "MIR"

-- | The 'MIRTarget' determines the target of a 'MIRCertificate'.
Expand Down Expand Up @@ -177,6 +193,17 @@ data StakePoolMetadataReference =
}
deriving (Eq, Show)

-- ----------------------------------------------------------------------------
-- DRep parameters
--

data DRepMetadataReference =
DRepMetadataReference
{ drepMetadataURL :: Text
, drepMetadataHash :: Hash DRepMetadata
}
deriving (Eq, Show)


-- ----------------------------------------------------------------------------
-- Constructor functions
Expand All @@ -203,6 +230,17 @@ makeGenesisKeyDelegationCertificate :: Hash GenesisKey
-> Certificate
makeGenesisKeyDelegationCertificate = GenesisKeyDelegationCertificate

makeCommitteeDelegationCertificate :: ()
=> Hash CommitteeColdKey
-> Hash CommitteeHotKey
-> Certificate
makeCommitteeDelegationCertificate = CommitteeDelegationCertificate

makeCommitteeHotKeyUnregistrationCertificate :: ()
=> Hash CommitteeColdKey
-> Certificate
makeCommitteeHotKeyUnregistrationCertificate = CommitteeHotKeyDeregistrationCertificate

makeMIRCertificate :: MIRPot -> MIRTarget -> Certificate
makeMIRCertificate = MIRCertificate

Expand Down Expand Up @@ -252,6 +290,17 @@ toShelleyCertificate (GenesisKeyDelegationCertificate
delegatekh
vrfkh

toShelleyCertificate
( CommitteeDelegationCertificate
(CommitteeColdKeyHash _ckh)
(CommitteeHotKeyHash _hkh)
) = error "TODO CIP-1694 Need ledger types for CommitteeDelegationCertificate"

toShelleyCertificate
( CommitteeHotKeyDeregistrationCertificate
(CommitteeColdKeyHash _ckh)
) = error "TODO CIP-1694 Need ledger types for CommitteeHotKeyDeregistrationCertificate"

toShelleyCertificate (MIRCertificate mirpot (StakeAddressesMIR amounts)) =
Shelley.DCertMir $
Shelley.MIRCert
Expand Down
92 changes: 92 additions & 0 deletions cardano-api/internal/Cardano/Api/DRepMetadata.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,92 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}

-- | DRep off-chain metadata
--
module Cardano.Api.DRepMetadata (
-- * DRep off-chain metadata
DRepMetadata(..),
validateAndHashDRepMetadata,
DRepMetadataValidationError(..),

-- * Data family instances
AsType(..),
Hash(..),
) where

import Cardano.Api.Eras
import Cardano.Api.Error
import Cardano.Api.Hash
import Cardano.Api.HasTypeProxy
import Cardano.Api.Keys.Byron
import Cardano.Api.Keys.Praos
import Cardano.Api.Script
import Cardano.Api.SerialiseRaw

import qualified Cardano.Crypto.Hash.Class as Crypto
import Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Keys as Shelley

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Either.Combinators (maybeToRight)

-- ----------------------------------------------------------------------------
-- DRep metadata
--

-- | A representation of the required fields for off-chain drep metadata.
--
newtype DRepMetadata = DRepMetadata
{ unDRepMetadata :: ByteString
} deriving (Eq, Show)

newtype instance Hash DRepMetadata = DRepMetadataHash (Shelley.Hash StandardCrypto ByteString)
deriving (Eq, Show)

instance HasTypeProxy DRepMetadata where
data AsType DRepMetadata = AsDRepMetadata
proxyToAsType _ = AsDRepMetadata

instance SerialiseAsRawBytes (Hash DRepMetadata) where
serialiseToRawBytes (DRepMetadataHash h) = Crypto.hashToBytes h

deserialiseFromRawBytes (AsHash AsDRepMetadata) bs =
maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash DRepMetadata") $
DRepMetadataHash <$> Crypto.hashFromBytes bs

-- | A drep metadata validation error.
data DRepMetadataValidationError
= DRepMetadataInvalidLengthError
-- ^ The length of the JSON-encoded drep metadata exceeds the
-- maximum.
!Int
-- ^ Maximum byte length.
!Int
-- ^ Actual byte length.
deriving Show

instance Error DRepMetadataValidationError where
displayError = \case
DRepMetadataInvalidLengthError maxLen actualLen ->
mconcat
[ "DRep metadata must consist of at most "
, show maxLen
, " bytes, but it consists of "
, show actualLen
, " bytes."
]

-- | Decode and validate the provided JSON-encoded bytes as 'DRepMetadata'.
-- Return the decoded metadata and the hash of the original bytes.
validateAndHashDRepMetadata
:: ByteString
-> Either DRepMetadataValidationError (DRepMetadata, Hash DRepMetadata)
validateAndHashDRepMetadata bs
-- TODO confirm if there are size limits to the DRep metadata
| BS.length bs <= 512 = do
let md = DRepMetadata bs
let mdh = DRepMetadataHash (Crypto.hashWith id bs)
return (md, mdh)
| otherwise = Left $ DRepMetadataInvalidLengthError 512 (BS.length bs)
Original file line number Diff line number Diff line change
@@ -0,0 +1,83 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Api.Governance.Actions.ProposalProcedure where

import Cardano.Api.Eras
import Cardano.Api.Keys.Shelley
import Cardano.Api.Utils
import Cardano.Api.Value

import qualified Cardano.Ledger.Conway.Governance as Gov
import Cardano.Ledger.Core (EraCrypto)
import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Ledger.SafeHash

import Data.ByteString (ByteString)
import Data.Maybe.Strict
import Data.Proxy

-- | A representation of whether the era supports tx governance actions.
--
-- The Conway and subsequent eras support governance actions.
--
data TxGovernanceActions era where
TxGovernanceActionsNone :: TxGovernanceActions era

TxGovernanceActions
:: TxGovernanceActionSupportedInEra era
-- (deposit, return address, governance action)
-> [(Lovelace, Hash StakeKey, GovernanceAction)]
-> TxGovernanceActions era

deriving instance Show (TxGovernanceActions era)
deriving instance Eq (TxGovernanceActions era)


-- | A representation of whether the era supports transactions with governance
-- actions.
--
-- The Conway and subsequent eras support governance actions.
--
data TxGovernanceActionSupportedInEra era where

GovernanceActionsSupportedInConwayEra :: TxGovernanceActionSupportedInEra ConwayEra

deriving instance Show (TxGovernanceActionSupportedInEra era)
deriving instance Eq (TxGovernanceActionSupportedInEra era)


data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovernanceAction era)

-- TODO: Conway - fill in remaining actions
data GovernanceAction
= MotionOfNoConfidence
| ProposeNewConstitution ByteString
deriving (Eq, Show)

toSafeHash :: ByteString -> SafeHash StandardCrypto ByteString
toSafeHash = makeHashWithExplicitProxys (Proxy :: Proxy StandardCrypto) (Proxy :: Proxy ByteString)

toGovernanceAction
:: EraCrypto ledgerera ~ StandardCrypto
=> GovernanceAction
-> Gov.GovernanceAction ledgerera
toGovernanceAction MotionOfNoConfidence = Gov.NoConfidence
toGovernanceAction (ProposeNewConstitution bs) =
Gov.NewConstitution $ toSafeHash bs

createProposalProcedure
:: ShelleyBasedEra era
-> Lovelace -- ^ Deposit
-> Hash StakeKey -- ^ Return address
-> GovernanceAction
-> Gov.ProposalProcedure (ShelleyLedgerEra era)
createProposalProcedure sbe dep (StakeKeyHash retAddrh) govAct =
obtainEraCryptoConstraints sbe $
Gov.ProposalProcedure
{ Gov.pProcDeposit = toShelleyLovelace dep
, Gov.pProcReturnAddr = retAddrh
, Gov.pProcGovernanceAction = toGovernanceAction govAct
, Gov.pProcAnchor = SNothing -- TODO: Conway
}
Loading

0 comments on commit f3469ab

Please sign in to comment.