{-# 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.Crypto (Crypto, StandardCrypto)
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 Crypto c => EraTxOut (MaryEra c) where
  {-# SPECIALIZE instance EraTxOut (MaryEra StandardCrypto) #-}

  type TxOut (MaryEra c) = ShelleyTxOut (MaryEra c)

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

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

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

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

  getMinCoinTxOut :: PParams (MaryEra c) -> TxOut (MaryEra c) -> Coin
getMinCoinTxOut PParams (MaryEra c)
pp TxOut (MaryEra c)
txOut = forall v. Val v => v -> Coin -> Coin
scaledMinDeposit (TxOut (MaryEra c)
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL) (PParams (MaryEra c)
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)