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

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

  -- * 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 (fromBoostrapCompactAddress, isBootstrapRedeemer)
import Cardano.Ledger.BaseTypes (BlocksMade (..), EpochNo, TxIx (..))
import Cardano.Ledger.Coin (CompactForm (CompactCoin))
import Cardano.Ledger.Crypto (Crypto (ADDRHASH))
import Cardano.Ledger.EpochBoundary (emptySnapShots)
import Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API.Types
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState.Types (curPParamsEpochStateL, prevPParamsEpochStateL)
import Cardano.Ledger.Shelley.Rules ()
import Cardano.Ledger.Shelley.Translation (FromByronTranslationContext (..))
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (coinBalance)
import Cardano.Ledger.Val (zero, (<->))
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)
import Lens.Micro ((&), (.~), (^.))
import Lens.Micro.Extras (view)

-- | 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 ::
  (Crypto c, ADDRHASH c ~ Crypto.Blake2b_224) =>
  Byron.TxId ->
  TxId c
translateTxIdByronToShelley :: forall c. (Crypto c, ADDRHASH c ~ Blake2b_224) => TxId -> TxId c
translateTxIdByronToShelley =
  forall c. SafeHash c EraIndependentTxBody -> TxId c
TxId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c index. Hash (HASH c) index -> SafeHash c index
unsafeMakeSafeHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
hashFromShortBytesE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall algo a. AbstractHash algo a -> ShortByteString
Hashing.abstractHashToShort

hashFromShortBytesE ::
  forall h a.
  (Crypto.HashAlgorithm h, HasCallStack) =>
  SBS.ShortByteString ->
  Crypto.Hash h a
hashFromShortBytesE :: forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
hashFromShortBytesE ShortByteString
sbs =
  case 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 ->
      forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"hashFromBytesShort called with ShortByteString of the wrong length: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show ShortByteString
sbs

translateCompactTxOutByronToShelley :: Byron.CompactTxOut -> ShelleyTxOut (ShelleyEra c)
translateCompactTxOutByronToShelley :: forall c. CompactTxOut -> ShelleyTxOut (ShelleyEra c)
translateCompactTxOutByronToShelley (Byron.CompactTxOut CompactAddress
compactAddr Lovelace
amount) =
  forall era.
CompactAddr (EraCrypto era)
-> CompactForm (Value era) -> ShelleyTxOut era
TxOutCompact
    (forall c. CompactAddress -> CompactAddr c
fromBoostrapCompactAddress CompactAddress
compactAddr)
    (Word64 -> CompactForm Coin
CompactCoin (Lovelace -> Word64
Byron.unsafeGetLovelace Lovelace
amount))

translateCompactTxInByronToShelley ::
  (Crypto c, ADDRHASH c ~ Crypto.Blake2b_224) =>
  Byron.CompactTxIn ->
  TxIn c
translateCompactTxInByronToShelley :: forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
CompactTxIn -> TxIn c
translateCompactTxInByronToShelley (Byron.CompactTxInUtxo CompactTxId
compactTxId Word16
idx) =
  forall c. TxId c -> TxIx -> TxIn c
TxIn
    (forall c. (Crypto c, ADDRHASH c ~ Blake2b_224) => TxId -> TxId c
translateTxIdByronToShelley (CompactTxId -> TxId
Byron.fromCompactTxId CompactTxId
compactTxId))
    (Word64 -> TxIx
TxIx ((forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) Word16
idx))

translateUTxOByronToShelley ::
  forall c.
  (Crypto c, ADDRHASH c ~ Crypto.Blake2b_224) =>
  Byron.UTxO ->
  UTxO (ShelleyEra c)
translateUTxOByronToShelley :: forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
UTxO -> UTxO (ShelleyEra c)
translateUTxOByronToShelley (Byron.UTxO Map CompactTxIn CompactTxOut
utxoByron) =
  forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (TxIn c
txInShelley, ShelleyTxOut (ShelleyEra c)
txOutShelley)
      | (CompactTxIn
txInByron, CompactTxOut
txOutByron) <- forall k a. Map k a -> [(k, a)]
Map.toList Map CompactTxIn CompactTxOut
utxoByron
      , let txInShelley :: TxIn c
