Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- hashVerKeyVRF :: ( VRFAlgorithm v, HashAlgorithm h) => VerKeyVRF v -> Hash h ( VerKeyVRF v)
- data StrictMaybe a
- bbody :: Block h era -> TxSeq era
- bheader :: Block h era -> h
-
data
Block
h era
where
- Block' !h !( TxSeq era) ByteString
- pattern UnserialisedBlock :: h -> TxSeq era -> Block h era
- pattern UnsafeUnserialisedBlock :: h -> TxSeq era -> Block h era
- pattern Block :: ( Era era, ToCBORGroup ( TxSeq era), ToCBOR h) => h -> TxSeq era -> Block h era
-
newtype
TxId
crypto =
TxId
{
- _unTxId :: SafeHash crypto EraIndependentTxBody
- data TxIn crypto = TxIn !( TxId crypto) ! TxIx
-
data
Addr
crypto
- = Addr Network ( PaymentCredential crypto) ( StakeReference crypto)
- | AddrBootstrap ( BootstrapAddress crypto)
-
data
RewardAcnt
crypto =
RewardAcnt
{
- getRwdNetwork :: ! Network
- getRwdCred :: !( Credential ' Staking crypto)
- isOverlaySlot :: SlotNo -> UnitInterval -> SlotNo -> Bool
-
data
Credential
(kr ::
KeyRole
) crypto
- = ScriptHashObj !( ScriptHash crypto)
- | KeyHashObj !( KeyHash kr crypto)
-
data
StakeReference
crypto
- = StakeRefBase !( StakeCredential crypto)
- | StakeRefPtr ! Ptr
- | StakeRefNull
- data Ptr = Ptr ! SlotNo ! TxIx ! CertIx
- certIxFromIntegral :: Integral a => a -> Maybe CertIx
- certIxToInt :: CertIx -> Int
- txIxFromIntegral :: Integral a => a -> Maybe TxIx
- txIxToInt :: TxIx -> Int
- data ProtVer = ProtVer { }
-
data
Nonce
- = Nonce !( Hash Blake2b_256 Nonce )
- | NeutralNonce
- newtype Port = Port { }
-
data
Globals
=
Globals
{
- epochInfo :: !( EpochInfo ( Either Text ))
- slotsPerKESPeriod :: ! Word64
- stabilityWindow :: ! Word64
- randomnessStabilisationWindow :: ! Word64
- securityParameter :: ! Word64
- maxKESEvo :: ! Word64
- quorum :: ! Word64
- maxMajorPV :: ! Natural
- maxLovelaceSupply :: ! Word64
- activeSlotCoeff :: ! ActiveSlotCoeff
- networkId :: ! Network
- systemStart :: ! SystemStart
- data Network
- data TxIx
- data CertIx
- individualPoolStake :: IndividualPoolStake crypto -> Rational
-
newtype
PoolDistr
crypto =
PoolDistr
{
- unPoolDistr :: Map ( KeyHash ' StakePool crypto) ( IndividualPoolStake crypto)
- hashKey :: forall crypto (kd :: KeyRole ). Crypto crypto => VKey kd crypto -> KeyHash kd crypto
-
data
KeyRole
- = Genesis
- | GenesisDelegate
- | Payment
- | Staking
- | StakePool
- | BlockIssuer
- | Witness
- coerceKeyRole :: forall (r :: KeyRole ) crypto (r' :: KeyRole ). HasKeyRole a => a r crypto -> a r' crypto
-
newtype
VKey
(kd ::
KeyRole
) crypto =
VKey
{
- unVKey :: VerKeyDSIGN ( DSIGN crypto)
-
data
KeyPair
(kd ::
KeyRole
) crypto =
KeyPair
{
- vKey :: !( VKey kd crypto)
- sKey :: !( SignKeyDSIGN ( DSIGN crypto))
- newtype KeyHash (discriminator :: KeyRole ) crypto = KeyHash ( Hash ( ADDRHASH crypto) ( VerKeyDSIGN ( DSIGN crypto)))
- type KESignable c = Signable ( KES c)
-
data
GenDelegPair
crypto =
GenDelegPair
{
- genDelegKeyHash :: !( KeyHash ' GenesisDelegate crypto)
- genDelegVrfHash :: !( Hash crypto ( VerKeyVRF crypto))
-
newtype
GenDelegs
crypto =
GenDelegs
{
- unGenDelegs :: Map ( KeyHash ' Genesis crypto) ( GenDelegPair crypto)
- type Hash c = Hash ( HASH c)
- type SignedDSIGN c = SignedDSIGN ( DSIGN c)
- type SignKeyDSIGN c = SignKeyDSIGN ( DSIGN c)
- type SignedKES c = SignedKES ( KES c)
- type SignKeyKES c = SignKeyKES ( KES c)
- type VerKeyKES c = VerKeyKES ( KES c)
- type CertifiedVRF c = CertifiedVRF ( VRF c)
- type SignKeyVRF c = SignKeyVRF ( VRF c)
- type VerKeyVRF c = VerKeyVRF ( VRF c)
- newtype ScriptHash crypto = ScriptHash ( Hash ( ADDRHASH crypto) EraIndependentScript )
- word64ToCoin :: Word64 -> Coin
- newtype Coin = Coin { }
-
data
BootstrapWitness
crypto
where
- pattern BootstrapWitness :: Crypto crypto => VKey ' Witness crypto -> SignedDSIGN crypto ( Hash crypto EraIndependentTxBody ) -> ChainCode -> ByteString -> BootstrapWitness crypto
- data Metadata era where
- data Metadatum
- newtype ProposedPPUpdates era = ProposedPPUpdates ( Map ( KeyHash ' Genesis ( Crypto era)) ( PParamsDelta era))
- data Update era = Update !( ProposedPPUpdates era) ! EpochNo
- type PParams era = PParams' Identity era
-
data
PParams'
f era =
PParams
{
- _minfeeA :: !( HKD f Natural )
- _minfeeB :: !( HKD f Natural )
- _maxBBSize :: !( HKD f Natural )
- _maxTxSize :: !( HKD f Natural )
- _maxBHSize :: !( HKD f Natural )
- _keyDeposit :: !( HKD f Coin )
- _poolDeposit :: !( HKD f Coin )
- _eMax :: !( HKD f EpochNo )
- _nOpt :: !( HKD f Natural )
- _a0 :: !( HKD f NonNegativeInterval )
- _rho :: !( HKD f UnitInterval )
- _tau :: !( HKD f UnitInterval )
- _d :: !( HKD f UnitInterval )
- _extraEntropy :: !( HKD f Nonce )
- _protocolVersion :: !( HKD f ProtVer )
- _minUTxOValue :: !( HKD f Coin )
- _minPoolCost :: !( HKD f Coin )
-
data
MultiSig
crypto
where
- pattern RequireMOf :: Crypto crypto => Int -> [ MultiSig crypto] -> MultiSig crypto
- pattern RequireSignature :: Crypto crypto => KeyHash ' Witness crypto -> MultiSig crypto
- pattern RequireAllOf :: Crypto crypto => [ MultiSig crypto] -> MultiSig crypto
- pattern RequireAnyOf :: Crypto crypto => [ MultiSig crypto] -> MultiSig crypto
- computeStabilityWindow :: Word64 -> ActiveSlotCoeff -> Word64
- computeRandomnessStabilisationWindow :: Word64 -> ActiveSlotCoeff -> Word64
-
newtype
StakeCreds
crypto =
StakeCreds
{
- unStakeCreds :: Map ( Credential ' Staking crypto) SlotNo
-
data
WitVKey
kr crypto
where
- pattern WitVKey :: ( Typeable kr, Crypto crypto) => VKey kr crypto -> SignedDSIGN crypto ( Hash crypto EraIndependentTxBody ) -> WitVKey kr crypto
-
newtype
TxBody
era
where
- TxBodyConstr ( MemoBytes ( TxBodyRaw era))
- pattern TxBody :: ( Era era, FromCBOR ( PParamsDelta era), TransTxBody ToCBOR era) => Set ( TxIn ( Crypto era)) -> StrictSeq ( TxOut era) -> StrictSeq ( DCert ( Crypto era)) -> Wdrl ( Crypto era) -> Coin -> SlotNo -> StrictMaybe ( Update era) -> StrictMaybe ( AuxiliaryDataHash ( Crypto era)) -> TxBody era
-
data
DCert
crypto
- = DCertDeleg !( DelegCert crypto)
- | DCertPool !( PoolCert crypto)
- | DCertGenesis !( GenesisDelegCert crypto)
- | DCertMir !( MIRCert crypto)
-
data
MIRCert
crypto =
MIRCert
{
- mirPot :: MIRPot
- mirRewards :: MIRTarget crypto
-
data
MIRTarget
crypto
- = StakeAddressesMIR ( Map ( Credential ' Staking crypto) DeltaCoin )
- | SendToOppositePotMIR Coin
- data MIRPot
- data GenesisDelegCert crypto = GenesisDelegCert !( KeyHash ' Genesis crypto) !( KeyHash ' GenesisDelegate crypto) !( Hash crypto ( VerKeyVRF crypto))
-
data
PoolCert
crypto
- = RegPool !( PoolParams crypto)
- | RetirePool !( KeyHash ' StakePool crypto) ! EpochNo
-
data
DelegCert
crypto
- = RegKey !( StakeCredential crypto)
- | DeRegKey !( StakeCredential crypto)
- | Delegate !( Delegation crypto)
-
data
TxOut
era
where
- TxOutCompact !( CompactAddr ( Crypto era)) !( CompactForm ( Value era))
- pattern TxOut :: ( Era era, Show ( Value era), Compactible ( Value era)) => Addr ( Crypto era) -> Value era -> TxOut era
-
newtype
Wdrl
crypto =
Wdrl
{
- unWdrl :: Map ( RewardAcnt crypto) Coin
-
data
PoolParams
crypto =
PoolParams
{
- _poolId :: !( KeyHash ' StakePool crypto)
- _poolVrf :: !( Hash crypto ( VerKeyVRF crypto))
- _poolPledge :: ! Coin
- _poolCost :: ! Coin
- _poolMargin :: ! UnitInterval
- _poolRAcnt :: !( RewardAcnt crypto)
- _poolOwners :: !( Set ( KeyHash ' Staking crypto))
- _poolRelays :: !( StrictSeq StakePoolRelay )
- _poolMD :: !( StrictMaybe PoolMetadata )
-
data
StakePoolRelay
- = SingleHostAddr !( StrictMaybe Port ) !( StrictMaybe IPv4 ) !( StrictMaybe IPv6 )
- | SingleHostName !( StrictMaybe Port ) ! DnsName
- | MultiHostName ! DnsName
-
data
PoolMetadata
=
PoolMetadata
{
- _poolMDUrl :: ! Url
- _poolMDHash :: ! ByteString
-
data
Delegation
crypto =
Delegation
{
- _delegator :: !( StakeCredential crypto)
- _delegatee :: !( KeyHash ' StakePool crypto)
- type WitnessSet = WitnessSetHKD Identity
-
data
Tx
era
where
- pattern Tx :: ( Era era, ToCBOR ( AuxiliaryData era), ToCBOR ( TxBody era), ToCBOR ( Witnesses era)) => TxBody era -> Witnesses era -> StrictMaybe ( AuxiliaryData era) -> Tx era
- bbHash :: forall era. Era era => TxSeq era -> Hash ( Crypto era) EraIndependentBlockBody
-
data
SnapShots
crypto =
SnapShots
{
- _pstakeMark :: SnapShot crypto
- _pstakeSet :: !( SnapShot crypto)
- _pstakeGo :: !( SnapShot crypto)
- _feeSS :: ! Coin
-
data
SnapShot
crypto =
SnapShot
{
- _stake :: !( Stake crypto)
- _delegations :: !( VMap VB VB ( Credential ' Staking crypto) ( KeyHash ' StakePool crypto))
- _poolParams :: !( VMap VB VB ( KeyHash ' StakePool crypto) ( PoolParams crypto))
-
newtype
Stake
crypto =
Stake
{
- unStake :: VMap VB VP ( Credential ' Staking crypto) ( CompactForm Coin )
- data NonMyopic crypto
- data RewardUpdate crypto = RewardUpdate { }
- newtype UTxO era = UTxO { }
- balance :: forall era. Era era => UTxO era -> Value era
-
newtype
WitHashes
crypto =
WitHashes
{
- unWitHashes :: Set ( KeyHash ' Witness crypto)
-
data
LedgerState
era =
LedgerState
{
- lsUTxOState :: !( UTxOState era)
- lsDPState :: !( DPState ( Crypto era))
-
data
NewEpochState
era =
NewEpochState
{
- nesEL :: ! EpochNo
- nesBprev :: !( BlocksMade ( Crypto era))
- nesBcur :: !( BlocksMade ( Crypto era))
- nesEs :: !( EpochState era)
- nesRu :: !( StrictMaybe ( PulsingRewUpdate ( Crypto era)))
- nesPd :: !( PoolDistr ( Crypto era))
- stashedAVVMAddresses :: !( StashedAVVMAddresses era)
-
data
UTxOState
era =
UTxOState
{
- _utxo :: !( UTxO era)
- _deposited :: ! Coin
- _fees :: ! Coin
- _ppups :: !( State ( EraRule "PPUP" era))
- _stakeDistro :: !( IncrementalStake ( Crypto era))
- data IncrementalStake crypto = IStake { }
-
data
PPUPState
era =
PPUPState
{
- proposals :: !( ProposedPPUpdates era)
- futureProposals :: !( ProposedPPUpdates era)
-
data
EpochState
era =
EpochState
{
- esAccountState :: ! AccountState
- esSnapshots :: !( SnapShots ( Crypto era))
- esLState :: !( LedgerState era)
- esPrevPp :: !( PParams era)
- esPp :: !( PParams era)
- esNonMyopic :: !( NonMyopic ( Crypto era))
- data AccountState = AccountState { }
- data DPState crypto = DPState { }
- data PState crypto = PState { }
-
data
DState
crypto =
DState
{
- _unified :: !( UnifiedMap crypto)
- _fGenDelegs :: !( Map ( FutureGenDeleg crypto) ( GenDelegPair crypto))
- _genDelegs :: !( GenDelegs crypto)
- _irwd :: !( InstantaneousRewards crypto)
-
data
InstantaneousRewards
crypto =
InstantaneousRewards
{
- iRReserves :: !( Map ( Credential ' Staking crypto) Coin )
- iRTreasury :: !( Map ( Credential ' Staking crypto) Coin )
- deltaReserves :: ! DeltaCoin
- deltaTreasury :: ! DeltaCoin
- type KeyPairs crypto = [( KeyPair ' Payment crypto, KeyPair ' Staking crypto)]
- data PPUPEnv era = PPUPEnv SlotNo ( PParams era) ( GenDelegs ( Crypto era))
- data PPUP era
- data UtxoEnv era = UtxoEnv SlotNo ( PParams era) ( Map ( KeyHash ' StakePool ( Crypto era)) ( PoolParams ( Crypto era))) ( GenDelegs ( Crypto era))
- data UTXO era
- data UTXOW era
- data POOLREAP era
- data PoolEnv era = PoolEnv SlotNo ( PParams era)
- data POOL (era :: Type )
- data DelegEnv era = DelegEnv { }
- data DELEG era
-
data
DelplEnv
era =
DelplEnv
{
- delplSlotNo :: SlotNo
- delPlPtr :: Ptr
- delPlPp :: PParams era
- delPlAcnt :: AccountState
- data DELPL era
-
data
DelegsEnv
era =
DelegsEnv
{
- delegsSlotNo :: ! SlotNo
- delegsIx :: ! TxIx
- delegspp :: !( PParams era)
- delegsTx :: !( Tx era)
- delegsAccount :: ! AccountState
- data DELEGS era
-
data
LedgerEnv
era =
LedgerEnv
{
- ledgerSlotNo :: ! SlotNo
- ledgerIx :: ! TxIx
- ledgerPp :: !( PParams era)
- ledgerAccount :: ! AccountState
- data LEDGER era
-
data
LedgersEnv
era =
LedgersEnv
{
- ledgersSlotNo :: SlotNo
- ledgersPp :: PParams era
- ledgersAccount :: AccountState
- data LEDGERS era
- data ValidationErr
-
data
ShelleyGenesis
era =
ShelleyGenesis
{
- sgSystemStart :: ! UTCTime
- sgNetworkMagic :: ! Word32
- sgNetworkId :: ! Network
- sgActiveSlotsCoeff :: ! PositiveUnitInterval
- sgSecurityParam :: ! Word64
- sgEpochLength :: ! EpochSize
- sgSlotsPerKESPeriod :: ! Word64
- sgMaxKESEvolutions :: ! Word64
- sgSlotLength :: ! NominalDiffTime
- sgUpdateQuorum :: ! Word64
- sgMaxLovelaceSupply :: ! Word64
- sgProtocolParams :: !( PParams era)
- sgGenDelegs :: !( Map ( KeyHash ' Genesis ( Crypto era)) ( GenDelegPair ( Crypto era)))
- sgInitialFunds :: !( Map ( Addr ( Crypto era)) Coin )
- sgStaking :: !( ShelleyGenesisStaking ( Crypto era))
- data ShelleyGenesisStaking crypto = ShelleyGenesisStaking { }
- emptyGenesisStaking :: ShelleyGenesisStaking crypto
- sgActiveSlotCoeff :: ShelleyGenesis era -> ActiveSlotCoeff
- genesisUTxO :: forall era. ( Era era, UsesTxOut era) => ShelleyGenesis era -> UTxO era
- initialFundsPseudoTxIn :: forall crypto. Crypto crypto => Addr crypto -> TxIn crypto
- describeValidationErr :: ValidationErr -> Text
- validateGenesis :: forall era. Era era => ShelleyGenesis era -> Either [ ValidationErr ] ()
- mkShelleyGlobals :: ShelleyGenesis era -> EpochInfo ( Either Text ) -> Natural -> Globals
- data NEWEPOCH era
- calculatePoolDistr :: SnapShot crypto -> PoolDistr crypto
- data TICK era
Documentation
hashVerKeyVRF :: ( VRFAlgorithm v, HashAlgorithm h) => VerKeyVRF v -> Hash h ( VerKeyVRF v) Source #
data StrictMaybe a Source #
Instances
Block' !h !( TxSeq era) ByteString |
pattern UnserialisedBlock :: h -> TxSeq era -> Block h era |
Access a block without its serialised bytes. This is often useful when
we're using a
|
pattern UnsafeUnserialisedBlock :: h -> TxSeq era -> Block h era |
Unsafely construct a block without the ability to serialise its bytes. Anyone calling this pattern must ensure that the resulting block is never serialised. Any uses of this pattern outside of testing code should be regarded with suspicion. |
pattern Block :: ( Era era, ToCBORGroup ( TxSeq era), ToCBOR h) => h -> TxSeq era -> Block h era |
Instances
A unique ID of a transaction, which is computable from the transaction.
TxId | |
|
Instances
Eq ( TxId crypto) | |
Ord ( TxId crypto) | |
Defined in Cardano.Ledger.TxIn compare :: TxId crypto -> TxId crypto -> Ordering Source # (<) :: TxId crypto -> TxId crypto -> Bool Source # (<=) :: TxId crypto -> TxId crypto -> Bool Source # (>) :: TxId crypto -> TxId crypto -> Bool Source # (>=) :: TxId crypto -> TxId crypto -> Bool Source # |
|
Show ( TxId crypto) | |
Generic ( TxId crypto) | |
Crypto crypto => NFData ( TxId crypto) | |
Defined in Cardano.Ledger.TxIn |
|
Crypto crypto => ToCBOR ( TxId crypto) | |
Crypto crypto => FromCBOR ( TxId crypto) | |
HeapWords ( TxId crypto) | |
NoThunks ( TxId crypto) | |
type Rep ( TxId crypto) | |
Defined in Cardano.Ledger.TxIn
type
Rep
(
TxId
crypto) =
D1
('
MetaData
"TxId" "Cardano.Ledger.TxIn" "cardano-ledger-core-0.1.0.0-3EJt5rxsPizAWHDEqGPh9V" '
True
) (
C1
('
MetaCons
"TxId" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"_unTxId") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
SafeHash
crypto
EraIndependentTxBody
))))
|
The input of a UTxO.
Instances
Crypto era ~ crypto => HasField "inputs" ( TxBody era) ( Set ( TxIn crypto)) Source # | |
c ~ Crypto era => HasField "txinputs_fee" ( TxBody era) ( Set ( TxIn c)) Source # | |
Eq ( TxIn crypto) | |
Ord ( TxIn crypto) | |
Defined in Cardano.Ledger.TxIn compare :: TxIn crypto -> TxIn crypto -> Ordering Source # (<) :: TxIn crypto -> TxIn crypto -> Bool Source # (<=) :: TxIn crypto -> TxIn crypto -> Bool Source # (>) :: TxIn crypto -> TxIn crypto -> Bool Source # (>=) :: TxIn crypto -> TxIn crypto -> Bool Source # |
|
Show ( TxIn crypto) | |
Generic ( TxIn crypto) | |
Crypto crypto => NFData ( TxIn crypto) | |
Defined in Cardano.Ledger.TxIn |
|
Crypto crypto => ToCBOR ( TxIn crypto) | |
Crypto crypto => FromCBOR ( TxIn crypto) | |
Crypto crypto => HeapWords ( TxIn crypto) | |
NoThunks ( TxIn crypto) | |
type Rep ( TxIn crypto) | |
Defined in Cardano.Ledger.TxIn
type
Rep
(
TxIn
crypto) =
D1
('
MetaData
"TxIn" "Cardano.Ledger.TxIn" "cardano-ledger-core-0.1.0.0-3EJt5rxsPizAWHDEqGPh9V" '
False
) (
C1
('
MetaCons
"TxIn" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
TxId
crypto))
:*:
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
SourceUnpack
'
SourceStrict
'
DecidedUnpack
) (
Rec0
TxIx
)))
|
An address for UTxO.
Contents of Addr data type are intentionally left as lazy, otherwise operating on compact form of an address will result in redundant work.
Addr Network ( PaymentCredential crypto) ( StakeReference crypto) | |
AddrBootstrap ( BootstrapAddress crypto) |
Instances
data RewardAcnt crypto Source #
An account based address for rewards
RewardAcnt | |
|
Instances
:: SlotNo |
The first slot of the given epoch. |
-> UnitInterval |
The decentralization parameter. |
-> SlotNo |
The slot to check. |
-> Bool |
Determine if the given slot is reserved for the overlay schedule.
data Credential (kr :: KeyRole ) crypto Source #
Script hash or key hash for a payment or a staking object.
Note that credentials (unlike raw key hashes) do appear to vary from era to era, since they reference the hash of a script, which can change. This parameter is a phantom, however, so in actuality the instances will remain the same.
ScriptHashObj !( ScriptHash crypto) | |
KeyHashObj !( KeyHash kr crypto) |
Instances
data StakeReference crypto Source #
StakeRefBase !( StakeCredential crypto) | |
StakeRefPtr ! Ptr | |
StakeRefNull |
Instances
Pointer to a slot number, transaction index and an index in certificate list.
Instances
Eq Ptr | |
Ord Ptr | |
Show Ptr | |
Generic Ptr | |
NFData Ptr | |
Defined in Cardano.Ledger.Credential |
|
ToCBOR Ptr | |
FromCBOR Ptr | |
ToCBORGroup Ptr | |
FromCBORGroup Ptr | |
Defined in Cardano.Ledger.Credential fromCBORGroup :: Decoder s Ptr Source # |
|
NoThunks Ptr | |
type Rep Ptr | |
Defined in Cardano.Ledger.Credential
type
Rep
Ptr
=
D1
('
MetaData
"Ptr" "Cardano.Ledger.Credential" "cardano-ledger-core-0.1.0.0-3EJt5rxsPizAWHDEqGPh9V" '
False
) (
C1
('
MetaCons
"Ptr" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedUnpack
) (
Rec0
SlotNo
)
:*:
(
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedUnpack
) (
Rec0
TxIx
)
:*:
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedUnpack
) (
Rec0
CertIx
))))
|
certIxToInt :: CertIx -> Int Source #
Instances
Evolving nonce type.
Nonce !( Hash Blake2b_256 Nonce ) | |
NeutralNonce |
Identity element |
Instances
Eq Nonce | |
Ord Nonce | |
Defined in Cardano.Ledger.BaseTypes |
|
Show Nonce | |
Generic Nonce | |
NFData Nonce | |
Defined in Cardano.Ledger.BaseTypes |
|
ToJSON Nonce | |
FromJSON Nonce | |
ToCBOR Nonce | |
FromCBOR Nonce | |
NoThunks Nonce | |
type Rep Nonce | |
Defined in Cardano.Ledger.BaseTypes
type
Rep
Nonce
=
D1
('
MetaData
"Nonce" "Cardano.Ledger.BaseTypes" "cardano-ledger-core-0.1.0.0-3EJt5rxsPizAWHDEqGPh9V" '
False
) (
C1
('
MetaCons
"Nonce" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
Hash
Blake2b_256
Nonce
)))
:+:
C1
('
MetaCons
"NeutralNonce" '
PrefixI
'
False
) (
U1
::
Type
->
Type
))
|
Globals | |
|
Instances
Instances
Bounded Network | |
Enum Network | |
Defined in Cardano.Ledger.BaseTypes succ :: Network -> Network Source # pred :: Network -> Network Source # toEnum :: Int -> Network Source # fromEnum :: Network -> Int Source # enumFrom :: Network -> [ Network ] Source # enumFromThen :: Network -> Network -> [ Network ] Source # enumFromTo :: Network -> Network -> [ Network ] Source # enumFromThenTo :: Network -> Network -> Network -> [ Network ] Source # |
|
Eq Network | |
Ord Network | |
Defined in Cardano.Ledger.BaseTypes |
|
Show Network | |
Generic Network | |
NFData Network | |
Defined in Cardano.Ledger.BaseTypes |
|
ToJSON Network | |
FromJSON Network | |
ToCBOR Network | |
FromCBOR Network | |
Default Network Source # | |
Defined in Cardano.Ledger.Shelley.Orphans |
|
NoThunks Network | |
type Rep Network | |
Defined in Cardano.Ledger.BaseTypes |
Transaction index.
Instances
Bounded TxIx | |
Enum TxIx | |
Eq TxIx | |
Ord TxIx | |
Defined in Cardano.Ledger.BaseTypes |
|
Show TxIx | |
NFData TxIx | |
Defined in Cardano.Ledger.BaseTypes |
|
ToCBOR TxIx | |
FromCBOR TxIx | |
NoThunks TxIx | |
Certificate index. Use
certIxFromIntegral
in order to construct this
index safely from anything other than
Word16
. There is also
mkCertIxPartial
that can be used for testing.
Instances
Bounded CertIx | |
Enum CertIx | |
Defined in Cardano.Ledger.BaseTypes succ :: CertIx -> CertIx Source # pred :: CertIx -> CertIx Source # toEnum :: Int -> CertIx Source # fromEnum :: CertIx -> Int Source # enumFrom :: CertIx -> [ CertIx ] Source # enumFromThen :: CertIx -> CertIx -> [ CertIx ] Source # enumFromTo :: CertIx -> CertIx -> [ CertIx ] Source # enumFromThenTo :: CertIx -> CertIx -> CertIx -> [ CertIx ] Source # |
|
Eq CertIx | |
Ord CertIx | |
Show CertIx | |
NFData CertIx | |
Defined in Cardano.Ledger.BaseTypes |
|
ToCBOR CertIx | |
FromCBOR CertIx | |
NoThunks CertIx | |
individualPoolStake :: IndividualPoolStake crypto -> Rational Source #
newtype PoolDistr crypto Source #
A map of stake pool IDs (the hash of the stake pool operator's
verification key) to
IndividualPoolStake
.
PoolDistr | |
|
Instances
Eq ( PoolDistr crypto) | |
Show ( PoolDistr crypto) | |
NFData ( PoolDistr crypto) | |
Defined in Cardano.Ledger.PoolDistr |
|
Crypto crypto => ToCBOR ( PoolDistr crypto) | |
Defined in Cardano.Ledger.PoolDistr |
|
Crypto crypto => FromCBOR ( PoolDistr crypto) | |
NoThunks ( PoolDistr crypto) | |
HasExp ( PoolDistr crypto) ( Map ( KeyHash ' StakePool crypto) ( IndividualPoolStake crypto)) | |
Defined in Cardano.Ledger.PoolDistr |
|
Embed ( PoolDistr crypto) ( Map ( KeyHash ' StakePool crypto) ( IndividualPoolStake crypto)) |
We can Embed a Newtype around a Map (or other Iterable type) and then use it in a set expression. |
hashKey :: forall crypto (kd :: KeyRole ). Crypto crypto => VKey kd crypto -> KeyHash kd crypto Source #
Hash a given public key
The role of a key.
Note that a role is not _fixed_, nor is it unique. In particular, keys may
variously be used as witnesses, and so in many case we will change the role
of a key to the
Witness
role.
It is also perfectly allowable for a key to be used in many roles; there is nothing prohibiting somebody using the same underlying key as their payment and staking key, as well as the key for their stake pool. So these roles are more intended for two purposes:
- To make explicit how we are using a key in the specifications
- To provide a guide to downstream implementors, for whom the profusion of keys may be confusing.
coerceKeyRole :: forall (r :: KeyRole ) crypto (r' :: KeyRole ). HasKeyRole a => a r crypto -> a r' crypto Source #
General coercion of key roles.
The presence of this function is mostly to help the user realise where they are converting key roles.
newtype VKey (kd :: KeyRole ) crypto Source #
Discriminated verification key
We wrap the basic
VerKeyDSIGN
in order to add the key role.
VKey | |
|
Instances
HasKeyRole VKey | |
Defined in Cardano.Ledger.Keys |
|
Crypto crypto => Eq ( VKey kd crypto) | |
Crypto crypto => Show ( VKey kd crypto) | |
Generic ( VKey kd crypto) | |
( Crypto crypto, NFData ( VerKeyDSIGN ( DSIGN crypto))) => NFData ( VKey kd crypto) | |
Defined in Cardano.Ledger.Keys |
|
( Crypto crypto, Typeable kd) => ToCBOR ( VKey kd crypto) | |
( Crypto crypto, Typeable kd) => FromCBOR ( VKey kd crypto) | |
Crypto crypto => NoThunks ( VKey kd crypto) | |
type Rep ( VKey kd crypto) | |
Defined in Cardano.Ledger.Keys
type
Rep
(
VKey
kd crypto) =
D1
('
MetaData
"VKey" "Cardano.Ledger.Keys" "cardano-ledger-core-0.1.0.0-3EJt5rxsPizAWHDEqGPh9V" '
True
) (
C1
('
MetaCons
"VKey" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"unVKey") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
VerKeyDSIGN
(
DSIGN
crypto)))))
|
data KeyPair (kd :: KeyRole ) crypto Source #
Pair of signing key and verification key, with a usage role.
Instances
HasKeyRole KeyPair | |
Defined in Cardano.Ledger.Keys |
|
Crypto crypto => Show ( KeyPair kd crypto) | |
Generic ( KeyPair kd crypto) | |
( Crypto crypto, NFData ( VerKeyDSIGN ( DSIGN crypto)), NFData ( SignKeyDSIGN ( DSIGN crypto))) => NFData ( KeyPair kd crypto) | |
Defined in Cardano.Ledger.Keys |
|
Crypto crypto => NoThunks ( KeyPair kd crypto) | |
type Rep ( KeyPair kd crypto) | |
Defined in Cardano.Ledger.Keys
type
Rep
(
KeyPair
kd crypto) =
D1
('
MetaData
"KeyPair" "Cardano.Ledger.Keys" "cardano-ledger-core-0.1.0.0-3EJt5rxsPizAWHDEqGPh9V" '
False
) (
C1
('
MetaCons
"KeyPair" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"vKey") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
VKey
kd crypto))
:*:
S1
('
MetaSel
('
Just
"sKey") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
SignKeyDSIGN
(
DSIGN
crypto)))))
|
newtype KeyHash (discriminator :: KeyRole ) crypto Source #
Discriminated hash of public Key
KeyHash ( Hash ( ADDRHASH crypto) ( VerKeyDSIGN ( DSIGN crypto))) |
Instances
HasKeyRole KeyHash | |
Defined in Cardano.Ledger.Keys |
|
HasExp ( PoolDistr crypto) ( Map ( KeyHash ' StakePool crypto) ( IndividualPoolStake crypto)) | |
Defined in Cardano.Ledger.PoolDistr |
|
Embed ( PoolDistr crypto) ( Map ( KeyHash ' StakePool crypto) ( IndividualPoolStake crypto)) |
We can Embed a Newtype around a Map (or other Iterable type) and then use it in a set expression. |
Eq ( KeyHash discriminator crypto) | |
Ord ( KeyHash discriminator crypto) | |
Defined in Cardano.Ledger.Keys compare :: KeyHash discriminator crypto -> KeyHash discriminator crypto -> Ordering Source # (<) :: KeyHash discriminator crypto -> KeyHash discriminator crypto -> Bool Source # (<=) :: KeyHash discriminator crypto -> KeyHash discriminator crypto -> Bool Source # (>) :: KeyHash discriminator crypto -> KeyHash discriminator crypto -> Bool Source # (>=) :: KeyHash discriminator crypto -> KeyHash discriminator crypto -> Bool Source # max :: KeyHash discriminator crypto -> KeyHash discriminator crypto -> KeyHash discriminator crypto Source # min :: KeyHash discriminator crypto -> KeyHash discriminator crypto -> KeyHash discriminator crypto Source # |
|
Show ( KeyHash discriminator crypto) | |
Generic ( KeyHash discriminator crypto) | |
NFData ( KeyHash discriminator crypto) | |
Defined in Cardano.Ledger.Keys |
|
Crypto crypto => ToJSON ( KeyHash disc crypto) | |
Crypto crypto => ToJSONKey ( KeyHash disc crypto) | |
Defined in Cardano.Ledger.Keys toJSONKey :: ToJSONKeyFunction ( KeyHash disc crypto) Source # toJSONKeyList :: ToJSONKeyFunction [ KeyHash disc crypto] Source # |
|
Crypto crypto => FromJSON ( KeyHash disc crypto) | |
Crypto crypto => FromJSONKey ( KeyHash disc crypto) | |
Defined in Cardano.Ledger.Keys fromJSONKey :: FromJSONKeyFunction ( KeyHash disc crypto) Source # fromJSONKeyList :: FromJSONKeyFunction [ KeyHash disc crypto] Source # |
|
( Crypto crypto, Typeable disc) => ToCBOR ( KeyHash disc crypto) | |
Defined in Cardano.Ledger.Keys |
|
( Crypto crypto, Typeable disc) => FromCBOR ( KeyHash disc crypto) | |
Crypto b => Default ( KeyHash a b) Source # | |
Defined in Cardano.Ledger.Shelley.Orphans |
|
NoThunks ( KeyHash discriminator crypto) | |
type Rep ( KeyHash discriminator crypto) | |
Defined in Cardano.Ledger.Keys |
type KESignable c = Signable ( KES c) Source #
data GenDelegPair crypto Source #
GenDelegPair | |
|
Instances
newtype GenDelegs crypto Source #
GenDelegs | |
|
Instances
Eq ( GenDelegs crypto) | |
Show ( GenDelegs crypto) | |
Generic ( GenDelegs crypto) | |
NFData ( GenDelegs crypto) | |
Defined in Cardano.Ledger.Keys |
|
Crypto crypto => ToCBOR ( GenDelegs crypto) | |
Crypto crypto => FromCBOR ( GenDelegs crypto) | |
NoThunks ( GenDelegs crypto) | |
type Rep ( GenDelegs crypto) | |
Defined in Cardano.Ledger.Keys
type
Rep
(
GenDelegs
crypto) =
D1
('
MetaData
"GenDelegs" "Cardano.Ledger.Keys" "cardano-ledger-core-0.1.0.0-3EJt5rxsPizAWHDEqGPh9V" '
True
) (
C1
('
MetaCons
"GenDelegs" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"unGenDelegs") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
Map
(
KeyHash
'
Genesis
crypto) (
GenDelegPair
crypto)))))
|
type SignedDSIGN c = SignedDSIGN ( DSIGN c) Source #
type SignKeyDSIGN c = SignKeyDSIGN ( DSIGN c) Source #
type SignKeyKES c = SignKeyKES ( KES c) Source #
type CertifiedVRF c = CertifiedVRF ( VRF c) Source #
type SignKeyVRF c = SignKeyVRF ( VRF c) Source #
newtype ScriptHash crypto Source #
ScriptHash ( Hash ( ADDRHASH crypto) EraIndependentScript ) |
Instances
word64ToCoin :: Word64 -> Coin Source #
The amount of value held by a transaction output.
Instances
data BootstrapWitness crypto where Source #
pattern BootstrapWitness :: Crypto crypto => VKey ' Witness crypto -> SignedDSIGN crypto ( Hash crypto EraIndependentTxBody ) -> ChainCode -> ByteString -> BootstrapWitness crypto |
Instances
data Metadata era where Source #
Instances
A generic metadatum type.
Instances
newtype ProposedPPUpdates era Source #
Update operation for protocol parameters structure @PParams
ProposedPPUpdates ( Map ( KeyHash ' Genesis ( Crypto era)) ( PParamsDelta era)) |
Instances
Update Proposal
Update !( ProposedPPUpdates era) ! EpochNo |
Instances
Protocol parameters.
We use the HKD type family so that the protocol parameters type and
the type for the updates to the protocol parameters can share records fields.
The protocol parameters will have type
PParams'
Identity
, and the updates
will have type
PParams'
StrictMaybe
, though
Identity
will be hidden from use.
For example:
myParameters = PParams { _minfeeA = 0, _minfeeB = 0, ... } myUpdate = PParamsUpdate { _minfeeA = SNothing, _minfeeB = SJust 42, ... }
PParams | |
|
Instances
data MultiSig crypto where Source #
pattern RequireMOf :: Crypto crypto => Int -> [ MultiSig crypto] -> MultiSig crypto | |
pattern RequireSignature :: Crypto crypto => KeyHash ' Witness crypto -> MultiSig crypto | |
pattern RequireAllOf :: Crypto crypto => [ MultiSig crypto] -> MultiSig crypto | |
pattern RequireAnyOf :: Crypto crypto => [ MultiSig crypto] -> MultiSig crypto |
Instances
computeStabilityWindow :: Word64 -> ActiveSlotCoeff -> Word64 Source #
Calculate the stability window (e.g. the number of slots needed for a block to become stable) from the security param and the active slot coefficient.
The value 3k/f is determined to be a suitabe value as per https://docs.google.com/document/d/1B8BNMx8jVWRjYiUBOaI3jfZ7dQNvNTSDODvT5iOuYCU/edit#heading=h.qh2zcajmu6hm
computeRandomnessStabilisationWindow :: Word64 -> ActiveSlotCoeff -> Word64 Source #
Calculate the randomness stabilisation window from the security param and the active slot coefficient.
The value 4k/f is determined to be a suitabe value as per https://docs.google.com/document/d/1B8BNMx8jVWRjYiUBOaI3jfZ7dQNvNTSDODvT5iOuYCU/edit#heading=h.qh2zcajmu6hm
newtype StakeCreds crypto Source #
StakeCreds | |
|
Instances
data WitVKey kr crypto where Source #
Proof/Witness that a transaction is authorized by the given key holder.
pattern WitVKey :: ( Typeable kr, Crypto crypto) => VKey kr crypto -> SignedDSIGN crypto ( Hash crypto EraIndependentTxBody ) -> WitVKey kr crypto |
Instances
TxBodyConstr ( MemoBytes ( TxBodyRaw era)) |
pattern TxBody :: ( Era era, FromCBOR ( PParamsDelta era), TransTxBody ToCBOR era) => Set ( TxIn ( Crypto era)) -> StrictSeq ( TxOut era) -> StrictSeq ( DCert ( Crypto era)) -> Wdrl ( Crypto era) -> Coin -> SlotNo -> StrictMaybe ( Update era) -> StrictMaybe ( AuxiliaryDataHash ( Crypto era)) -> TxBody era |
Pattern for use by external users |
Instances
A heavyweight certificate.
DCertDeleg !( DelegCert crypto) | |
DCertPool !( PoolCert crypto) | |
DCertGenesis !( GenesisDelegCert crypto) | |
DCertMir !( MIRCert crypto) |
Instances
Move instantaneous rewards certificate
MIRCert | |
|
Instances
Eq ( MIRCert crypto) Source # | |
Show ( MIRCert crypto) Source # | |
Generic ( MIRCert crypto) Source # | |
NFData ( MIRCert crypto) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
|
Crypto crypto => ToCBOR ( MIRCert crypto) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
|
Crypto crypto => FromCBOR ( MIRCert crypto) Source # | |
NoThunks ( MIRCert crypto) Source # | |
type Rep ( MIRCert crypto) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody
type
Rep
(
MIRCert
crypto) =
D1
('
MetaData
"MIRCert" "Cardano.Ledger.Shelley.TxBody" "cardano-ledger-shelley-0.1.0.0-4LNBTpyKcsy6EW18a3tTt2" '
False
) (
C1
('
MetaCons
"MIRCert" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"mirPot") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
MIRPot
)
:*:
S1
('
MetaSel
('
Just
"mirRewards") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
MIRTarget
crypto))))
|
data MIRTarget crypto Source #
MIRTarget specifies if funds from either the reserves or the treasury are to be handed out to a collection of reward accounts or instead transfered to the opposite pot.
StakeAddressesMIR ( Map ( Credential ' Staking crypto) DeltaCoin ) | |
SendToOppositePotMIR Coin |
Instances
Instances
Bounded MIRPot Source # | |
Enum MIRPot Source # | |
Defined in Cardano.Ledger.Shelley.TxBody succ :: MIRPot -> MIRPot Source # pred :: MIRPot -> MIRPot Source # toEnum :: Int -> MIRPot Source # fromEnum :: MIRPot -> Int Source # enumFrom :: MIRPot -> [ MIRPot ] Source # enumFromThen :: MIRPot -> MIRPot -> [ MIRPot ] Source # enumFromTo :: MIRPot -> MIRPot -> [ MIRPot ] Source # enumFromThenTo :: MIRPot -> MIRPot -> MIRPot -> [ MIRPot ] Source # |
|
Eq MIRPot Source # | |
Ord MIRPot Source # | |
Show MIRPot Source # | |
Generic MIRPot Source # | |
NFData MIRPot Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
|
ToCBOR MIRPot Source # | |
FromCBOR MIRPot Source # | |
NoThunks MIRPot Source # | |
type Rep MIRPot Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
data GenesisDelegCert crypto Source #
Genesis key delegation certificate
GenesisDelegCert !( KeyHash ' Genesis crypto) !( KeyHash ' GenesisDelegate crypto) !( Hash crypto ( VerKeyVRF crypto)) |
Instances
RegPool !( PoolParams crypto) |
A stake pool registration certificate. |
RetirePool !( KeyHash ' StakePool crypto) ! EpochNo |
A stake pool retirement certificate. |
Instances
Eq ( PoolCert crypto) Source # | |
Show ( PoolCert crypto) Source # | |
Generic ( PoolCert crypto) Source # | |
NFData ( PoolCert crypto) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
|
NoThunks ( PoolCert crypto) Source # | |
type Rep ( PoolCert crypto) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody
type
Rep
(
PoolCert
crypto) =
D1
('
MetaData
"PoolCert" "Cardano.Ledger.Shelley.TxBody" "cardano-ledger-shelley-0.1.0.0-4LNBTpyKcsy6EW18a3tTt2" '
False
) (
C1
('
MetaCons
"RegPool" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
PoolParams
crypto)))
:+:
C1
('
MetaCons
"RetirePool" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
(
KeyHash
'
StakePool
crypto))
:*:
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
EpochNo
)))
|
data DelegCert crypto Source #
RegKey !( StakeCredential crypto) |
A stake key registration certificate. |
DeRegKey !( StakeCredential crypto) |
A stake key deregistration certificate. |
Delegate !( Delegation crypto) |
A stake delegation certificate. |
Instances
The output of a UTxO.
TxOutCompact !( CompactAddr ( Crypto era)) !( CompactForm ( Value era)) |
pattern TxOut :: ( Era era, Show ( Value era), Compactible ( Value era)) => Addr ( Crypto era) -> Value era -> TxOut era |
Instances
( Compactible v, v ~ Value era) => HasField "value" ( TxOut era) v Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
|
TransTxOut Eq era => Eq ( TxOut era) Source # | |
( TransTxOut Show era, Era era) => Show ( TxOut era) Source # | |
NFData ( TxOut era) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
|
( Era era, TransTxOut ToCBOR era) => ToCBOR ( TxOut era) Source # | |
( Era era, TransTxOut DecodeNonNegative era, Show ( Value era)) => FromCBOR ( TxOut era) Source # | |
( Era era, TransTxOut DecodeNonNegative era, Show ( Value era)) => FromSharedCBOR ( TxOut era) Source # | |
( Crypto ( Crypto era), HeapWords ( CompactForm ( Value era))) => HeapWords ( TxOut era) Source # | |
NoThunks ( TxOut era) Source # | |
type Share ( TxOut era) Source # | |
Wdrl | |
|
Instances
Crypto era ~ crypto => HasField "wdrls" ( TxBody era) ( Wdrl crypto) Source # | |
Eq ( Wdrl crypto) Source # | |
Show ( Wdrl crypto) Source # | |
Generic ( Wdrl crypto) Source # | |
NFData ( Wdrl crypto) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
|
Crypto crypto => ToCBOR ( Wdrl crypto) Source # | |
Crypto crypto => FromCBOR ( Wdrl crypto) Source # | |
NoThunks ( Wdrl crypto) Source # | |
type Rep ( Wdrl crypto) Source # | |
Defined in Cardano.Ledger.Shelley.TxBody
type
Rep
(
Wdrl
crypto) =
D1
('
MetaData
"Wdrl" "Cardano.Ledger.Shelley.TxBody" "cardano-ledger-shelley-0.1.0.0-4LNBTpyKcsy6EW18a3tTt2" '
True
) (
C1
('
MetaCons
"Wdrl" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"unWdrl") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
Map
(
RewardAcnt
crypto)
Coin
))))
|
data PoolParams crypto Source #
A stake pool.
PoolParams | |
|
Instances
data StakePoolRelay Source #
SingleHostAddr !( StrictMaybe Port ) !( StrictMaybe IPv4 ) !( StrictMaybe IPv6 ) |
One or both of IPv4 & IPv6 |
SingleHostName !( StrictMaybe Port ) ! DnsName |
An
|
MultiHostName ! DnsName |
A
|
Instances
data PoolMetadata Source #
PoolMetadata | |
|
Instances
data Delegation crypto Source #
The delegation of one stake key to another.
Delegation | |
|
Instances
type WitnessSet = WitnessSetHKD Identity Source #
pattern Tx :: ( Era era, ToCBOR ( AuxiliaryData era), ToCBOR ( TxBody era), ToCBOR ( Witnesses era)) => TxBody era -> Witnesses era -> StrictMaybe ( AuxiliaryData era) -> Tx era |
Instances
bbHash :: forall era. Era era => TxSeq era -> Hash ( Crypto era) EraIndependentBlockBody Source #
Hash a given block body
data SnapShots crypto Source #
Snapshots of the stake distribution.
SnapShots | |
|
Instances
Snapshot of the stake distribution.
SnapShot | |
|
Instances
Type of stake as map from hash key to coins associated.
Stake | |
|
Instances
Eq ( Stake crypto) Source # | |
Show ( Stake crypto) Source # | |
Generic ( Stake crypto) Source # | |
NFData ( Stake crypto) Source # | |
Defined in Cardano.Ledger.Shelley.EpochBoundary |
|
Crypto crypto => ToCBOR ( Stake crypto) Source # | |
Defined in Cardano.Ledger.Shelley.EpochBoundary |
|
Crypto crypto => FromSharedCBOR ( Stake crypto) Source # | |
Typeable crypto => NoThunks ( Stake crypto) Source # | |
type Rep ( Stake crypto) Source # | |
Defined in Cardano.Ledger.Shelley.EpochBoundary
type
Rep
(
Stake
crypto) =
D1
('
MetaData
"Stake" "Cardano.Ledger.Shelley.EpochBoundary" "cardano-ledger-shelley-0.1.0.0-4LNBTpyKcsy6EW18a3tTt2" '
True
) (
C1
('
MetaCons
"Stake" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"unStake") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
VMap
VB
VP
(
Credential
'
Staking
crypto) (
CompactForm
Coin
)))))
|
|
type Share ( Stake crypto) Source # | |
data NonMyopic crypto Source #
Instances
data RewardUpdate crypto Source #
The ultiate goal of a reward update computation. Aggregating rewards for each staking credential.
Instances
The unspent transaction outputs.
Instances
balance :: forall era. Era era => UTxO era -> Value era Source #
Determine the total balance contained in the UTxO.
newtype WitHashes crypto Source #
WitHashes | |
|
Instances
Eq ( WitHashes crypto) Source # | |
Show ( WitHashes crypto) Source # | |
Generic ( WitHashes crypto) Source # | |
NoThunks ( WitHashes crypto) Source # | |
type Rep ( WitHashes crypto) Source # | |
Defined in Cardano.Ledger.Shelley.LedgerState
type
Rep
(
WitHashes
crypto) =
D1
('
MetaData
"WitHashes" "Cardano.Ledger.Shelley.LedgerState" "cardano-ledger-shelley-0.1.0.0-4LNBTpyKcsy6EW18a3tTt2" '
True
) (
C1
('
MetaCons
"WitHashes" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"unWitHashes") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
Set
(
KeyHash
'
Witness
crypto)))))
|
data LedgerState era Source #
The state associated with a
Ledger
.
LedgerState | |
|
Instances
data NewEpochState era Source #
New Epoch state and environment
NewEpochState | |
|
Instances
There is a serious invariant that we must maintain in the UTxOState. Given (UTxOState utxo _ _ _ istake) it must be the case that istake == (updateStakeDistribution (UTxO Map.empty) (UTxO Map.empty) utxo) Of course computing the RHS of the above equality can be very expensive, so we only use this route in the testing function smartUTxO. But we are very carefull, wherever we update the UTxO, we carefully make INCREMENTAL changes to istake to maintain this invariant. This happens in the UTxO rule.
UTxOState | |
|
Instances
data IncrementalStake crypto Source #
Incremental Stake, Stake along with possible missed coins from danging Ptrs.
Transactions can use Ptrs to refer to a stake credential in a TxOut. The Ptr
does not have to point to anything until the epoch boundary, when we compute
rewards and aggregate staking information for ranking. This is unusual but legal.
In a non incremental system, we use whatever
legal
Ptrs exist at the epoch
boundary. Here we are computing things incrementally, so we need to remember Ptrs
that might point to something by the time the epoch boundary is reached. When
the epoch boundary is reached we
resolve
these pointers, to see if any have
become non-dangling since the time they were first used in the incremental computation.
Instances
PPUPState | |
|
Instances
data EpochState era Source #
EpochState | |
|
Instances
data AccountState Source #
Instances
The state associated with the current stake delegation.
Instances
Current state of staking pools and their certificate counters.
PState | |
|
Instances
State of staking pool delegations and rewards
DState | |
|
Instances
data InstantaneousRewards crypto Source #
InstantaneousRewards captures the pending changes to the ledger state caused by MIR certificates. It consists of two mappings, the rewards which will be paid out from the reserves and the rewards which will be paid out from the treasury. It also consists of two coin values which represent the transfer of coins from one pot to the other pot. NOTE that the following property should always hold: deltaReserves + deltaTreasury = 0
InstantaneousRewards | |
|
Instances
type KeyPairs crypto = [( KeyPair ' Payment crypto, KeyPair ' Staking crypto)] Source #
Representation of a list of pairs of key pairs, e.g., pay and stake keys
Instances
Instances
Instances
Instances
data POOL (era :: Type ) Source #
Instances
Instances
DelplEnv | |
|
Instances
DelegsEnv | |
|
Instances
LedgerEnv | |
|
Instances
data LedgersEnv era Source #
LedgersEnv | |
|
Instances
data ValidationErr Source #
EpochNotLongEnough EpochSize Word64 Rational EpochSize | |
MaxKESEvolutionsUnsupported Word64 Word | |
QuorumTooSmall Word64 Word64 Word64 |
Instances
Eq ValidationErr Source # | |
Defined in Cardano.Ledger.Shelley.Genesis (==) :: ValidationErr -> ValidationErr -> Bool Source # (/=) :: ValidationErr -> ValidationErr -> Bool Source # |
|
Show ValidationErr Source # | |
Defined in Cardano.Ledger.Shelley.Genesis |
data ShelleyGenesis era Source #
Shelley genesis information
Note that this is needed only for a pure Shelley network, hence it being defined here rather than in its own module. In mainnet, Shelley will transition naturally from Byron, and thus will never have its own genesis information.
ShelleyGenesis | |
|
Instances
data ShelleyGenesisStaking crypto Source #
Genesis Shelley staking configuration.
This allows us to configure some initial stake pools and delegation to them, in order to test Praos in a static configuration, without requiring on-chain registration and delegation.
For simplicity, pools defined in the genesis staking do not pay deposits for their registration.
ShelleyGenesisStaking | |
|
Instances
emptyGenesisStaking :: ShelleyGenesisStaking crypto Source #
Empty genesis staking
sgActiveSlotCoeff :: ShelleyGenesis era -> ActiveSlotCoeff Source #
genesisUTxO :: forall era. ( Era era, UsesTxOut era) => ShelleyGenesis era -> UTxO era Source #
initialFundsPseudoTxIn :: forall crypto. Crypto crypto => Addr crypto -> TxIn crypto Source #
Compute the
TxIn
of the initial UTxO pseudo-transaction corresponding
to the given address in the genesis initial funds.
The Shelley initial UTxO is constructed from the
sgInitialFunds
which
is not a full UTxO but just a map from addresses to coin values.
This gets turned into a UTxO by making a pseudo-transaction for each address,
with the 0th output being the coin value. So to spend from the initial UTxO
we need this same
TxIn
to use as an input to the spending transaction.
validateGenesis :: forall era. Era era => ShelleyGenesis era -> Either [ ValidationErr ] () Source #
Do some basic sanity checking on the Shelley genesis file.
mkShelleyGlobals :: ShelleyGenesis era -> EpochInfo ( Either Text ) -> Natural -> Globals Source #
Instances
calculatePoolDistr :: SnapShot crypto -> PoolDistr crypto Source #