{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Mary.TxOut (scaledMinDeposit) where

import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Mary.Era (MaryEra)
import Cardano.Ledger.Mary.PParams ()
import Cardano.Ledger.Shelley.TxOut (
  ShelleyTxOut (..),
  addrEitherShelleyTxOutL,
  valueEitherShelleyTxOutL,
 )
import Cardano.Ledger.Val (Val (isAdaOnly, size), injectCompact)
import Data.Coerce (coerce)
import Lens.Micro ((^.))

instance EraTxOut MaryEra where
  type TxOut MaryEra = ShelleyTxOut MaryEra

  mkBasicTxOut :: HasCallStack => Addr -> Value MaryEra -> TxOut MaryEra
mkBasicTxOut = forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut

  upgradeTxOut :: EraTxOut (PreviousEra MaryEra) =>
TxOut (PreviousEra MaryEra) -> TxOut MaryEra
upgradeTxOut (TxOutCompact CompactAddr
addr CompactForm (Value AllegraEra)
cfval) = forall era.
CompactAddr -> CompactForm (Value era) -> ShelleyTxOut era
TxOutCompact (coerce :: forall a b. Coercible a b => a -> b
coerce CompactAddr
addr) (forall t. Val t => CompactForm Coin -> CompactForm t
injectCompact CompactForm (Value AllegraEra)
cfval)

  addrEitherTxOutL :: Lens' (TxOut MaryEra) (Either Addr CompactAddr)
addrEitherTxOutL = forall era. Lens' (ShelleyTxOut era) (Either Addr CompactAddr)
addrEitherShelleyTxOutL
  {-# INLINE addrEitherTxOutL #-}

  valueEitherTxOutL :: Lens'
  (TxOut MaryEra)
  (Either (Value MaryEra) (CompactForm (Value MaryEra)))
valueEitherTxOutL = forall era.
Val (Value era) =>
Lens'
  (ShelleyTxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherShelleyTxOutL
  {-# INLINE valueEitherTxOutL #-}

  getMinCoinTxOut :: PParams MaryEra -> TxOut MaryEra -> Coin
getMinCoinTxOut PParams MaryEra
pp TxOut MaryEra
txOut = forall v. Val v => v -> Coin -> Coin
scaledMinDeposit (TxOut MaryEra
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL) (PParams MaryEra
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL)

-- | The `scaledMinDeposit` calculation uses the minUTxOValue protocol parameter
-- (passed to it as Coin mv) as a specification of "the cost of making a
-- Shelley-sized UTxO entry", calculated here by "utxoEntrySizeWithoutVal +
-- uint", using the constants in the "where" clause.  In the case when a UTxO
-- entry contains coins only (and the Shelley UTxO entry format is used - we
-- will extend this to be correct for other UTxO formats shortly), the deposit
-- should be exactly the minUTxOValue.  This is the "inject (coin v) == v" case.
-- Otherwise, we calculate the per-byte deposit by multiplying the minimum
-- deposit (which is for the number of Shelley UTxO-entry bytes) by the size of
-- a Shelley UTxO entry.  This is the "(mv * (utxoEntrySizeWithoutVal + uint))"
-- calculation.  We then calculate the total deposit required for making a UTxO
-- entry with a Val-class member v by dividing "(mv * (utxoEntrySizeWithoutVal +
-- uint))" by the estimated total size of the UTxO entry containing v, ie by
-- "(utxoEntrySizeWithoutVal + size v)".  See the formal specification for
-- details.
--
-- This scaling function is right for UTxO, not EUTxO
scaledMinDeposit :: Val v => v -> Coin -> Coin
scaledMinDeposit :: forall v. Val v => v -> Coin -> Coin
scaledMinDeposit v
v (Coin Integer
mv)
  | forall t. Val t => t -> Bool
isAdaOnly v
v = Integer -> Coin
Coin Integer
mv -- without non-Coin assets, scaled deposit should be exactly minUTxOValue
  -- The calculation should represent this equation
  -- minValueParameter / coinUTxOSize = actualMinValue / valueUTxOSize
  -- actualMinValue = (minValueParameter / coinUTxOSize) * valueUTxOSize
  | Bool
otherwise = Integer -> Coin
Coin forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Integer
mv (Integer
coinsPerUTxOWord forall a. Num a => a -> a -> a
* (Integer
utxoEntrySizeWithoutVal forall a. Num a => a -> a -> a
+ forall t. Val t => t -> Integer
size v
v))
  where
    -- lengths obtained from tracing on HeapWords of inputs and outputs
    -- obtained experimentally, and number used here
    -- units are Word64s
    txoutLenNoVal :: Integer
txoutLenNoVal = Integer
14
    txinLen :: Integer
txinLen = Integer
7

    -- unpacked CompactCoin Word64 size in Word64s
    coinSize :: Integer
    coinSize :: Integer
coinSize = Integer
0

    utxoEntrySizeWithoutVal :: Integer
    utxoEntrySizeWithoutVal :: Integer
utxoEntrySizeWithoutVal = Integer
6 forall a. Num a => a -> a -> a
+ Integer
txoutLenNoVal forall a. Num a => a -> a -> a
+ Integer
txinLen

    -- how much ada does a Word64 of UTxO space cost, calculated from minAdaValue PP
    -- round down
    coinsPerUTxOWord :: Integer
    coinsPerUTxOWord :: Integer
coinsPerUTxOWord = forall a. Integral a => a -> a -> a
quot Integer
mv (Integer
utxoEntrySizeWithoutVal forall a. Num a => a -> a -> a
+ Integer
coinSize)