txInShelley = forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
CompactTxIn -> TxIn c
translateCompactTxInByronToShelley CompactTxIn
txInByron
            txOutShelley :: ShelleyTxOut (ShelleyEra c)
txOutShelley = forall c. CompactTxOut -> ShelleyTxOut (ShelleyEra c)
translateCompactTxOutByronToShelley CompactTxOut
txOutByron
      , -- In some testnets there are a few TxOuts with zero values injected at
      -- initialization of Byron. We do not allow zero values in TxOuts in Shelley
      -- onwards.
      ShelleyTxOut (ShelleyEra c)
txOutShelley forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall a. Eq a => a -> a -> Bool
/= forall t. Val t => t
zero
      ]

translateToShelleyLedgerState ::
  forall c.
  (Crypto c, ADDRHASH c ~ Crypto.Blake2b_224) =>
  FromByronTranslationContext c ->
  EpochNo ->
  Byron.ChainValidationState ->
  NewEpochState (ShelleyEra c)
translateToShelleyLedgerState :: forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
FromByronTranslationContext c
-> EpochNo -> ChainValidationState -> NewEpochState (ShelleyEra c)
translateToShelleyLedgerState FromByronTranslationContext c
transContext EpochNo
epochNo ChainValidationState
cvs =
  forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
FromByronTranslationContext c
-> EpochNo -> UTxO -> NewEpochState (ShelleyEra c)
translateToShelleyLedgerStateFromUtxo FromByronTranslationContext c
transContext EpochNo
epochNo (ChainValidationState -> UTxO
Byron.cvsUtxo ChainValidationState
cvs)

translateToShelleyLedgerStateFromUtxo ::
  forall c.
  (Crypto c, ADDRHASH c ~ Crypto.Blake2b_224) =>
  FromByronTranslationContext c ->
  EpochNo ->
  Byron.UTxO ->
  NewEpochState (ShelleyEra c)
translateToShelleyLedgerStateFromUtxo :: forall c.
(Crypto c, ADDRHASH c ~ Blake2b_224) =>
FromByronTranslationContext c
-> EpochNo -> UTxO -> NewEpochState (ShelleyEra c)
translateToShelleyLedgerStateFromUtxo FromByronTranslationContext c
transCtxt EpochNo
epochNo UTxO
utxoByron =
  NewEpochState
    { nesEL :: EpochNo
nesEL = EpochNo
epochNo
    , nesBprev :: BlocksMade (EraCrypto (ShelleyEra c))
nesBprev = forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall k a. Map k a
Map.empty
    , nesBcur :: BlocksMade (EraCrypto (ShelleyEra c))
nesBcur = forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall k a. Map k a
Map.empty
    , nesEs :: EpochState (ShelleyEra c)
nesEs = EpochState (ShelleyEra c)
epochState
    , nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto (ShelleyEra c)))
nesRu = forall a. StrictMaybe a
SNothing
    , nesPd :: PoolDistr (EraCrypto (ShelleyEra c))
nesPd = forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr forall k a. Map k a
Map.empty forall a. Monoid a => a
mempty
    , -- 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 (EraCrypto (ShelleyEra c))) (TxOut (ShelleyEra c))
utxo = forall era. UTxOState era -> UTxO era
utxosUtxo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. LedgerState era -> UTxOState era
lsUTxOState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EpochState era -> LedgerState era
esLState forall a b. (a -> b) -> a -> b
$ EpochState (ShelleyEra c)
epochState
            redeemers :: Map (TxIn c) (TxOut (ShelleyEra c))
redeemers =
              forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall c. BootstrapAddress c -> Bool
isBootstrapRedeemer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
view forall era.
EraTxOut era =>
SimpleGetter (TxOut era) (Maybe (BootstrapAddress (EraCrypto era)))
bootAddrTxOutF) Map (TxIn (EraCrypto (ShelleyEra c))) (TxOut (ShelleyEra c))
utxo
         in forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn c) (TxOut (ShelleyEra c))
