{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- | Functions for working with the contract interface using typed transactions.
module Plutus.Contract.Typed.Tx where

import Ledger.Constraints (TxConstraints)
import Ledger.Constraints.TxConstraints (addTxIn)

import Data.Foldable (foldl')
import Data.Map qualified as Map

import Ledger (TxOutRef)
import Ledger.Tx (ChainIndexTxOut)

-- | Given the pay to script address of the 'Validator', collect from it
--   all the outputs that match a predicate, using the 'RedeemerValue'.
collectFromScriptFilter ::
    forall i o
    .  (TxOutRef -> ChainIndexTxOut -> Bool)
    -> Map.Map TxOutRef ChainIndexTxOut
    -> i
    -> TxConstraints i o
collectFromScriptFilter :: (TxOutRef -> ChainIndexTxOut -> Bool)
-> Map TxOutRef ChainIndexTxOut -> i -> TxConstraints i o
collectFromScriptFilter TxOutRef -> ChainIndexTxOut -> Bool
flt Map TxOutRef ChainIndexTxOut
utxo i
red =
    let ourUtxo :: Map.Map TxOutRef ChainIndexTxOut
        ourUtxo :: Map TxOutRef ChainIndexTxOut
ourUtxo = (TxOutRef -> ChainIndexTxOut -> Bool)
-> Map TxOutRef ChainIndexTxOut -> Map TxOutRef ChainIndexTxOut
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey TxOutRef -> ChainIndexTxOut -> Bool
flt Map TxOutRef ChainIndexTxOut
utxo
    in Map TxOutRef ChainIndexTxOut -> i -> TxConstraints i o
forall i o. Map TxOutRef ChainIndexTxOut -> i -> TxConstraints i o
collectFromScript Map TxOutRef ChainIndexTxOut
ourUtxo i
red

-- | A version of 'collectFromScript' that selects all outputs
--   at the address
collectFromScript ::
    forall i o
    .  Map.Map TxOutRef ChainIndexTxOut
    -> i
    -> TxConstraints i o
collectFromScript :: Map TxOutRef ChainIndexTxOut -> i -> TxConstraints i o
collectFromScript Map TxOutRef ChainIndexTxOut
utxo i
redeemer =
    (TxConstraints i o -> TxOutRef -> TxConstraints i o)
-> TxConstraints i o -> [TxOutRef] -> TxConstraints i o
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\TxConstraints i o
b TxOutRef
a -> TxOutRef -> i -> TxConstraints i o -> TxConstraints i o
forall i o. TxOutRef -> i -> TxConstraints i o -> TxConstraints i o
addTxIn TxOutRef
a i
redeemer TxConstraints i o
b) TxConstraints i o
forall a. Monoid a => a
mempty (Map TxOutRef ChainIndexTxOut -> [TxOutRef]
forall k a. Map k a -> [k]
Map.keys Map TxOutRef ChainIndexTxOut
utxo)