-- | This module exposes the infrastructure to execute mockchain runs. In
-- particular:
--
-- - The notion of initial distribution (a list of payments)
--
-- - The return types of the runs (raw and refined)
--
-- - The initial configuration with which to execute a run
--
-- - The notion of `RunnableMockChain` to actually execute computations
module Cooked.MockChain.Runnable where

import Cooked.MockChain.Error
import Cooked.MockChain.Journal
import Cooked.MockChain.State
import Cooked.MockChain.Write
import Cooked.Skeleton.Output
import Cooked.Wallet
import Data.Default
import Data.List (foldl')
import Data.Map (Map)
import Plutus.Script.Utils.Value qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import Polysemy

-- * Initial distribution of funds

-- | Describes the initial distribution of UTxOs per user.
--
--  The following specifies a starting state where @wallet 1@ owns two UTxOs,
--  one with 42 Ada and one with 2 Ada and one "TOK" token; @wallet 2@ owns a
--  single UTxO with 10 Ada and @wallet 3@ has 10 Ada and a permanent value
--
--  > i0 = distributionFromList $
--  >        [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
--  >        , (wallet 2 , [ ada 10 ])
--  >        , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
--  >        ]
--
-- Note that payment issued through an initial distribution will be attached
-- enough ADA to sustain themselves unless a fixed value is explicitly required.
type InitialDistribution = [TxSkelOut]

-- | 4 UTxOs with 100 Ada each, for each of the first 4 'knownWallets'
initialDistributionTemplate :: InitialDistribution
initialDistributionTemplate :: InitialDistribution
initialDistributionTemplate =
  [(Wallet, [Value])] -> InitialDistribution
forall owner.
IsTxSkelOutAllowedOwner owner =>
[(owner, [Value])] -> InitialDistribution
distributionFromList
    ([(Wallet, [Value])] -> InitialDistribution)
-> (Value -> [(Wallet, [Value])]) -> Value -> InitialDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Wallet] -> [[Value]] -> [(Wallet, [Value])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Wallet] -> [Wallet]
forall a. Int -> [a] -> [a]
take Int
4 [Wallet]
knownWallets)
    ([[Value]] -> [(Wallet, [Value])])
-> (Value -> [[Value]]) -> Value -> [(Wallet, [Value])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> [[Value]]
forall a. a -> [a]
repeat
    ([Value] -> [[Value]]) -> (Value -> [Value]) -> Value -> [[Value]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
4
    (Value -> InitialDistribution) -> Value -> InitialDistribution
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Script.ada Integer
100

-- | Creating a initial distribution with simple values assigned to owners
distributionFromList :: (IsTxSkelOutAllowedOwner owner) => [(owner, [Api.Value])] -> InitialDistribution
distributionFromList :: forall owner.
IsTxSkelOutAllowedOwner owner =>
[(owner, [Value])] -> InitialDistribution
distributionFromList = (InitialDistribution -> (owner, [Value]) -> InitialDistribution)
-> InitialDistribution -> [(owner, [Value])] -> InitialDistribution
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\InitialDistribution
x (owner
user, [Value]
values) -> InitialDistribution
x InitialDistribution -> InitialDistribution -> InitialDistribution
forall a. Semigroup a => a -> a -> a
<> (Value -> TxSkelOut) -> [Value] -> InitialDistribution
forall a b. (a -> b) -> [a] -> [b]
map (owner -> Payable '[ 'IsValue] -> TxSkelOut
forall owner (els :: [PayableKind]).
IsTxSkelOutAllowedOwner owner =>
owner -> Payable els -> TxSkelOut
receives owner
user (Payable '[ 'IsValue] -> TxSkelOut)
-> (Value -> Payable '[ 'IsValue]) -> Value -> TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Payable '[ 'IsValue]
forall a1. ToValue a1 => a1 -> Payable '[ 'IsValue]
Value) [Value]
values) []

-- | Raw return type of running a mockchain
type RawMockChainReturn a =
  (MockChainJournal, (MockChainState, Either MockChainError a))