redeemers
    }
  where
    pparams :: PParams (ShelleyEra c)
    pparams :: PParams (ShelleyEra c)
pparams = forall c. FromByronTranslationContext c -> PParams (ShelleyEra c)
fbtcProtocolParams FromByronTranslationContext c
transCtxt

    -- 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 = forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs forall a b. (a -> b) -> a -> b
$ forall c.
FromByronTranslationContext c
-> Map (KeyHash 'Genesis c) (GenDelegPair c)
fbtcGenDelegs FromByronTranslationContext c
transCtxt

    reserves :: Coin
    reserves :: Coin
reserves =
      Word64 -> Coin
word64ToCoin (forall c. FromByronTranslationContext c -> Word64
fbtcMaxLovelaceSupply FromByronTranslationContext c
transCtxt) forall t. Val t => t -> t -> t
<-> forall era. EraTxOut era => UTxO era -> Coin
coinBalance UTxO (ShelleyEra c)
utxoShelley

    epochState :: EpochState (ShelleyEra c)
    epochState :: EpochState (ShelleyEra c)
epochState =
      EpochState
        { esAccountState :: AccountState
esAccountState = Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) Coin
reserves
        , esSnapshots :: SnapShots (EraCrypto (ShelleyEra c))
esSnapshots = forall c. SnapShots c
emptySnapShots
        , esLState :: LedgerState (ShelleyEra c)
esLState = LedgerState (ShelleyEra c)
ledgerState
        , esNonMyopic :: NonMyopic (EraCrypto (ShelleyEra c))
esNonMyopic = forall a. Default a => a
def
        }
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (ShelleyEra c)
pparams
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams (ShelleyEra c)
pparams

    utxoShelley :: UTxO (ShelleyEra c)
    utxoShelley :: UTxO (ShelleyEra c)
utxoShelley = 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
        { lsUTxOState :: UTxOState (ShelleyEra c)
lsUTxOState =
            UTxOState
              { utxosUtxo :: UTxO (ShelleyEra c)
utxosUtxo = UTxO (ShelleyEra c)
utxoShelley
              , utxosDeposited :: Coin
utxosDeposited = Integer -> Coin
Coin Integer
0
              , utxosFees :: Coin
utxosFees = Integer -> Coin
Coin Integer
0
              , utxosGovState :: GovState (ShelleyEra c)
utxosGovState = forall era. EraGov era => GovState era
emptyGovState
              , utxosStakeDistr :: IncrementalStake (EraCrypto (ShelleyEra c))
utxosStakeDistr = forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake forall a. Monoid a => a
mempty forall k a. Map k a
Map.empty
              , utxosDonation :: Coin
utxosDonation = forall a. Monoid a => a
mempty
              }
        , lsCertState :: CertState (ShelleyEra c)
lsCertState =
            CertState
              { certDState :: DState (ShelleyEra c)
certDState = DState (ShelleyEra c)
dState
              , certPState :: PState (ShelleyEra c)
certPState = forall a. Default a => a
def
              , certVState :: VState (ShelleyEra c)
certVState = forall a. Default a => a
def
              }
        }

    dState :: DState (ShelleyEra c)
    dState :: DState (ShelleyEra c)
dState =
      DState
        { dsUnified :: UMap (EraCrypto (ShelleyEra c))
dsUnified = forall c. UMap c
UM.empty
        , dsFutureGenDelegs :: Map
  (FutureGenDeleg (EraCrypto (ShelleyEra c)))
  (GenDelegPair (EraCrypto (ShelleyEra c)))
dsFutureGenDelegs = forall k a. Map k a
Map.empty
        , dsGenDelegs :: GenDelegs (EraCrypto (ShelleyEra c))
dsGenDelegs = GenDelegs c
genDelegs
        , dsIRewards :: InstantaneousRewards (EraCrypto (ShelleyEra c))
dsIRewards = forall a. Default a => a
def
        }