{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Ledger.Shelley.API.ByronTranslation
  ( translateToShelleyLedgerState,

    -- * Exported for testing purposes
    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 Cardano.Ledger.Address (isBootstrapRedeemer)
import Cardano.Ledger.BaseTypes (BlocksMade (..), TxIx (..))
import Cardano.Ledger.Coin (CompactForm (CompactCoin))
import Cardano.Ledger.CompactAddress (CompactAddr (UnsafeCompactAddr))
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Era (getTxOutBootstrapAddress)
import Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API.Types
import Cardano.Ledger.Shelley.EpochBoundary
import Cardano.Ledger.Shelley.Rules.EraMapping ()
import Cardano.Ledger.Slot
import Cardano.Ledger.Val ((<->))
import qualified Data.ByteString.Short as SBS
import Data.Default.Class (def)
import qualified Data.Map.Strict as Map
import Data.Word
import GHC.Stack (HasCallStack)

-- | We use the same hashing algorithm so we can unwrap and rewrap the bytes.
-- We don't care about the type that is hashed, which will differ going from
-- Byron to Shelley, we just use the hashes as IDs.
translateTxIdByronToShelley ::
  (CC.Crypto c, CC.ADDRHASH c ~ Crypto.Blake2b_224) =>
  Byron.TxId ->
  TxId c
translateTxIdByronToShelley :: TxId -> TxId c
translateTxIdByronToShelley =
  SafeHash c EraIndependentTxBody -> TxId c
forall crypto. SafeHash crypto EraIndependentTxBody -> TxId crypto
TxId (SafeHash c EraIndependentTxBody -> TxId c)
-> (TxId -> SafeHash c EraIndependentTxBody) -> TxId -> TxId c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH c) EraIndependentTxBody
-> SafeHash c EraIndependentTxBody
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
unsafeMakeSafeHash (Hash (HASH c) EraIndependentTxBody
 -> SafeHash c EraIndependentTxBody)
-> (TxId -> Hash (HASH c) EraIndependentTxBody)
-> TxId
-> SafeHash c EraIndependentTxBody
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 =
  case ShortByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
Crypto.hashFromBytesShort ShortByteString
sbs of
    Just !Hash h a
h -> Hash h a
h
    Maybe (Hash h a)
Nothing ->
      [Char] -> Hash h a
forall a. HasCallStack => [Char] -> a
error ([Char] -> Hash h a) -> [Char] -> Hash h a
forall a b. (a -> b) -> a -> b
$ [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 Word16
idx) =
  TxId c -> TxIx -> TxIn c
forall crypto. TxId crypto -> TxIx -> TxIn crypto
TxIn
    (TxId -> TxId c
forall c. (Crypto c, ADDRHASH c ~ Blake2b_224) => TxId -> TxId c
translateTxIdByronToShelley (CompactTxId -> TxId
Byron.fromCompactTxId CompactTxId
compactTxId))
    (Word64 -> TxIx
TxIx ((Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) Word16
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 (PulsingRewUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> StashedAVVMAddresses 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 (PulsingRewUpdate (Crypto (ShelleyEra c)))
nesRu = StrictMaybe (PulsingRewUpdate (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,
      -- At this point, we compute the stashed AVVM addresses, while we are able
      -- to do a linear scan of the UTxO, and stash them away for use at the
      -- Shelley/Allegra boundary.
      stashedAVVMAddresses :: StashedAVVMAddresses (ShelleyEra c)
stashedAVVMAddresses =
        let UTxO Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
utxo = UTxOState (ShelleyEra c) -> UTxO (ShelleyEra c)
forall era. UTxOState era -> UTxO era
_utxo (UTxOState (ShelleyEra c) -> UTxO (ShelleyEra c))
-> (EpochState (ShelleyEra c) -> UTxOState (ShelleyEra c))
-> EpochState (ShelleyEra c)
-> UTxO (ShelleyEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyEra c) -> UTxOState (ShelleyEra c)
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState (ShelleyEra c) -> UTxOState (ShelleyEra c))
-> (EpochState (ShelleyEra c) -> LedgerState (ShelleyEra c))
-> EpochState (ShelleyEra c)
-> UTxOState (ShelleyEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState (ShelleyEra c) -> LedgerState (ShelleyEra c)
forall era. EpochState era -> LedgerState era
esLState (EpochState (ShelleyEra c) -> UTxO (ShelleyEra c))
-> EpochState (ShelleyEra c) -> UTxO (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$ EpochState (ShelleyEra c)
epochState
            redeemers :: Map (TxIn c) (TxOut (ShelleyEra c))
redeemers =
              (TxOut (ShelleyEra c) -> Bool)
-> Map (TxIn c) (TxOut (ShelleyEra c))
-> Map (TxIn c) (TxOut (ShelleyEra c))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool
-> (BootstrapAddress c -> Bool)
-> Maybe (BootstrapAddress c)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BootstrapAddress c -> Bool
forall crypto. BootstrapAddress crypto -> Bool
isBootstrapRedeemer (Maybe (BootstrapAddress c) -> Bool)
-> (TxOut (ShelleyEra c) -> Maybe (BootstrapAddress c))
-> TxOut (ShelleyEra c)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (ShelleyEra c) -> Maybe (BootstrapAddress c)
forall era.
Era era =>
TxOut era -> Maybe (BootstrapAddress (Crypto era))
getTxOutBootstrapAddress) Map (TxIn c) (TxOut (ShelleyEra c))
Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
utxo
         in Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
-> UTxO (ShelleyEra c)
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn c) (TxOut (ShelleyEra c))
Map (TxIn (Crypto (ShelleyEra c))) (TxOut (ShelleyEra c))
redeemers
    }
  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

    -- NOTE: we ignore the Byron delegation map because the genesis and
    -- delegation verification keys are hashed using a different hashing
    -- scheme. This means we can't simply convert them, as Byron nowhere stores
    -- the original verification keys.
    --
    -- Fortunately, no Byron genesis delegations have happened yet, and if
    -- they did, we would be aware of them before the hard fork, as we
    -- instigate the hard fork. We just have to make sure that the hard-coded
    -- Shelley genesis contains the same genesis and delegation verification
    -- keys, but hashed with the right algorithm.
    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. Era 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 (ShelleyEra c)
pparams,
          esPp :: PParams (ShelleyEra c)
esPp = PParams (ShelleyEra c)
PParams (ShelleyEra c)
pparams,
          esNonMyopic :: NonMyopic (Crypto (ShelleyEra c))
esNonMyopic = NonMyopic (Crypto (ShelleyEra c))
forall a. Default a => a
def
        }

    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
        { lsUTxOState :: UTxOState (ShelleyEra c)
lsUTxOState =
            UTxOState :: forall era.
UTxO era
-> Coin
-> Coin
-> State (EraRule "PPUP" era)
-> IncrementalStake (Crypto 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 :: State (EraRule "PPUP" (ShelleyEra c))
_ppups = State (EraRule "PPUP" (ShelleyEra c))
forall a. Default a => a
def,
                _stakeDistro :: IncrementalStake (Crypto (ShelleyEra c))
_stakeDistro = Map (Credential 'Staking c) Coin
-> Map Ptr Coin -> IncrementalStake c
forall crypto.
Map (Credential 'Staking crypto) Coin
-> Map Ptr Coin -> IncrementalStake crypto
IStake Map (Credential 'Staking c) Coin
forall a. Monoid a => a
mempty Map Ptr Coin
forall k a. Map k a
Map.empty
              },
          lsDPState :: DPState (Crypto (ShelleyEra c))
lsDPState =
            DPState :: forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState
              { dpsDState :: DState c
dpsDState = DState c
forall a. Default a => a
def {_genDelegs :: GenDelegs c
_genDelegs = GenDelegs c
genDelegs},
                dpsPState :: PState c
dpsPState = PState c
forall a. Default a => a
def
              }
        }