-- | This module provides a depiction of the state we return when running a
-- 'Cooked.BlockChain.Direct.MockChain'.
module Cooked.MockChain.UtxoState
  ( UtxoState (..),
    UtxoPayloadSet (..),
    UtxoPayload (..),
    holdsInState,
  )
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 Plutus.Script.Utils.Address qualified as Script
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 :: (Script.ToAddress a) => a -> UtxoState -> Api.Value
holdsInState :: forall a. ToAddress a => a -> UtxoState -> Value
holdsInState (a -> Address
forall a. ToAddress a => a -> Address
Script.toAddress -> 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
  { -- | List of UTxOs contained in this '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
  { -- | The reference of this UTxO
    UtxoPayload -> TxOutRef
utxoPayloadTxOutRef :: Api.TxOutRef,
    -- | The value stored in this UTxO
    UtxoPayload -> Value
utxoPayloadValue :: Api.Value,
    -- | The datum stored in this UTxO
    UtxoPayload -> TxSkelOutDatum
utxoPayloadSkelOutDatum :: TxSkelOutDatum,
    -- | The optional reference script stored in this UTxO
    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