Skip to content

Commit

Permalink
Document GADT constructor arguments
Browse files Browse the repository at this point in the history
  • Loading branch information
newhoggy committed May 20, 2024
1 parent 074114b commit 11db5cf
Show file tree
Hide file tree
Showing 14 changed files with 455 additions and 198 deletions.
77 changes: 46 additions & 31 deletions cardano-api/internal/Cardano/Api/Address.hs
Original file line number Diff line number Diff line change
Expand Up @@ -175,25 +175,29 @@ instance HasTypeProxy ShelleyAddr where
-- with the era in which it is supported.
--
data Address addrtype where

-- | Byron addresses were the only supported address type in the original
-- Byron era.
--
ByronAddress
:: Byron.Address
-> Address ByronAddr

-- | Shelley addresses allow delegation. Shelley addresses were introduced
-- in Shelley era and are thus supported from the Shelley era onwards
--
ShelleyAddress
:: Shelley.Network
-> Shelley.PaymentCredential StandardCrypto
-> Shelley.StakeReference StandardCrypto
-> Address ShelleyAddr
-- Note that the two ledger credential types here are parametrised by
-- the era, but in fact this is a phantom type parameter and they are
-- the same for all eras. See 'toShelleyAddr' below.
-- | Byron addresses were the only supported address type in the original
-- Byron era.
--
ByronAddress
:: Byron.Address
-- ^ The Byron address
-> Address ByronAddr

-- | Shelley addresses allow delegation. Shelley addresses were introduced
-- in Shelley era and are thus supported from the Shelley era onwards
--
-- Note that the two ledger credential types here are parameterrised by
-- the era, but in fact this is a phantom type parameter and they are
-- the same for all eras. See 'toShelleyAddr' below.
--
ShelleyAddress
:: Shelley.Network
-- ^ The shelley network
-> Shelley.PaymentCredential StandardCrypto
-- ^ Payment credentials
-> Shelley.StakeReference StandardCrypto
-- ^ Stake reference
-> Address ShelleyAddr

deriving instance Eq (Address addrtype)
deriving instance Ord (Address addrtype)
Expand Down Expand Up @@ -363,9 +367,12 @@ fromShelleyAddrToAny (Shelley.Addr nw pc scr) =
-- supported in the 'ShelleyEra' and later eras.
--
data AddressInEra era where
AddressInEra :: AddressTypeInEra addrtype era
-> Address addrtype
-> AddressInEra era
AddressInEra
:: AddressTypeInEra addrtype era
-- ^ Witness that the address type is supported in the era
-> Address addrtype
-- ^ The address
-> AddressInEra era

instance NFData (AddressInEra era) where
rnf (AddressInEra t a) = deepseq (deepseq t a) ()
Expand Down Expand Up @@ -428,10 +435,15 @@ deriving instance Show (AddressInEra era)

data AddressTypeInEra addrtype era where

ByronAddressInAnyEra :: AddressTypeInEra ByronAddr era
-- | Byron addresses are supported in all eras.
ByronAddressInAnyEra
:: AddressTypeInEra ByronAddr era

ShelleyAddressInEra :: ShelleyBasedEra era
-> AddressTypeInEra ShelleyAddr era
-- | Shelley addresses are supported in the Shelley era and later eras.
ShelleyAddressInEra
:: ShelleyBasedEra era
-- ^ Witness that the era is shelley era onwards
-> AddressTypeInEra ShelleyAddr era

deriving instance Show (AddressTypeInEra addrtype era)

Expand Down Expand Up @@ -523,15 +535,17 @@ makeShelleyAddressInEra sbe nw pc scr =
--

data StakeAddress where
StakeAddress
:: Shelley.Network
-> Shelley.StakeCredential StandardCrypto
-> StakeAddress
StakeAddress
:: Shelley.Network
-- ^ The shelley network
-> Shelley.StakeCredential StandardCrypto
-- ^ The stake credential
-> StakeAddress
deriving (Eq, Ord, Show)

data PaymentCredential
= PaymentCredentialByKey (Hash PaymentKey)
| PaymentCredentialByScript ScriptHash
= PaymentCredentialByKey (Hash PaymentKey)
| PaymentCredentialByScript ScriptHash
deriving (Eq, Ord, Show)

data StakeCredential
Expand Down Expand Up @@ -679,6 +693,7 @@ fromShelleyAddrIsSbe sbe = \case

fromShelleyAddr
:: ShelleyBasedEra era
-- ^ Witness that the era is shelley era onwards
-> Shelley.Addr StandardCrypto
-> AddressInEra era
fromShelleyAddr _ (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) =
Expand Down
19 changes: 13 additions & 6 deletions cardano-api/internal/Cardano/Api/Block.hs
Original file line number Diff line number Diff line change
Expand Up @@ -94,12 +94,17 @@ import Data.Text (Text)
--
data Block era where

