{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Figure 2: Functions related to fees and collateral
--   Babbage Specification
module Cardano.Ledger.Babbage.Collateral (
  collAdaBalance,
  collOuts,
)
where

import Cardano.Ledger.Babbage.PParams ()
import Cardano.Ledger.Babbage.TxBody (BabbageEraTxBody (..))
import Cardano.Ledger.BaseTypes (TxIx (..), txIxFromIntegral)
import Cardano.Ledger.Coin (DeltaCoin, toDeltaCoin)
import Cardano.Ledger.Core
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UTxO (UTxO (..), coinBalance)
import Cardano.Ledger.Val ((<->))
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Word (Word16, Word64)
import Lens.Micro

-- ============================================================

collAdaBalance ::
  forall era.
  BabbageEraTxBody era =>
  TxBody era ->
  Map.Map (TxIn (EraCrypto era)) (TxOut era) ->
  DeltaCoin
collAdaBalance :: forall era.
BabbageEraTxBody era =>
TxBody era -> Map (TxIn (EraCrypto era)) (TxOut era) -> DeltaCoin
collAdaBalance TxBody era
txBody Map (TxIn (EraCrypto era)) (TxOut era)
utxoCollateral = Coin -> DeltaCoin
toDeltaCoin forall a b. (a -> b) -> a -> b
$
  case TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL of
    StrictMaybe (TxOut era)
SNothing -> Coin
colbal
    SJust TxOut era
txOut -> Coin
colbal forall t. Val t => t -> t -> t
<-> (TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL @era)
  where
    colbal :: Coin
colbal = forall era. EraTxOut era => UTxO era -> Coin
coinBalance forall a b. (a -> b) -> a -> b
$ forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn (EraCrypto era)) (TxOut era)
utxoCollateral

collOuts ::
  BabbageEraTxBody era =>
  TxBody era ->
  UTxO era
collOuts :: forall era. BabbageEraTxBody era => TxBody era -> UTxO era
collOuts TxBody era
txBody =
  case TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL of
    StrictMaybe (TxOut era)
SNothing -> forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall k a. Map k a
Map.empty
    SJust TxOut era
txOut -> forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO (forall k a. k -> a -> Map k a
Map.singleton (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody era
txBody) TxIx
index) TxOut era
txOut)
      where
        index :: TxIx
index = case forall a (m :: * -> *). (Integral a, MonadFail m) => a -> m TxIx
txIxFromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL)) of
          Just TxIx
i -> TxIx
i
          -- In the impossible event that there are more transaction outputs
          -- in the transaction than will fit into a Word16 (which backs the TxIx),
          -- we give the collateral return output an index of maxBound.
          Maybe TxIx
Nothing -> Word64 -> TxIx
TxIx ((forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) (forall a. Bounded a => a
maxBound :: Word16))