-- | This module provides a depiction of the internal state we carry around to
-- emulate the blockchain index. This is mostly useful in the Direct
-- implementation of the MonadBlockChain.
module Cooked.MockChain.UtxoState
  ( UtxoState (..),
    UtxoPayloadSet (..),
    UtxoPayload (..),
    holdsInState,
    SkelContext (..),
  )
where

import Cooked.Skeleton (TxSkelOutDatum)
import Data.Function (on)
import Data.List qualified as List
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api

-- | A description of who owns what in a blockchain. Owners are addresses and
-- they each own a 'UtxoPayloadSet'.
newtype UtxoState = UtxoState {UtxoState -> Map Address UtxoPayloadSet
utxoState :: Map Api.Address UtxoPayloadSet}
  deriving (UtxoState -> UtxoState -> Bool
(UtxoState -> UtxoState -> Bool)
-> (UtxoState -> UtxoState -> Bool) -> Eq UtxoState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UtxoState -> UtxoState -> Bool
== :: UtxoState -> UtxoState -> Bool
$c/= :: UtxoState -> UtxoState -> Bool
/= :: UtxoState -> UtxoState -> Bool
Eq)

-- | Total value accessible to what's pointed by the address.
holdsInState :: Api.Address -> UtxoState -> Api.Value
holdsInState :: Address -> UtxoState -> Value
holdsInState Address
address (UtxoState Map Address UtxoPayloadSet
m) =
  Value -> (UtxoPayloadSet -> Value) -> Maybe UtxoPayloadSet -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall a. Monoid a => a
mempty UtxoPayloadSet -> Value
utxoPayloadSetTotal (Address -> Map Address UtxoPayloadSet -> Maybe UtxoPayloadSet
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Address
address Map Address UtxoPayloadSet
m)

instance Semigroup UtxoState where
  (UtxoState Map Address UtxoPayloadSet
a) <> :: UtxoState -> UtxoState -> UtxoState
<> (UtxoState Map Address UtxoPayloadSet
b) = Map Address UtxoPayloadSet -> UtxoState
UtxoState (Map Address UtxoPayloadSet -> UtxoState)
-> Map Address UtxoPayloadSet -> UtxoState
forall a b. (a -> b) -> a -> b
$ (UtxoPayloadSet -> UtxoPayloadSet -> UtxoPayloadSet)
-> Map Address UtxoPayloadSet
-> Map Address UtxoPayloadSet
-> Map Address UtxoPayloadSet
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith UtxoPayloadSet -> UtxoPayloadSet -> UtxoPayloadSet
forall a. Semigroup a => a -> a -> a
(<>) Map Address UtxoPayloadSet
a Map Address UtxoPayloadSet
b

-- | Represents a /set/ of payloads.
newtype UtxoPayloadSet = UtxoPayloadSet
  { UtxoPayloadSet -> [UtxoPayload]
utxoPayloadSet :: [UtxoPayload]
  -- We use a list instead of a set because 'Api.Value' doesn't implement 'Ord'
  -- and because it is possible that we want to distinguish between utxo states
  -- that have additional utxos, even if these could have been merged together.
  }
  deriving (Int -> UtxoPayloadSet -> ShowS
[UtxoPayloadSet] -> ShowS
UtxoPayloadSet -> String
(Int -> UtxoPayloadSet -> ShowS)
-> (UtxoPayloadSet -> String)
-> ([UtxoPayloadSet] -> ShowS)
-> Show UtxoPayloadSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UtxoPayloadSet -> ShowS
showsPrec :: Int -> UtxoPayloadSet -> ShowS
$cshow :: UtxoPayloadSet -> String
show :: UtxoPayloadSet -> String
$cshowList :: [UtxoPayloadSet] -> ShowS
showList :: [UtxoPayloadSet] -> ShowS
Show)

-- | A convenient wrapping of the interesting information of a UTxO.
data UtxoPayload = UtxoPayload
  { UtxoPayload -> TxOutRef
utxoPayloadTxOutRef :: Api.TxOutRef,
    UtxoPayload -> Value
utxoPayloadValue :: Api.Value,
    UtxoPayload -> TxSkelOutDatum
utxoPayloadSkelOutDatum :: TxSkelOutDatum,
    UtxoPayload -> Maybe ScriptHash
utxoPayloadReferenceScript :: Maybe Api.ScriptHash
  }
  deriving (UtxoPayload -> UtxoPayload -> Bool
(UtxoPayload -> UtxoPayload -> Bool)
-> (UtxoPayload -> UtxoPayload -> Bool) -> Eq UtxoPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UtxoPayload -> UtxoPayload -> Bool
== :: UtxoPayload -> UtxoPayload -> Bool
$c/= :: UtxoPayload -> UtxoPayload -> Bool
/= :: UtxoPayload -> UtxoPayload -> Bool
Eq, Int -> UtxoPayload -> ShowS
[UtxoPayload] -> ShowS
UtxoPayload -> String
(Int -> UtxoPayload -> ShowS)
-> (UtxoPayload -> String)
-> ([UtxoPayload] -> ShowS)
-> Show UtxoPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UtxoPayload -> ShowS
showsPrec :: Int -> UtxoPayload -> ShowS
$cshow :: UtxoPayload -> String
show :: UtxoPayload -> String
$cshowList :: [UtxoPayload] -> ShowS
showList :: [UtxoPayload] -> ShowS
Show)

