{-# 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.State
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val ((<->))
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Word (Word16)
import Lens.Micro

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

collAdaBalance ::
  forall era.
  BabbageEraTxBody era =>
  TxBody era ->
  Map.Map TxIn (TxOut era) ->
  DeltaCoin
collAdaBalance :: forall era.
BabbageEraTxBody era =>
TxBody era -> Map TxIn (TxOut era) -> DeltaCoin
collAdaBalance TxBody era
txBody Map TxIn (TxOut era)
utxoCollateral = Coin -> DeltaCoin
toDeltaCoin (Coin -> DeltaCoin) -> Coin -> DeltaCoin
forall a b. (a -> b) -> a -> b
$
  case TxBody era
txBody TxBody era
-> Getting
     (StrictMaybe (TxOut era)) (TxBody era) (StrictMaybe (TxOut era))
-> StrictMaybe (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxOut era)) (TxBody era) (StrictMaybe (TxOut era))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL of
    StrictMaybe (TxOut era)
SNothing -> Coin
colbal
    SJust TxOut era
txOut -> Coin
colbal Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (TxOut era
txOut TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL @era)
  where
    colbal :: Coin
colbal = Map TxIn (TxOut era) -> Coin
forall era (f :: * -> *).
(EraTxOut era, Foldable f) =>
f (TxOut era) -> Coin
sumAllCoin Map TxIn (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 TxBody era
-> Getting
     (StrictMaybe (TxOut era)) (TxBody era) (StrictMaybe (TxOut era))
-> StrictMaybe (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxOut era)) (TxBody era) (StrictMaybe (TxOut era))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL of
    StrictMaybe (TxOut era)
SNothing -> Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO Map TxIn (TxOut era)
forall k a. Map k a
Map.empty
    SJust TxOut era
txOut -> Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (TxIn -> TxOut era -> Map TxIn (TxOut era)
forall k a. k -> a -> Map k a
Map.singleton (TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody era
txBody) TxIx
index) TxOut era
txOut)
      where
        index :: TxIx
index = case Int -> Maybe TxIx
forall a (m :: * -> *). (Integral a, MonadFail m) => a -> m TxIx
txIxFromIntegral (StrictSeq (TxOut era) -> Int
forall a. StrictSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut 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 -> Word16 -> TxIx
TxIx (Word16
forall a. Bounded a => a
maxBound :: Word16)