{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Shelley.Spec.Ledger.API.ByronTranslation
( mkInitialShelleyLedgerView,
translateToShelleyLedgerState,
translateCompactTxOutByronToShelley,
translateTxIdByronToShelley,
)
where
import qualified Cardano.Chain.Block as Byron
import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Chain.UTxO as Byron
import qualified Cardano.Crypto.Hash as Crypto
import qualified Cardano.Crypto.Hashing as Hashing
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Val ((<->))
import qualified Data.ByteString.Short as SBS
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import GHC.Stack (HasCallStack)
import Shelley.Spec.Ledger.API.Protocol
import Shelley.Spec.Ledger.API.Types
import Shelley.Spec.Ledger.Coin (CompactForm (CompactCoin))
import Shelley.Spec.Ledger.CompactAddr (CompactAddr (UnsafeCompactAddr))
import Shelley.Spec.Ledger.EpochBoundary
import Shelley.Spec.Ledger.LedgerState
import Shelley.Spec.Ledger.Rewards
import Shelley.Spec.Ledger.STS.Chain (pparamsToChainChecksData)
import Shelley.Spec.Ledger.Slot
translateTxIdByronToShelley ::
(CC.Crypto c, CC.ADDRHASH c ~ Crypto.Blake2b_224) =>
Byron.TxId ->
TxId c
translateTxIdByronToShelley :: TxId -> TxId c
translateTxIdByronToShelley =
Hash (HASH c) EraIndependentTxBody -> TxId c
forall crypto. Hash crypto EraIndependentTxBody -> TxId crypto
TxId (Hash (HASH c) EraIndependentTxBody -> TxId c)
-> (TxId -> Hash (HASH c) EraIndependentTxBody) -> TxId -> TxId c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Hash (HASH c) EraIndependentTxBody
forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
hashFromShortBytesE (ShortByteString -> Hash (HASH c) EraIndependentTxBody)
-> (TxId -> ShortByteString)
-> TxId
-> Hash (HASH c) EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
Hashing.abstractHashToShort
hashFromShortBytesE ::
forall h a.
(Crypto.HashAlgorithm h, HasCallStack) =>
SBS.ShortByteString ->
Crypto.Hash h a
hashFromShortBytesE :: ShortByteString -> Hash h a
hashFromShortBytesE ShortByteString
sbs = Hash h a -> Maybe (Hash h a) -> Hash h a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Hash h a
forall a. HasCallStack => [Char] -> a
error [Char]
msg) (Maybe (Hash h a) -> Hash h a) -> Maybe (Hash h a) -> Hash h a
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
Crypto.hashFromBytesShort ShortByteString
sbs
where
msg :: [Char]
msg =
[Char]
"hashFromBytesShort called with ShortByteString of the wrong length: "
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> [Char]
forall a. Show a => a -> [Char]
show ShortByteString
sbs
translateCompactTxOutByronToShelley :: Byron.CompactTxOut -> TxOut (ShelleyEra c)
translateCompactTxOutByronToShelley :: CompactTxOut -> TxOut (ShelleyEra c)
translateCompactTxOutByronToShelley (Byron.CompactTxOut CompactAddress
compactAddr Lovelace
amount) =
CompactAddr (Crypto (ShelleyEra c))
-> CompactForm (Value (ShelleyEra c)) -> TxOut (ShelleyEra c)
forall era.
CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
TxOutCompact
(ShortByteString -> CompactAddr c
forall crypto. ShortByteString -> CompactAddr crypto
UnsafeCompactAddr (CompactAddress -> ShortByteString
Byron.unsafeGetCompactAddress CompactAddress
compactAddr))
(Word64 -> CompactForm Coin
CompactCoin (Lovelace -> Word64
Byron.unsafeGetLovelace Lovelace
amount))
translateCompactTxInByronToShelley ::
(CC.Crypto c, CC.ADDRHASH c ~ Crypto.Blake2b_224) =>
Byron.CompactTxIn ->
TxIn c
translateCompactTxInByronToShelley :: CompactTxIn -> TxIn c
translateCompactTxInByronToShelley (Byron.CompactTxInUtxo CompactTxId
compactTxId Word32
idx) =
TxId c -> Word64 -> TxIn c
forall crypto. TxId crypto -> Word64 -> TxIn crypto
TxInCompact
(TxId -> TxId c
forall c. (Crypto c, ADDRHASH c ~ Blake2b_224) => TxId -> TxId c
translateTxIdByronToShelley (CompactTxId -> TxId
Byron.fromCompactTxId CompactTxId
compactTxId))
(Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
idx)
translateUTxOByronToShelley ::
forall c.
(CC.Crypto c, CC.ADDRHASH c ~ Crypto.Blake2b_224) =>
Byron.UTxO ->
UTxO (ShelleyEra c)
translateUTxOByronToShelley :: UTxO -> UTxO (ShelleyEra c)
translateUTxOByronToShelley (Byron.UTxO Map CompactTxIn CompactTxOut
utxoByron) =
Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
-> UTxO (ShelleyEra c)
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
UTxO (Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
-> UTxO (ShelleyEra c))
-> Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
-> UTxO (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$
[(TxIn c, TxOut (ShelleyEra c))]
-> Map (TxIn c) (TxOut (ShelleyEra c))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (TxIn c
txInShelley, TxOut (ShelleyEra c)
txOutShelley)
| (CompactTxIn
txInByron, CompactTxOut
txOutByron) <- Map CompactTxIn CompactTxOut -> [(CompactTxIn, CompactTxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList Map CompactTxIn CompactTxOut
utxoByron,
let txInShelley :: TxIn c
txInShelley = CompactTxIn -> TxIn c
forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
CompactTxIn -> TxIn c
translateCompactTxInByronToShelley CompactTxIn
txInByron
txOutShelley :: TxOut (ShelleyEra c)
txOutShelley = CompactTxOut -> TxOut (ShelleyEra c)
forall c. CompactTxOut -> TxOut (ShelleyEra c)
translateCompactTxOutByronToShelley CompactTxOut
txOutByron
]
translateToShelleyLedgerState ::
forall c.
(CC.Crypto c, CC.ADDRHASH c ~ Crypto.Blake2b_224) =>
ShelleyGenesis (ShelleyEra c) ->
EpochNo ->
Byron.ChainValidationState ->
NewEpochState (ShelleyEra c)
translateToShelleyLedgerState :: ShelleyGenesis (ShelleyEra c)
-> EpochNo -> ChainValidationState -> NewEpochState (ShelleyEra c)
translateToShelleyLedgerState ShelleyGenesis (ShelleyEra c)
genesisShelley EpochNo
epochNo ChainValidationState
cvs =
NewEpochState :: forall era.
EpochNo
-> BlocksMade (Crypto era)
-> BlocksMade (Crypto era)
-> EpochState era
-> StrictMaybe (RewardUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> NewEpochState era
NewEpochState
{ nesEL :: EpochNo
nesEL = EpochNo
epochNo,
nesBprev :: BlocksMade (Crypto (ShelleyEra c))
nesBprev = Map (KeyHash 'StakePool c) Natural -> BlocksMade c
forall crypto.
Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
BlocksMade Map (KeyHash 'StakePool c) Natural
forall k a. Map k a
Map.empty,
nesBcur :: BlocksMade (Crypto (ShelleyEra c))
nesBcur = Map (KeyHash 'StakePool c) Natural -> BlocksMade c
forall crypto.
Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
BlocksMade Map (KeyHash 'StakePool c) Natural
forall k a. Map k a
Map.empty,
nesEs :: EpochState (ShelleyEra c)
nesEs = EpochState (ShelleyEra c)
epochState,
nesRu :: StrictMaybe (RewardUpdate (Crypto (ShelleyEra c)))
nesRu = StrictMaybe (RewardUpdate (Crypto (ShelleyEra c)))
forall a. StrictMaybe a
SNothing,
nesPd :: PoolDistr (Crypto (ShelleyEra c))
nesPd = Map (KeyHash 'StakePool c) (IndividualPoolStake c) -> PoolDistr c
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr Map (KeyHash 'StakePool c) (IndividualPoolStake c)
forall k a. Map k a
Map.empty
}
where
pparams :: PParams (ShelleyEra c)
pparams :: PParams (ShelleyEra c)
pparams = ShelleyGenesis (ShelleyEra c) -> PParams (ShelleyEra c)
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams ShelleyGenesis (ShelleyEra c)
genesisShelley
genDelegs :: GenDelegs c
genDelegs :: GenDelegs c
genDelegs = Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
forall crypto.
Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
-> GenDelegs crypto
GenDelegs (Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c)
-> Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis (ShelleyEra c)
-> Map
(KeyHash 'Genesis (Crypto (ShelleyEra c)))
(GenDelegPair (Crypto (ShelleyEra c)))
forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs ShelleyGenesis (ShelleyEra c)
genesisShelley
reserves :: Coin
reserves :: Coin
reserves =
Word64 -> Coin
word64ToCoin (ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis (ShelleyEra c)
genesisShelley) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> UTxO (ShelleyEra c) -> Value (ShelleyEra c)
forall era. ShelleyBased era => UTxO era -> Value era
balance UTxO (ShelleyEra c)
utxoShelley
epochState :: EpochState (ShelleyEra c)
epochState :: EpochState (ShelleyEra c)
epochState =
EpochState :: forall era.
AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
EpochState
{ esAccountState :: AccountState
esAccountState = Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) Coin
reserves,
esSnapshots :: SnapShots (Crypto (ShelleyEra c))
esSnapshots = SnapShots (Crypto (ShelleyEra c))
forall crypto. SnapShots crypto
emptySnapShots,
esLState :: LedgerState (ShelleyEra c)
esLState = LedgerState (ShelleyEra c)
ledgerState,
esPrevPp :: PParams (ShelleyEra c)
esPrevPp = PParams (ShelleyEra c)
pparams,
esPp :: PParams (ShelleyEra c)
esPp = PParams (ShelleyEra c)
pparams,
esNonMyopic :: NonMyopic (Crypto (ShelleyEra c))
esNonMyopic = NonMyopic (Crypto (ShelleyEra c))
forall crypto. NonMyopic crypto
emptyNonMyopic
}
utxoByron :: Byron.UTxO
utxoByron :: UTxO
utxoByron = ChainValidationState -> UTxO
Byron.cvsUtxo ChainValidationState
cvs
utxoShelley :: UTxO (ShelleyEra c)
utxoShelley :: UTxO (ShelleyEra c)
utxoShelley = UTxO -> UTxO (ShelleyEra c)
forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
UTxO -> UTxO (ShelleyEra c)
translateUTxOByronToShelley UTxO
utxoByron
ledgerState :: LedgerState (ShelleyEra c)
ledgerState :: LedgerState (ShelleyEra c)
ledgerState =
LedgerState :: forall era.
UTxOState era -> DPState (Crypto era) -> LedgerState era
LedgerState
{ _utxoState :: UTxOState (ShelleyEra c)
_utxoState =
UTxOState :: forall era.
UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
UTxOState
{ _utxo :: UTxO (ShelleyEra c)
_utxo = UTxO (ShelleyEra c)
utxoShelley,
_deposited :: Coin
_deposited = Integer -> Coin
Coin Integer
0,
_fees :: Coin
_fees = Integer -> Coin
Coin Integer
0,
_ppups :: PPUPState (ShelleyEra c)
_ppups = PPUPState (ShelleyEra c)
forall era. PPUPState era
emptyPPUPState
},
_delegationState :: DPState (Crypto (ShelleyEra c))
_delegationState =
DPState :: forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState
{ _dstate :: DState c
_dstate = DState c
forall crypto. DState crypto
emptyDState {_genDelegs :: GenDelegs c
_genDelegs = GenDelegs c
genDelegs},
_pstate :: PState c
_pstate = PState c
forall crypto. PState crypto
emptyPState
}
}
mkInitialShelleyLedgerView ::
forall c.
ShelleyGenesis (ShelleyEra c) ->
LedgerView c
mkInitialShelleyLedgerView :: ShelleyGenesis (ShelleyEra c) -> LedgerView c
mkInitialShelleyLedgerView ShelleyGenesis (ShelleyEra c)
genesisShelley =
LedgerView :: forall crypto.
UnitInterval
-> Nonce
-> PoolDistr crypto
-> GenDelegs crypto
-> ChainChecksData
-> LedgerView crypto
LedgerView
{ lvD :: UnitInterval
lvD = PParams' Identity (ShelleyEra c) -> UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d (PParams' Identity (ShelleyEra c) -> UnitInterval)
-> (ShelleyGenesis (ShelleyEra c)
-> PParams' Identity (ShelleyEra c))
-> ShelleyGenesis (ShelleyEra c)
-> UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis (ShelleyEra c) -> PParams' Identity (ShelleyEra c)
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams (ShelleyGenesis (ShelleyEra c) -> UnitInterval)
-> ShelleyGenesis (ShelleyEra c) -> UnitInterval
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis (ShelleyEra c)
genesisShelley,
lvExtraEntropy :: Nonce
lvExtraEntropy = PParams' Identity (ShelleyEra c) -> Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy (PParams' Identity (ShelleyEra c) -> Nonce)
-> (ShelleyGenesis (ShelleyEra c)
-> PParams' Identity (ShelleyEra c))
-> ShelleyGenesis (ShelleyEra c)
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis (ShelleyEra c) -> PParams' Identity (ShelleyEra c)
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams (ShelleyGenesis (ShelleyEra c) -> Nonce)
-> ShelleyGenesis (ShelleyEra c) -> Nonce
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis (ShelleyEra c)
genesisShelley,
lvPoolDistr :: PoolDistr c
lvPoolDistr = Map (KeyHash 'StakePool c) (IndividualPoolStake c) -> PoolDistr c
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr Map (KeyHash 'StakePool c) (IndividualPoolStake c)
forall k a. Map k a
Map.empty,
lvGenDelegs :: GenDelegs c
lvGenDelegs = Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
forall crypto.
Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
-> GenDelegs crypto
GenDelegs (Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c)
-> Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis (ShelleyEra c)
-> Map
(KeyHash 'Genesis (Crypto (ShelleyEra c)))
(GenDelegPair (Crypto (ShelleyEra c)))
forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs ShelleyGenesis (ShelleyEra c)
genesisShelley,
lvChainChecks :: ChainChecksData
lvChainChecks = PParams' Identity (ShelleyEra c) -> ChainChecksData
forall era. PParams era -> ChainChecksData
pparamsToChainChecksData (PParams' Identity (ShelleyEra c) -> ChainChecksData)
-> (ShelleyGenesis (ShelleyEra c)
-> PParams' Identity (ShelleyEra c))
-> ShelleyGenesis (ShelleyEra c)
-> ChainChecksData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis (ShelleyEra c) -> PParams' Identity (ShelleyEra c)
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams (ShelleyGenesis (ShelleyEra c) -> ChainChecksData)
-> ShelleyGenesis (ShelleyEra c) -> ChainChecksData
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis (ShelleyEra c)
genesisShelley
}