instance Eq UtxoPayloadSet where
  (UtxoPayloadSet [UtxoPayload]
xs) == :: UtxoPayloadSet -> UtxoPayloadSet -> Bool
== (UtxoPayloadSet [UtxoPayload]
ys) = [UtxoPayload]
xs' [UtxoPayload] -> [UtxoPayload] -> Bool
forall a. Eq a => a -> a -> Bool
== [UtxoPayload]
ys'
    where
      k :: UtxoPayload
-> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
    TxSkelOutDatum, Maybe ScriptHash)
k (UtxoPayload TxOutRef
ref Value
val TxSkelOutDatum
dat Maybe ScriptHash
rs) = (TxOutRef
ref, Value -> [(CurrencySymbol, TokenName, Integer)]
Api.flattenValue Value
val, TxSkelOutDatum
dat, Maybe ScriptHash
rs)
      xs' :: [UtxoPayload]
xs' = (UtxoPayload -> UtxoPayload -> Ordering)
-> [UtxoPayload] -> [UtxoPayload]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((TxOutRef, [(CurrencySymbol, TokenName, Integer)], TxSkelOutDatum,
 Maybe ScriptHash)
-> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
    TxSkelOutDatum, Maybe ScriptHash)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((TxOutRef, [(CurrencySymbol, TokenName, Integer)], TxSkelOutDatum,
  Maybe ScriptHash)
 -> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
     TxSkelOutDatum, Maybe ScriptHash)
 -> Ordering)
-> (UtxoPayload
    -> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
        TxSkelOutDatum, Maybe ScriptHash))
-> UtxoPayload
-> UtxoPayload
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` UtxoPayload
-> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
    TxSkelOutDatum, Maybe ScriptHash)
k) [UtxoPayload]
xs
      ys' :: [UtxoPayload]
ys' = (UtxoPayload -> UtxoPayload -> Ordering)
-> [UtxoPayload] -> [UtxoPayload]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((TxOutRef, [(CurrencySymbol, TokenName, Integer)], TxSkelOutDatum,
 Maybe ScriptHash)
-> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
    TxSkelOutDatum, Maybe ScriptHash)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((TxOutRef, [(CurrencySymbol, TokenName, Integer)], TxSkelOutDatum,
  Maybe ScriptHash)
 -> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
     TxSkelOutDatum, Maybe ScriptHash)
 -> Ordering)
-> (UtxoPayload
    -> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
        TxSkelOutDatum, Maybe ScriptHash))
-> UtxoPayload
-> UtxoPayload
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` UtxoPayload
-> (TxOutRef, [(CurrencySymbol, TokenName, Integer)],
    TxSkelOutDatum, Maybe ScriptHash)
k) [UtxoPayload]
ys

instance Semigroup UtxoPayloadSet where
  UtxoPayloadSet [UtxoPayload]
a <> :: UtxoPayloadSet -> UtxoPayloadSet -> UtxoPayloadSet
<> UtxoPayloadSet [UtxoPayload]
b = [UtxoPayload] -> UtxoPayloadSet
UtxoPayloadSet ([UtxoPayload] -> UtxoPayloadSet)
-> [UtxoPayload] -> UtxoPayloadSet
forall a b. (a -> b) -> a -> b
$ [UtxoPayload]
a [UtxoPayload] -> [UtxoPayload] -> [UtxoPayload]
forall a. [a] -> [a] -> [a]
++ [UtxoPayload]
b

instance Monoid UtxoPayloadSet where
  mempty :: UtxoPayloadSet
mempty = [UtxoPayload] -> UtxoPayloadSet
UtxoPayloadSet []

-- | Computes the total value in a set
utxoPayloadSetTotal :: UtxoPayloadSet -> Api.Value
utxoPayloadSetTotal :: UtxoPayloadSet -> Value
utxoPayloadSetTotal = [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat ([Value] -> Value)
-> (UtxoPayloadSet -> [Value]) -> UtxoPayloadSet -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoPayload -> Value) -> [UtxoPayload] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UtxoPayload -> Value
utxoPayloadValue ([UtxoPayload] -> [Value])
-> (UtxoPayloadSet -> [UtxoPayload]) -> UtxoPayloadSet -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoPayloadSet -> [UtxoPayload]
utxoPayloadSet

-- | The missing information on a 'TxSkel' that can only be resolved by querying
-- the state of the blockchain.
data SkelContext = SkelContext
  { SkelContext -> Map TxOutRef TxOut
skelContextTxOuts :: Map Api.TxOutRef Api.TxOut,
    SkelContext -> Map DatumHash TxSkelOutDatum
skelContextTxSkelOutDatums :: Map Api.DatumHash TxSkelOutDatum
  }