ByronBlock :: Consensus.ByronBlock
-> Block ByronEra

ShelleyBlock :: ShelleyBasedEra era
-> Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> Block era
ByronBlock
:: Consensus.ByronBlock
-- ^ The underlying Byron block type
-> Block ByronEra

ShelleyBlock
:: ShelleyBasedEra era
-- ^ Shelley based era witness
-> Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-- ^ The underlying Shelley block type
-> Block era

-- | A block consists of a header and a body containing transactions.
--
Expand Down Expand Up @@ -186,7 +191,9 @@ getShelleyBlockTxs era (Ledger.Block _header txs) =
data BlockInMode where
BlockInMode
:: CardanoEra era
-- ^ The era of the block
-> Block era
-- ^ The block itself
-> BlockInMode

deriving instance Show BlockInMode
Expand Down
85 changes: 66 additions & 19 deletions cardano-api/internal/Cardano/Api/Certificate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -114,25 +114,29 @@ import Network.Socket (PortNumber)
--

data Certificate era where
-- Pre-Conway
-- 1. Stake registration
-- 2. Stake unregistration
-- 3. Stake delegation
-- 4. Pool retirement
-- 5. Pool registration
-- 6. Genesis delegation
-- 7. MIR certificates
ShelleyRelatedCertificate
:: ShelleyToBabbageEra era
-> Ledger.ShelleyTxCert (ShelleyLedgerEra era)
-> Certificate era

-- Conway onwards
-- TODO: Add comments about the new types of certificates
ConwayCertificate
:: ConwayEraOnwards era
-> Ledger.ConwayTxCert (ShelleyLedgerEra era)
-> Certificate era
-- Pre-Conway
-- 1. Stake registration
-- 2. Stake unregistration
-- 3. Stake delegation
-- 4. Pool retirement
-- 5. Pool registration
-- 6. Genesis delegation
-- 7. MIR certificates
ShelleyRelatedCertificate
:: ShelleyToBabbageEra era
-- ^ Shelley to babbage era witness
-> Ledger.ShelleyTxCert (ShelleyLedgerEra era)
-- ^ Shelley ledger transaction certificate
-> Certificate era

-- Conway onwards
-- TODO: Add comments about the new types of certificates
ConwayCertificate
:: ConwayEraOnwards era
-- ^ Conway era onwards witness
-> Ledger.ConwayTxCert (ShelleyLedgerEra era)
-- ^ Conway ledger transaction certificate
-> Certificate era

deriving anyclass SerialiseAsCBOR

Expand Down Expand Up @@ -250,13 +254,18 @@ data DRepMetadataReference =
data StakeAddressRequirements era where
StakeAddrRegistrationConway
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> L.Coin
-- ^ Deposit
-> StakeCredential
-- ^ Stake credential
-> StakeAddressRequirements era

StakeAddrRegistrationPreConway
:: ShelleyToBabbageEra era
-- ^ Witness that the era is shelley to babbage
-> StakeCredential
-- ^ Stake credential
-> StakeAddressRequirements era

makeStakeAddressRegistrationCertificate :: StakeAddressRequirements era -> Certificate era
Expand Down Expand Up @@ -286,14 +295,20 @@ makeStakeAddressUnregistrationCertificate req =
data StakeDelegationRequirements era where
StakeDelegationRequirementsConwayOnwards
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> StakeCredential
-- ^ Stake credential
-> Ledger.Delegatee (EraCrypto (ShelleyLedgerEra era))
-- ^ Delegatee
-> StakeDelegationRequirements era

StakeDelegationRequirementsPreConway
:: ShelleyToBabbageEra era
-- ^ Witness that the era is shelley to babbage
-> StakeCredential
-- ^ Stake credential
-> PoolId
-- ^ Pool id
-> StakeDelegationRequirements era

makeStakeAddressDelegationCertificate :: StakeDelegationRequirements era -> Certificate era
Expand All @@ -311,12 +326,16 @@ makeStakeAddressDelegationCertificate = \case
data StakePoolRegistrationRequirements era where
StakePoolRegistrationRequirementsConwayOnwards
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> Ledger.PoolParams (EraCrypto (ShelleyLedgerEra era))
-- ^ Pool parameters
-> StakePoolRegistrationRequirements era

StakePoolRegistrationRequirementsPreConway
:: ShelleyToBabbageEra era
-- ^ Witness that the era is shelley to babbage
-> Ledger.PoolParams (EraCrypto (ShelleyLedgerEra era))
-- ^ Pool parameters
-> StakePoolRegistrationRequirements era

