{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
module Plutus.ChainIndex.TxOutBalance where

import Control.Lens (view)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Ledger (TxIn (txInRef), TxOutRef (..))
import Plutus.ChainIndex.Tx (ChainIndexTx (..), citxInputs, citxTxId, txOutsWithRef)
import Plutus.ChainIndex.TxIdState (transactionStatus)
import Plutus.ChainIndex.Types (BlockNumber, Point (..), Tip (..), TxIdState, TxOutBalance (..), TxOutState (..),
                                TxOutStatus, TxStatusFailure (TxOutBalanceStateInvalid), tobSpentOutputs,
                                tobUnspentOutputs)
import Plutus.ChainIndex.UtxoState (RollbackFailed, RollbackResult, UtxoIndex,
                                    UtxoState (UtxoState, _usTip, _usTxUtxoData), rollbackWith, usTxUtxoData)

-- | Given the current block, compute the status for the given transaction
-- output by getting the state of the transaction that produced it and checking
-- if the output is spent or unspent.
transactionOutputStatus
  :: BlockNumber
  -- ^ Current block number for inspecting the state of the transaction output
  -> TxIdState
  -- ^ Information on the state of a transaction. Needed for determining its
  -- status.
  -> TxOutBalance
  -- ^ Balance of spent and unspent transaction outputs.
  -> TxOutRef
  -- ^ Target transaction output for inspecting its state.
  -> Either TxStatusFailure TxOutStatus
transactionOutputStatus :: BlockNumber
-> TxIdState
-> TxOutBalance
-> TxOutRef
-> Either TxStatusFailure TxOutStatus
transactionOutputStatus BlockNumber
currentBlock TxIdState
txIdState TxOutBalance
txOutBalance txOutRef :: TxOutRef
txOutRef@TxOutRef { TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId :: TxId
txOutRefId } =
  let txOutState :: Maybe TxOutState
txOutState = TxOutBalance -> TxOutRef -> Maybe TxOutState
transactionOutputState TxOutBalance
txOutBalance TxOutRef
txOutRef
   in case Maybe TxOutState
txOutState of
        Maybe TxOutState
Nothing -> TxStatusFailure -> Either TxStatusFailure TxOutStatus
forall a b. a -> Either a b
Left (TxStatusFailure -> Either TxStatusFailure TxOutStatus)
-> TxStatusFailure -> Either TxStatusFailure TxOutStatus
forall a b. (a -> b) -> a -> b
$ BlockNumber -> TxOutRef -> TxOutBalance -> TxStatusFailure
TxOutBalanceStateInvalid BlockNumber
currentBlock TxOutRef
txOutRef TxOutBalance
txOutBalance
        Just s :: TxOutState
s@(Spent TxId
txid) -> do
          -- Get the status of the tx which spent the target tx output
          TxStatus
txStatus <- BlockNumber -> TxIdState -> TxId -> Either TxStatusFailure TxStatus
transactionStatus BlockNumber
currentBlock TxIdState
txIdState TxId
txid
          TxOutStatus -> Either TxStatusFailure TxOutStatus
forall a b. b -> Either a b
Right (TxOutStatus -> Either TxStatusFailure TxOutStatus)
-> TxOutStatus -> Either TxStatusFailure TxOutStatus
forall a b. (a -> b) -> a -> b
$ (() -> TxOutState) -> TxStatus -> TxOutStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOutState -> () -> TxOutState
forall a b. a -> b -> a
const TxOutState
s) TxStatus
txStatus
        Just s :: TxOutState
s@TxOutState
Unspent -> do
          -- Get the status of the tx which produced the target tx output
          TxStatus
txStatus <- BlockNumber -> TxIdState -> TxId -> Either TxStatusFailure TxStatus
transactionStatus BlockNumber
currentBlock TxIdState
txIdState TxId
txOutRefId
          TxOutStatus -> Either TxStatusFailure TxOutStatus
forall a b. b -> Either a b
Right (TxOutStatus -> Either TxStatusFailure TxOutStatus)
-> TxOutStatus -> Either TxStatusFailure TxOutStatus
forall a b. (a -> b) -> a -> b
$ (() -> TxOutState) -> TxStatus -> TxOutStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOutState -> () -> TxOutState
forall a b. a -> b -> a
const TxOutState
s) TxStatus
txStatus

transactionOutputState
  :: TxOutBalance
  -> TxOutRef
  -> Maybe TxOutState
transactionOutputState :: TxOutBalance -> TxOutRef -> Maybe TxOutState
transactionOutputState TxOutBalance
txOutBalance TxOutRef
txOutRef =
  let spentTxOutTxId :: Maybe TxId
spentTxOutTxId = TxOutRef -> Map TxOutRef TxId -> Maybe TxId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
txOutRef (TxOutBalance -> Map TxOutRef TxId
_tobSpentOutputs TxOutBalance
txOutBalance)
      isUnspent :: Bool
