{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Plutus.ChainIndex.TxUtxoBalance where

import Control.Lens (view)
import Data.Set (Set)
import Data.Set qualified as Set
import Ledger (TxIn (txInRef), TxOutRef (..))
import Plutus.ChainIndex.Tx (ChainIndexTx (..), citxInputs, txOutsWithRef)
import Plutus.ChainIndex.Types (Point (..), Tip (..), TxUtxoBalance (..), tubUnspentOutputs)
import Plutus.ChainIndex.UtxoState (RollbackFailed, RollbackResult, UtxoIndex,
                                    UtxoState (UtxoState, _usTip, _usTxUtxoData), rollbackWith, usTxUtxoData)

fromTx :: ChainIndexTx -> TxUtxoBalance
fromTx :: ChainIndexTx -> TxUtxoBalance
fromTx ChainIndexTx
tx =
    TxUtxoBalance :: Set TxOutRef -> Set TxOutRef -> TxUtxoBalance
TxUtxoBalance
        { _tubUnspentOutputs :: Set TxOutRef
_tubUnspentOutputs = [TxOutRef] -> Set TxOutRef
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Set TxOutRef) -> [TxOutRef] -> Set TxOutRef
forall a b. (a -> b) -> a -> b
$ ((ChainIndexTxOut, TxOutRef) -> TxOutRef)
-> [(ChainIndexTxOut, TxOutRef)] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ChainIndexTxOut, TxOutRef) -> TxOutRef
forall a b. (a, b) -> b
snd ([(ChainIndexTxOut, TxOutRef)] -> [TxOutRef])
-> [(ChainIndexTxOut, TxOutRef)] -> [TxOutRef]
forall a b. (a -> b) -> a -> b
$ ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef ChainIndexTx
tx
        , _tubUnmatchedSpentInputs :: Set TxOutRef
_tubUnmatchedSpentInputs = [TxOutRef] -> Set TxOutRef
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Set TxOutRef) -> [TxOutRef] -> Set TxOutRef
forall a b. (a -> b) -> a -> b
$ (TxIn -> TxOutRef) -> [TxIn] -> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxOutRef
txInRef (Getting [TxIn] ChainIndexTx [TxIn] -> ChainIndexTx -> [TxIn]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [TxIn] ChainIndexTx [TxIn]
Lens' ChainIndexTx [TxIn]
citxInputs ChainIndexTx
tx)
        }

-- | Whether a 'TxOutRef' is a member of the UTXO set (ie. unspent)
isUnspentOutput :: TxOutRef -> UtxoState TxUtxoBalance -> Bool
isUnspentOutput :: TxOutRef -> UtxoState TxUtxoBalance -> Bool
isUnspentOutput TxOutRef
r = TxOutRef -> Set TxOutRef -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TxOutRef
r (Set TxOutRef -> Bool)
-> (UtxoState TxUtxoBalance -> Set TxOutRef)
-> UtxoState TxUtxoBalance
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Set TxOutRef) (UtxoState TxUtxoBalance) (Set TxOutRef)
-> UtxoState TxUtxoBalance -> Set TxOutRef
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance)
-> UtxoState TxUtxoBalance
-> Const (Set TxOutRef) (UtxoState TxUtxoBalance)
forall a a2. Lens (UtxoState a) (UtxoState a2) a a2
usTxUtxoData ((TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance)
 -> UtxoState TxUtxoBalance
 -> Const (Set TxOutRef) (UtxoState TxUtxoBalance))
-> ((Set TxOutRef -> Const (Set TxOutRef) (Set TxOutRef))
    -> TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance)
-> Getting (Set TxOutRef) (UtxoState TxUtxoBalance) (Set TxOutRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxOutRef -> Const (Set TxOutRef) (Set TxOutRef))
-> TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance
Lens' TxUtxoBalance (Set TxOutRef)
tubUnspentOutputs)

-- | The UTXO set
unspentOutputs :: UtxoState TxUtxoBalance -> Set TxOutRef
unspentOutputs :: UtxoState TxUtxoBalance -> Set TxOutRef
unspentOutputs = Getting (Set TxOutRef) (UtxoState TxUtxoBalance) (Set TxOutRef)
-> UtxoState TxUtxoBalance -> Set TxOutRef
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance)
-> UtxoState TxUtxoBalance
-> Const (Set TxOutRef) (UtxoState TxUtxoBalance)
forall a a2. Lens (UtxoState a) (UtxoState a2) a a2
usTxUtxoData ((TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance)
 -> UtxoState TxUtxoBalance
 -> Const (Set TxOutRef) (UtxoState TxUtxoBalance))
-> ((Set TxOutRef -> Const (Set TxOutRef) (Set TxOutRef))
    -> TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance)
-> Getting (Set TxOutRef) (UtxoState TxUtxoBalance) (Set TxOutRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxOutRef -> Const (Set TxOutRef) (Set TxOutRef))
-> TxUtxoBalance -> Const (Set TxOutRef) TxUtxoBalance
Lens' TxUtxoBalance (Set TxOutRef)
tubUnspentOutputs)

-- | 'UtxoIndex' for a single block
fromBlock :: Tip -> [ChainIndexTx] -> UtxoState TxUtxoBalance
fromBlock :: Tip -> [ChainIndexTx] -> UtxoState TxUtxoBalance
fromBlock Tip
tip_ [ChainIndexTx]
transactions =
    UtxoState :: forall a. a -> Tip -> UtxoState a
UtxoState
            { _usTxUtxoData :: TxUtxoBalance
_usTxUtxoData = (ChainIndexTx -> TxUtxoBalance) -> [ChainIndexTx] -> TxUtxoBalance
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ChainIndexTx -> TxUtxoBalance
fromTx [ChainIndexTx]
transactions
            , _usTip :: Tip
_usTip        = Tip
tip_
            }

-- | Perform a rollback on the utxo index
rollback :: Point
         -> UtxoIndex TxUtxoBalance
         -> Either RollbackFailed (RollbackResult TxUtxoBalance)
rollback :: Point
-> UtxoIndex TxUtxoBalance
-> Either RollbackFailed (RollbackResult TxUtxoBalance)
rollback = (UtxoIndex TxUtxoBalance
 -> UtxoIndex TxUtxoBalance -> UtxoIndex TxUtxoBalance)
-> Point
-> UtxoIndex TxUtxoBalance
-> Either RollbackFailed (RollbackResult TxUtxoBalance)
forall a.
Monoid a =>
(UtxoIndex a -> UtxoIndex a -> UtxoIndex a)
-> Point -> UtxoIndex a -> Either RollbackFailed (RollbackResult a)
rollbackWith UtxoIndex TxUtxoBalance
-> UtxoIndex TxUtxoBalance -> UtxoIndex TxUtxoBalance
forall a b. a -> b -> a
const