-- | The returned type when running a mockchain. This is both a reorganizing and
-- filtering of the natural returned type `RawMockChainReturn`.
data MockChainReturn a where
  MockChainReturn ::
    { -- | The value returned by the computation, or an error
      forall a. MockChainReturn a -> Either MockChainError a
mcrValue :: Either MockChainError a,
      -- | The outputs at the end of the run
      forall a. MockChainReturn a -> Map TxOutRef (TxSkelOut, Bool)
mcrOutputs :: Map Api.TxOutRef (TxSkelOut, Bool),
      -- | The 'UtxoState' at the end of the run
      forall a. MockChainReturn a -> UtxoState
mcrUtxoState :: UtxoState,
      -- | The final journal emitted during the run
      forall a. MockChainReturn a -> MockChainJournal
mcrJournal :: MockChainJournal
    } ->
    MockChainReturn a
  deriving ((forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b)
-> (forall a b. a -> MockChainReturn b -> MockChainReturn a)
-> Functor MockChainReturn
forall a b. a -> MockChainReturn b -> MockChainReturn a
forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b
fmap :: forall a b. (a -> b) -> MockChainReturn a -> MockChainReturn b
$c<$ :: forall a b. a -> MockChainReturn b -> MockChainReturn a
<$ :: forall a b. a -> MockChainReturn b -> MockChainReturn a
Functor)

-- | The type of functions transforming an element of type @RawMockChainReturn a@
-- into an element of type @b@
type FunOnMockChainResult a b = RawMockChainReturn a -> b

-- | Building a `MockChainReturn` from a `RawMockChainReturn`
unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
unRawMockChainReturn :: forall a. FunOnMockChainResult a (MockChainReturn a)
unRawMockChainReturn (MockChainJournal
journal, (MockChainState
st, Either MockChainError a
val)) =
  Either MockChainError a
-> Map TxOutRef (TxSkelOut, Bool)
-> UtxoState
-> MockChainJournal
-> MockChainReturn a
forall a.
Either MockChainError a
-> Map TxOutRef (TxSkelOut, Bool)
-> UtxoState
-> MockChainJournal
-> MockChainReturn a
MockChainReturn Either MockChainError a
val (MockChainState -> Map TxOutRef (TxSkelOut, Bool)
mcstOutputs MockChainState
st) (MockChainState -> UtxoState
mcstToUtxoState MockChainState
st) MockChainJournal
journal

-- | Configuration from which to run a mockchain
data MockChainConf a b where
  MockChainConf ::
    { -- | The initial state from which to run the mockchain
      forall a b. MockChainConf a b -> MockChainState
mccInitialState :: MockChainState,
      -- | The initial payments to issue in the run
      forall a b. MockChainConf a b -> InitialDistribution
mccInitialDistribution :: InitialDistribution,
      -- | The function to apply on the results of the run
      forall a b. MockChainConf a b -> FunOnMockChainResult a b
mccFunOnResult :: FunOnMockChainResult a b
    } ->
    MockChainConf a b

-- | The default `MockChainConf`, which uses the default initial state and
-- initial distribution, and returns a refined `MockChainReturn`
mockChainConfTemplate :: MockChainConf a (MockChainReturn a)
mockChainConfTemplate :: forall a. MockChainConf a (MockChainReturn a)
mockChainConfTemplate = MockChainState
-> InitialDistribution
-> FunOnMockChainResult a (MockChainReturn a)
-> MockChainConf a (MockChainReturn a)
forall a b.
MockChainState
-> InitialDistribution
-> FunOnMockChainResult a b
-> MockChainConf a b
MockChainConf MockChainState
forall a. Default a => a
def InitialDistribution
forall a. Default a => a
def FunOnMockChainResult a (MockChainReturn a)
forall a. FunOnMockChainResult a (MockChainReturn a)
unRawMockChainReturn

-- | The class of effects that represent a mockchain run
class RunnableMockChain effs where
  -- | Runs a computation from an initial `MockChainState`, while returning a
  -- list of `RawMockChainReturn`
  runMockChain :: MockChainState -> Sem effs a -> [RawMockChainReturn a]

-- | Runs a `RunnableMockChain` from an initial `MockChainConf`
runMockChainFromConf ::
  ( RunnableMockChain effs,
    Member MockChainWrite effs
  ) =>
  MockChainConf a b ->
  Sem effs a ->
  [b]