makeStakePoolRegistrationCertificate :: ()
Expand All @@ -335,14 +354,20 @@ makeStakePoolRegistrationCertificate = \case
data StakePoolRetirementRequirements era where
StakePoolRetirementRequirementsConwayOnwards
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> PoolId
-- ^ Pool id
-> Ledger.EpochNo
-- ^ Retirement epoch number
-> StakePoolRetirementRequirements era

StakePoolRetirementRequirementsPreConway
:: ShelleyToBabbageEra era
-- ^ Witness that the era is shelley to babbage
-> PoolId
-- ^ Pool id
-> Ledger.EpochNo
-- ^ Retirement epoch number
-> StakePoolRetirementRequirements era

makeStakePoolRetirementCertificate :: ()
Expand All @@ -362,9 +387,13 @@ makeStakePoolRetirementCertificate req =
data GenesisKeyDelegationRequirements ere where
GenesisKeyDelegationRequirements
:: ShelleyToBabbageEra era
-- ^ Witness that the era is shelley to babbage
-> Hash GenesisKey
-- ^ Genesis key hash
-> Hash GenesisDelegateKey
-- ^ Genesis delegate key hash
-> Hash VrfKey
-- ^ VRF key hash
-> GenesisKeyDelegationRequirements era

makeGenesisKeyDelegationCertificate :: GenesisKeyDelegationRequirements era -> Certificate era
Expand All @@ -377,8 +406,11 @@ makeGenesisKeyDelegationCertificate (GenesisKeyDelegationRequirements atMostEra
data MirCertificateRequirements era where
MirCertificateRequirements
:: ShelleyToBabbageEra era
-- ^ Witness that the era is shelley to babbage
-> Ledger.MIRPot
-- ^ MIR pot
-> Ledger.MIRTarget (EraCrypto (ShelleyLedgerEra era))
-- ^ MIR target
-> MirCertificateRequirements era

makeMIRCertificate :: ()
Expand All @@ -391,8 +423,11 @@ makeMIRCertificate (MirCertificateRequirements atMostEra mirPot mirTarget) =
data DRepRegistrationRequirements era where
DRepRegistrationRequirements
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era)))
-- ^ DRep credential
-> L.Coin
-- ^ Deposit
-> DRepRegistrationRequirements era


Expand All @@ -408,8 +443,11 @@ makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards vcre
data CommitteeHotKeyAuthorizationRequirements era where
CommitteeHotKeyAuthorizationRequirements
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> Ledger.Credential Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-- ^ Cold key credential
-> Ledger.Credential Ledger.HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-- ^ Hot key credential
-> CommitteeHotKeyAuthorizationRequirements era

makeCommitteeHotKeyAuthorizationCertificate :: ()
Expand All @@ -423,8 +461,11 @@ makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequire
data CommitteeColdkeyResignationRequirements era where
CommitteeColdkeyResignationRequirements
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> Ledger.Credential Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-- ^ Cold key credential
-> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
-- ^ Anchor
-> CommitteeColdkeyResignationRequirements era

makeCommitteeColdkeyResignationCertificate :: ()
Expand All @@ -440,8 +481,11 @@ makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequireme
data DRepUnregistrationRequirements era where
DRepUnregistrationRequirements
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era)))
-- ^ DRep credential
-> L.Coin
-- ^ Deposit
-> DRepUnregistrationRequirements era

makeDrepUnregistrationCertificate :: ()
Expand All @@ -466,7 +510,9 @@ makeStakeAddressAndDRepDelegationCertificate w cred delegatee deposit =
data DRepUpdateRequirements era where
DRepUpdateRequirements
:: ConwayEraOnwards era
-- ^ Witness that the era is conway onwards
-> Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era))
-- ^ DRep credential
-> DRepUpdateRequirements era

makeDrepUpdateCertificate
Expand All @@ -484,6 +530,7 @@ makeDrepUpdateCertificate (DRepUpdateRequirements conwayOnwards vcred) mAnchor =

getTxCertWitness
:: ShelleyBasedEra era
-- ^ Witness that the era is shelley era onwards
-> Ledger.TxCert (ShelleyLedgerEra era)
-> Maybe StakeCredential
getTxCertWitness sbe ledgerCert = shelleyBasedEraConstraints sbe $
Expand Down
6 changes: 5 additions & 1 deletion cardano-api/internal/Cardano/Api/Error.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,11 @@ throwErrorAsException :: Error e => e -> IO a
throwErrorAsException e = throwIO (ErrorAsException e)

data ErrorAsException where
ErrorAsException :: Error e => e -> ErrorAsException
ErrorAsException
:: Error e
=> e
-- ^ The error
-> ErrorAsException

instance Error ErrorAsException where
prettyError (ErrorAsException e) =
Expand Down
Loading

0 comments on commit 11db5cf

Please sign in to comment.