{-# 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 = Addr -> Value MaryEra -> TxOut MaryEra
Addr -> Value MaryEra -> ShelleyTxOut MaryEra
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) = CompactAddr -> CompactForm (Value MaryEra) -> ShelleyTxOut MaryEra
forall era.
CompactAddr -> CompactForm (Value era) -> ShelleyTxOut era
TxOutCompact (CompactAddr -> CompactAddr
forall a b. Coercible a b => a -> b
coerce CompactAddr
addr) (CompactForm Coin -> CompactForm MaryValue
forall t. Val t => CompactForm Coin -> CompactForm t
injectCompact CompactForm (Value AllegraEra)
CompactForm Coin
cfval)

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

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

  getMinCoinTxOut :: PParams MaryEra -> TxOut MaryEra -> Coin
getMinCoinTxOut PParams MaryEra
pp TxOut MaryEra
txOut = Value MaryEra -> Coin -> Coin
forall v. Val v => v -> Coin -> Coin
scaledMinDeposit (TxOut MaryEra
ShelleyTxOut MaryEra
txOut ShelleyTxOut MaryEra
-> Getting (Value MaryEra) (ShelleyTxOut MaryEra) (Value MaryEra)
-> Value MaryEra
forall s a. s -> Getting a s a -> a
^. (Value MaryEra -> Const (Value MaryEra) (Value MaryEra))
-> TxOut MaryEra -> Const (Value MaryEra) (TxOut MaryEra)
Getting (Value MaryEra) (ShelleyTxOut MaryEra) (Value MaryEra)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut MaryEra) (Value MaryEra)
valueTxOutL) (PParams MaryEra
pp PParams MaryEra -> Getting Coin (PParams MaryEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams MaryEra) Coin
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams MaryEra) 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)
  | v -> Bool
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 (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
mv (Integer
coinsPerUTxOWord Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
utxoEntrySizeWithoutVal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ v -> Integer
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
txoutLenNoVal Integer -> Integer -> Integer
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 = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
mv (Integer
utxoEntrySizeWithoutVal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
coinSize)