runMockChainFromConf :: forall (effs :: EffectRow) a b.
(RunnableMockChain effs, Member MockChainWrite effs) =>
MockChainConf a b -> Sem effs a -> [b]
runMockChainFromConf (MockChainConf MockChainState
initState InitialDistribution
initDist FunOnMockChainResult a b
funOnResult) Sem effs a
currentRun =
  FunOnMockChainResult a b -> [RawMockChainReturn a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunOnMockChainResult a b
funOnResult ([RawMockChainReturn a] -> [b]) -> [RawMockChainReturn a] -> [b]
forall a b. (a -> b) -> a -> b
$
    MockChainState -> Sem effs a -> [RawMockChainReturn a]
forall (effs :: EffectRow) a.
RunnableMockChain effs =>
MockChainState -> Sem effs a -> [RawMockChainReturn a]
forall a. MockChainState -> Sem effs a -> [RawMockChainReturn a]
runMockChain MockChainState
initState (Sem effs a -> [RawMockChainReturn a])
-> Sem effs a -> [RawMockChainReturn a]
forall a b. (a -> b) -> a -> b
$
      InitialDistribution -> Sem effs Utxos
forall (effs :: EffectRow).
Member MockChainWrite effs =>
InitialDistribution -> Sem effs Utxos
forceOutputs InitialDistribution
initDist Sem effs Utxos -> Sem effs a -> Sem effs a
forall a b. Sem effs a -> Sem effs b -> Sem effs b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sem effs a
currentRun

-- | Runs a `RunnableMockChain` from an initial distribution
runMockChainFromInitDist ::
  ( RunnableMockChain effs,
    Member MockChainWrite effs
  ) =>
  InitialDistribution ->
  Sem effs a ->
  [MockChainReturn a]
runMockChainFromInitDist :: forall (effs :: EffectRow) a.
(RunnableMockChain effs, Member MockChainWrite effs) =>
InitialDistribution -> Sem effs a -> [MockChainReturn a]
runMockChainFromInitDist InitialDistribution
initDist =
  MockChainConf a (MockChainReturn a)
-> Sem effs a -> [MockChainReturn a]
forall (effs :: EffectRow) a b.
(RunnableMockChain effs, Member MockChainWrite effs) =>
MockChainConf a b -> Sem effs a -> [b]
runMockChainFromConf (MockChainConf a (MockChainReturn a)
 -> Sem effs a -> [MockChainReturn a])
-> MockChainConf a (MockChainReturn a)
-> Sem effs a
-> [MockChainReturn a]
forall a b. (a -> b) -> a -> b
$ MockChainConf a (MockChainReturn a)
forall a. MockChainConf a (MockChainReturn a)
mockChainConfTemplate {mccInitialDistribution = initDist}

-- | Same as `runMockChainFromInitDist` using the `initialDistributionTemplate`
runMockChainFromInitDistTemplate ::
  ( RunnableMockChain effs,
    Member MockChainWrite effs
  ) =>
  Sem effs a ->
  [MockChainReturn a]
runMockChainFromInitDistTemplate :: forall (effs :: EffectRow) a.
(RunnableMockChain effs, Member MockChainWrite effs) =>
Sem effs a -> [MockChainReturn a]
runMockChainFromInitDistTemplate = InitialDistribution -> Sem effs a -> [MockChainReturn a]
forall (effs :: EffectRow) a.
(RunnableMockChain effs, Member MockChainWrite effs) =>
InitialDistribution -> Sem effs a -> [MockChainReturn a]
runMockChainFromInitDist InitialDistribution
initialDistributionTemplate

-- | Runs a `RunnableMockChain` from a default configuration
runMockChainDef ::
  ( RunnableMockChain effs,
    Member MockChainWrite effs
  ) =>
  Sem effs a ->
  [MockChainReturn a]
runMockChainDef :: forall (effs :: EffectRow) a.
(RunnableMockChain effs, Member MockChainWrite effs) =>
Sem effs a -> [MockChainReturn a]
runMockChainDef = MockChainConf a (MockChainReturn a)
-> Sem effs a -> [MockChainReturn a]
forall (effs :: EffectRow) a b.
(RunnableMockChain effs, Member MockChainWrite effs) =>
MockChainConf a b -> Sem effs a -> [b]
runMockChainFromConf MockChainConf a (MockChainReturn a)
forall a. MockChainConf a (MockChainReturn a)
mockChainConfTemplate