isUnspent = TxOutRef
txOutRef TxOutRef -> Set TxOutRef -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` TxOutBalance -> Set TxOutRef
_tobUnspentOutputs TxOutBalance
txOutBalance
      txOutState :: Maybe TxOutState
txOutState
          | Bool
isUnspent = TxOutState -> Maybe TxOutState
forall a. a -> Maybe a
Just TxOutState
Unspent
          | Just TxId
txid <- Maybe TxId
spentTxOutTxId = TxOutState -> Maybe TxOutState
forall a. a -> Maybe a
Just (TxId -> TxOutState
Spent TxId
txid)
          | Maybe TxId
Nothing <- Maybe TxId
spentTxOutTxId = Maybe TxOutState
forall a. Maybe a
Nothing
  in Maybe TxOutState
txOutState

fromTx :: ChainIndexTx -> TxOutBalance
fromTx :: ChainIndexTx -> TxOutBalance
fromTx ChainIndexTx
tx =
    TxOutBalance :: Set TxOutRef -> Map TxOutRef TxId -> TxOutBalance
TxOutBalance
        { _tobUnspentOutputs :: Set TxOutRef
_tobUnspentOutputs = [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
        , _tobSpentOutputs :: Map TxOutRef TxId
_tobSpentOutputs =
          (TxOutRef -> TxId) -> Set TxOutRef -> Map TxOutRef TxId
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (TxId -> TxOutRef -> TxId
forall a b. a -> b -> a
const (TxId -> TxOutRef -> TxId) -> TxId -> TxOutRef -> TxId
forall a b. (a -> b) -> a -> b
$ Getting TxId ChainIndexTx TxId -> ChainIndexTx -> TxId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TxId ChainIndexTx TxId
Lens' ChainIndexTx TxId
citxTxId ChainIndexTx
tx)
                     (Set TxOutRef -> Map TxOutRef TxId)
-> Set TxOutRef -> Map TxOutRef TxId
forall a b. (a -> b) -> a -> b
$ [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 TxOutBalance -> Bool
isUnspentOutput :: TxOutRef -> UtxoState TxOutBalance -> Bool
isUnspentOutput TxOutRef
r = TxOutRef -> Set TxOutRef -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TxOutRef
r (Set TxOutRef -> Bool)
-> (UtxoState TxOutBalance -> Set TxOutRef)
-> UtxoState TxOutBalance
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoState TxOutBalance -> Set TxOutRef
unspentOutputs

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

-- | Whether a 'TxOutRef' is a member of the spent tx output set.
isSpentOutput :: TxOutRef -> UtxoState TxOutBalance -> Bool
isSpentOutput :: TxOutRef -> UtxoState TxOutBalance -> Bool
isSpentOutput TxOutRef
r = TxOutRef -> Set TxOutRef -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TxOutRef
r (Set TxOutRef -> Bool)
-> (UtxoState TxOutBalance -> Set TxOutRef)
-> UtxoState TxOutBalance
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoState TxOutBalance -> Set TxOutRef
spentOutputs

-- | The spent output set
spentOutputs :: UtxoState TxOutBalance -> Set TxOutRef
spentOutputs :: UtxoState TxOutBalance -> Set TxOutRef
spentOutputs = Map TxOutRef TxId -> Set TxOutRef
forall k a. Map k a -> Set k
Map.keysSet (Map TxOutRef TxId -> Set TxOutRef)
-> (UtxoState TxOutBalance -> Map TxOutRef TxId)
-> UtxoState TxOutBalance
-> Set TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Map TxOutRef TxId) (UtxoState TxOutBalance) (Map TxOutRef TxId)
-> UtxoState TxOutBalance -> Map TxOutRef TxId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxOutBalance -> Const (Map TxOutRef TxId) TxOutBalance)
-> UtxoState TxOutBalance
-> Const (Map TxOutRef TxId) (UtxoState TxOutBalance)
forall a a2. Lens (UtxoState a) (UtxoState a2) a a2
usTxUtxoData ((TxOutBalance -> Const (Map TxOutRef TxId) TxOutBalance)
 -> UtxoState TxOutBalance
 -> Const (Map TxOutRef TxId) (UtxoState TxOutBalance))
-> ((Map TxOutRef TxId
     -> Const (Map TxOutRef TxId) (Map TxOutRef TxId))
    -> TxOutBalance -> Const (Map TxOutRef TxId) TxOutBalance)
-> Getting
     (Map TxOutRef TxId) (UtxoState TxOutBalance) (Map TxOutRef TxId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map TxOutRef TxId
 -> Const (Map TxOutRef TxId) (Map TxOutRef TxId))
-> TxOutBalance -> Const (Map TxOutRef TxId) TxOutBalance
Lens' TxOutBalance (Map TxOutRef TxId)
tobSpentOutputs)

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

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