{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MonoLocalBinds      #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module Playground.Interpreter.Util
    ( stage
    , renderInstanceTrace
    ) where

import Control.Foldl qualified as L
import Control.Lens (Traversal', preview)
import Control.Monad (void)
import Control.Monad.Freer (run)
import Control.Monad.Freer.Error (Error, runError, throwError)
import Data.Aeson (FromJSON, eitherDecode)
import Data.Aeson qualified as JSON
import Data.Bifunctor (first)
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy.Char8 qualified as BSL
import Data.Foldable (traverse_)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (isJust)
import Data.Text (Text)

import Data.Default (Default (def))
import Data.Text.Encoding qualified as Text
import Ledger.Value (Value)
import Playground.Types (ContractCall (AddBlocks, AddBlocksUntil, CallEndpoint, PayToWallet), EvaluationResult,
                         Expression, FunctionSchema (FunctionSchema), PlaygroundError (JsonDecodingError, OtherError),
                         SimulatorWallet (SimulatorWallet), amount, argument, argumentValues, caller, decodingError,
                         endpointDescription, expected, input, recipient, sender, simulatorWalletWallet)
import Playground.Types qualified
import Plutus.Contract (Contract)
import Plutus.Trace (ContractConstraints, ContractInstanceTag)
import Plutus.Trace.Emulator.Types (EmulatorRuntimeError (EmulatorJSONDecodingError), _ContractLog,
                                    _ReceiveEndpointCall, cilMessage)
import Plutus.Trace.Playground (PlaygroundTrace, runPlaygroundStream, walletInstanceTag)
import Plutus.Trace.Playground qualified
import Plutus.Trace.Playground qualified as Trace
import Prettyprinter (defaultLayoutOptions, layoutPretty, pretty, vsep)
import Prettyprinter.Render.Text (renderStrict)
import Streaming.Prelude (fst')
import Wallet.Emulator.Folds (EmulatorEventFoldM)
import Wallet.Emulator.Folds qualified as Folds
import Wallet.Emulator.MultiAgent (EmulatorEvent, chainEvent, eteEvent, instanceEvent)
import Wallet.Emulator.Stream (foldEmulatorStreamM)
import Wallet.Emulator.Types (Wallet, WalletNumber, fromWalletNumber, mockWalletPaymentPubKeyHash)
import Wallet.Types (EndpointDescription (getEndpointDescription))

-- | Unfortunately any uncaught errors in the interpreter kill the
-- thread that is running it rather than returning the error. This
-- means we need to handle all expected errors in the expression we
-- are interpreting. This gets a little tricky because we have to
-- decode JSON inside the interpreter (since we don't have access to
-- it's type outside) so we need to wrap the @apply functions up in
-- something that can throw errors.
playgroundDecode ::
       FromJSON a => String -> ByteString -> Either PlaygroundError a
playgroundDecode :: String -> ByteString -> Either PlaygroundError a
playgroundDecode String
expected ByteString
input =
    (String -> PlaygroundError)
-> Either String a -> Either PlaygroundError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
        (\String
err ->
             JsonDecodingError :: String -> String -> String -> PlaygroundError
JsonDecodingError
                 {String
expected :: String
expected :: String
expected, input :: String
input = ByteString -> String
BSL.unpack ByteString
input, decodingError :: String
decodingError = String
err}) (Either String a -> Either PlaygroundError a)
-> Either String a -> Either PlaygroundError a
forall a b. (a -> b) -> a -> b
$
    ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
input

funds :: [WalletNumber] -> EmulatorEventFoldM effs (Map WalletNumber Value)
funds :: [WalletNumber] -> EmulatorEventFoldM effs (Map WalletNumber Value)
funds = Fold EmulatorEvent (Map WalletNumber Value)
-> EmulatorEventFoldM effs (Map WalletNumber Value)
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent (Map WalletNumber Value)
 -> EmulatorEventFoldM effs (Map WalletNumber Value))
-> ([WalletNumber] -> Fold EmulatorEvent (Map WalletNumber Value))
-> [WalletNumber]
-> EmulatorEventFoldM effs (Map WalletNumber Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WalletNumber (Fold EmulatorEvent Value)
-> Fold EmulatorEvent (Map WalletNumber Value)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Map WalletNumber (Fold EmulatorEvent Value)
 -> Fold EmulatorEvent (Map WalletNumber Value))
-> ([WalletNumber] -> Map WalletNumber (Fold EmulatorEvent Value))
-> [WalletNumber]
-> Fold EmulatorEvent (Map WalletNumber Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(WalletNumber, Fold EmulatorEvent Value)]
-> Map WalletNumber (Fold EmulatorEvent Value)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(WalletNumber, Fold EmulatorEvent Value)]
 -> Map WalletNumber (Fold EmulatorEvent Value))
-> ([WalletNumber] -> [(WalletNumber, Fold EmulatorEvent Value)])
-> [WalletNumber]
-> Map WalletNumber (Fold EmulatorEvent Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletNumber -> (WalletNumber, Fold EmulatorEvent Value))
-> [WalletNumber] -> [(WalletNumber, Fold EmulatorEvent Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WalletNumber
w -> (WalletNumber
w, Wallet -> Fold EmulatorEvent Value
Folds.walletFunds (WalletNumber -> Wallet
fromWalletNumber WalletNumber
w)))

fees :: [WalletNumber] -> EmulatorEventFoldM effs (Map WalletNumber Value)
fees :: [WalletNumber] -> EmulatorEventFoldM effs (Map WalletNumber Value)
fees = Fold EmulatorEvent (Map WalletNumber Value)
-> EmulatorEventFoldM effs (Map WalletNumber Value)
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent (Map WalletNumber Value)
 -> EmulatorEventFoldM effs (Map WalletNumber Value))
-> ([WalletNumber] -> Fold EmulatorEvent (Map WalletNumber Value))
-> [WalletNumber]
-> EmulatorEventFoldM effs (Map WalletNumber Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WalletNumber (Fold EmulatorEvent Value)
-> Fold EmulatorEvent (Map WalletNumber Value)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Map WalletNumber (Fold EmulatorEvent Value)
 -> Fold EmulatorEvent (Map WalletNumber Value))
-> ([WalletNumber] -> Map WalletNumber (Fold EmulatorEvent Value))
-> [WalletNumber]
-> Fold EmulatorEvent (Map WalletNumber Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(WalletNumber, Fold EmulatorEvent Value)]
-> Map WalletNumber (Fold EmulatorEvent Value)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(WalletNumber, Fold EmulatorEvent Value)]
 -> Map WalletNumber (Fold EmulatorEvent Value))
-> ([WalletNumber] -> [(WalletNumber, Fold EmulatorEvent Value)])
-> [WalletNumber]
-> Map WalletNumber (Fold EmulatorEvent Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletNumber -> (WalletNumber, Fold EmulatorEvent Value))
-> [WalletNumber] -> [(WalletNumber, Fold EmulatorEvent Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WalletNumber
w -> (WalletNumber
w, Wallet -> Fold EmulatorEvent Value
Folds.walletFees (WalletNumber -> Wallet
fromWalletNumber WalletNumber
w)))

renderInstanceTrace :: [ContractInstanceTag] -> EmulatorEventFoldM effs Text
renderInstanceTrace :: [ContractInstanceTag] -> EmulatorEventFoldM effs Text
renderInstanceTrace =
    Fold EmulatorEvent Text -> EmulatorEventFoldM effs Text
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize
    (Fold EmulatorEvent Text -> EmulatorEventFoldM effs Text)
-> ([ContractInstanceTag] -> Fold EmulatorEvent Text)
-> [ContractInstanceTag]
-> EmulatorEventFoldM effs Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[EmulatorTimeEvent ContractInstanceLog]] -> Text)
-> Fold EmulatorEvent [[EmulatorTimeEvent ContractInstanceLog]]
-> Fold EmulatorEvent Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream Any -> Text)
-> ([[EmulatorTimeEvent ContractInstanceLog]]
    -> SimpleDocStream Any)
-> [[EmulatorTimeEvent ContractInstanceLog]]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> ([[EmulatorTimeEvent ContractInstanceLog]] -> Doc Any)
-> [[EmulatorTimeEvent ContractInstanceLog]]
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Any] -> Doc Any
forall ann. [Doc ann] -> Doc ann
vsep ([Doc Any] -> Doc Any)
-> ([[EmulatorTimeEvent ContractInstanceLog]] -> [Doc Any])
-> [[EmulatorTimeEvent ContractInstanceLog]]
-> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([EmulatorTimeEvent ContractInstanceLog] -> Doc Any)
-> [[EmulatorTimeEvent ContractInstanceLog]] -> [Doc Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [EmulatorTimeEvent ContractInstanceLog] -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty)
    (Fold EmulatorEvent [[EmulatorTimeEvent ContractInstanceLog]]
 -> Fold EmulatorEvent Text)
-> ([ContractInstanceTag]
    -> Fold EmulatorEvent [[EmulatorTimeEvent ContractInstanceLog]])
-> [ContractInstanceTag]
-> Fold EmulatorEvent Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceTag
 -> Fold EmulatorEvent [EmulatorTimeEvent ContractInstanceLog])
-> [ContractInstanceTag]
-> Fold EmulatorEvent [[EmulatorTimeEvent ContractInstanceLog]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ContractInstanceTag
-> Fold EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
Folds.instanceLog

-- Events that are of interest to users of the Playground
isInteresting :: EmulatorEvent -> Bool
isInteresting :: EmulatorEvent -> Bool
isInteresting EmulatorEvent
x =
    let matches :: Traversal' s a -> s -> Bool
        matches :: Traversal' s a -> s -> Bool
matches Traversal' s a
p = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (s -> Maybe a) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First a) s a -> s -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First a) s a
Traversal' s a
p in
    Traversal' EmulatorEvent ChainEvent -> EmulatorEvent -> Bool
forall s a. Traversal' s a -> s -> Bool
matches ((EmulatorEvent' -> f EmulatorEvent')
-> EmulatorEvent -> f EmulatorEvent
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> f EmulatorEvent')
 -> EmulatorEvent -> f EmulatorEvent)
-> ((ChainEvent -> f ChainEvent)
    -> EmulatorEvent' -> f EmulatorEvent')
-> (ChainEvent -> f ChainEvent)
-> EmulatorEvent
-> f EmulatorEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent -> f ChainEvent) -> EmulatorEvent' -> f EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent) EmulatorEvent
x
    Bool -> Bool -> Bool
|| Traversal' EmulatorEvent (EndpointDescription, Value)
-> EmulatorEvent -> Bool
forall s a. Traversal' s a -> s -> Bool
matches ((EmulatorEvent' -> f EmulatorEvent')
-> EmulatorEvent -> f EmulatorEvent
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> f EmulatorEvent')
 -> EmulatorEvent -> f EmulatorEvent)
-> (((EndpointDescription, Value)
     -> f (EndpointDescription, Value))
    -> EmulatorEvent' -> f EmulatorEvent')
-> ((EndpointDescription, Value) -> f (EndpointDescription, Value))
-> EmulatorEvent
-> f EmulatorEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceLog -> f ContractInstanceLog)
-> EmulatorEvent' -> f EmulatorEvent'
Prism' EmulatorEvent' ContractInstanceLog
instanceEvent ((ContractInstanceLog -> f ContractInstanceLog)
 -> EmulatorEvent' -> f EmulatorEvent')
-> (((EndpointDescription, Value)
     -> f (EndpointDescription, Value))
    -> ContractInstanceLog -> f ContractInstanceLog)
-> ((EndpointDescription, Value) -> f (EndpointDescription, Value))
-> EmulatorEvent'
-> f EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceMsg -> f ContractInstanceMsg)
-> ContractInstanceLog -> f ContractInstanceLog
Lens' ContractInstanceLog ContractInstanceMsg
cilMessage ((ContractInstanceMsg -> f ContractInstanceMsg)
 -> ContractInstanceLog -> f ContractInstanceLog)
-> (((EndpointDescription, Value)
     -> f (EndpointDescription, Value))
    -> ContractInstanceMsg -> f ContractInstanceMsg)
-> ((EndpointDescription, Value) -> f (EndpointDescription, Value))
-> ContractInstanceLog
-> f ContractInstanceLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EndpointDescription, Value) -> f (EndpointDescription, Value))
-> ContractInstanceMsg -> f ContractInstanceMsg
Prism' ContractInstanceMsg (EndpointDescription, Value)
_ReceiveEndpointCall) EmulatorEvent
x
    Bool -> Bool -> Bool
|| Traversal' EmulatorEvent Value -> EmulatorEvent -> Bool
forall s a. Traversal' s a -> s -> Bool
matches ((EmulatorEvent' -> f EmulatorEvent')
-> EmulatorEvent -> f EmulatorEvent
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> f EmulatorEvent')
 -> EmulatorEvent -> f EmulatorEvent)
-> ((Value -> f Value) -> EmulatorEvent' -> f EmulatorEvent')
-> (Value -> f Value)
-> EmulatorEvent
-> f EmulatorEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceLog -> f ContractInstanceLog)
-> EmulatorEvent' -> f EmulatorEvent'
Prism' EmulatorEvent' ContractInstanceLog
instanceEvent ((ContractInstanceLog -> f ContractInstanceLog)
 -> EmulatorEvent' -> f EmulatorEvent')
-> ((Value -> f Value)
    -> ContractInstanceLog -> f ContractInstanceLog)
-> (Value -> f Value)
-> EmulatorEvent'
-> f EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceMsg -> f ContractInstanceMsg)
-> ContractInstanceLog -> f ContractInstanceLog
Lens' ContractInstanceLog ContractInstanceMsg
cilMessage ((ContractInstanceMsg -> f ContractInstanceMsg)
 -> ContractInstanceLog -> f ContractInstanceLog)
-> ((Value -> f Value)
    -> ContractInstanceMsg -> f ContractInstanceMsg)
-> (Value -> f Value)
-> ContractInstanceLog
-> f ContractInstanceLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> f Value) -> ContractInstanceMsg -> f ContractInstanceMsg
Prism' ContractInstanceMsg Value
_ContractLog) EmulatorEvent
x

evaluationResultFold :: [WalletNumber] -> EmulatorEventFoldM effs EvaluationResult
evaluationResultFold :: [WalletNumber] -> EmulatorEventFoldM effs EvaluationResult
evaluationResultFold [WalletNumber]
wallets =
    let pkh :: WalletNumber -> (PaymentPubKeyHash, WalletNumber)
pkh WalletNumber
wallet = (Wallet -> PaymentPubKeyHash
mockWalletPaymentPubKeyHash (Wallet -> PaymentPubKeyHash) -> Wallet -> PaymentPubKeyHash
forall a b. (a -> b) -> a -> b
$ WalletNumber -> Wallet
fromWalletNumber WalletNumber
wallet, WalletNumber
wallet)
    in [[AnnotatedTx]]
-> [EmulatorEvent]
-> Text
-> [SimulatorWallet]
-> [SimulatorWallet]
-> [(PaymentPubKeyHash, WalletNumber)]
-> EvaluationResult
Playground.Types.EvaluationResult
            ([[AnnotatedTx]]
 -> [EmulatorEvent]
 -> Text
 -> [SimulatorWallet]
 -> [SimulatorWallet]
 -> [(PaymentPubKeyHash, WalletNumber)]
 -> EvaluationResult)
-> FoldM (Eff effs) EmulatorEvent [[AnnotatedTx]]
-> FoldM
     (Eff effs)
     EmulatorEvent
     ([EmulatorEvent]
      -> Text
      -> [SimulatorWallet]
      -> [SimulatorWallet]
      -> [(PaymentPubKeyHash, WalletNumber)]
      -> EvaluationResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold EmulatorEvent [[AnnotatedTx]]
-> FoldM (Eff effs) EmulatorEvent [[AnnotatedTx]]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize ([[AnnotatedTx]] -> [[AnnotatedTx]]
forall a. [a] -> [a]
reverse ([[AnnotatedTx]] -> [[AnnotatedTx]])
-> Fold EmulatorEvent [[AnnotatedTx]]
-> Fold EmulatorEvent [[AnnotatedTx]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold EmulatorEvent [[AnnotatedTx]]
Folds.annotatedBlockchain)
            FoldM
  (Eff effs)
  EmulatorEvent
  ([EmulatorEvent]
   -> Text
   -> [SimulatorWallet]
   -> [SimulatorWallet]
   -> [(PaymentPubKeyHash, WalletNumber)]
   -> EvaluationResult)
-> FoldM (Eff effs) EmulatorEvent [EmulatorEvent]
-> FoldM
     (Eff effs)
     EmulatorEvent
     (Text
      -> [SimulatorWallet]
      -> [SimulatorWallet]
      -> [(PaymentPubKeyHash, WalletNumber)]
      -> EvaluationResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold EmulatorEvent [EmulatorEvent]
-> FoldM (Eff effs) EmulatorEvent [EmulatorEvent]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize ((EmulatorEvent -> Bool) -> [EmulatorEvent] -> [EmulatorEvent]
forall a. (a -> Bool) -> [a] -> [a]
filter EmulatorEvent -> Bool
isInteresting ([EmulatorEvent] -> [EmulatorEvent])
-> Fold EmulatorEvent [EmulatorEvent]
-> Fold EmulatorEvent [EmulatorEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold EmulatorEvent [EmulatorEvent]
Folds.emulatorLog)
            FoldM
  (Eff effs)
  EmulatorEvent
  (Text
   -> [SimulatorWallet]
   -> [SimulatorWallet]
   -> [(PaymentPubKeyHash, WalletNumber)]
   -> EvaluationResult)
-> FoldM (Eff effs) EmulatorEvent Text
-> FoldM
     (Eff effs)
     EmulatorEvent
     ([SimulatorWallet]
      -> [SimulatorWallet]
      -> [(PaymentPubKeyHash, WalletNumber)]
      -> EvaluationResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ContractInstanceTag] -> FoldM (Eff effs) EmulatorEvent Text
forall (effs :: [* -> *]).
[ContractInstanceTag] -> EmulatorEventFoldM effs Text
renderInstanceTrace (Wallet -> ContractInstanceTag
walletInstanceTag (Wallet -> ContractInstanceTag)
-> (WalletNumber -> Wallet) -> WalletNumber -> ContractInstanceTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletNumber -> Wallet
fromWalletNumber (WalletNumber -> ContractInstanceTag)
-> [WalletNumber] -> [ContractInstanceTag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WalletNumber]
wallets)
            FoldM
  (Eff effs)
  EmulatorEvent
  ([SimulatorWallet]
   -> [SimulatorWallet]
   -> [(PaymentPubKeyHash, WalletNumber)]
   -> EvaluationResult)
-> FoldM (Eff effs) EmulatorEvent [SimulatorWallet]
-> FoldM
     (Eff effs)
     EmulatorEvent
     ([SimulatorWallet]
      -> [(PaymentPubKeyHash, WalletNumber)] -> EvaluationResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map WalletNumber Value -> [SimulatorWallet])
-> FoldM (Eff effs) EmulatorEvent (Map WalletNumber Value)
-> FoldM (Eff effs) EmulatorEvent [SimulatorWallet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((WalletNumber, Value) -> SimulatorWallet)
-> [(WalletNumber, Value)] -> [SimulatorWallet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WalletNumber -> Value -> SimulatorWallet)
-> (WalletNumber, Value) -> SimulatorWallet
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WalletNumber -> Value -> SimulatorWallet
SimulatorWallet) ([(WalletNumber, Value)] -> [SimulatorWallet])
-> (Map WalletNumber Value -> [(WalletNumber, Value)])
-> Map WalletNumber Value
-> [SimulatorWallet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WalletNumber Value -> [(WalletNumber, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList) ([WalletNumber]
-> FoldM (Eff effs) EmulatorEvent (Map WalletNumber Value)
forall (effs :: [* -> *]).
[WalletNumber] -> EmulatorEventFoldM effs (Map WalletNumber Value)
funds [WalletNumber]
wallets)
            FoldM
  (Eff effs)
  EmulatorEvent
  ([SimulatorWallet]
   -> [(PaymentPubKeyHash, WalletNumber)] -> EvaluationResult)
-> FoldM (Eff effs) EmulatorEvent [SimulatorWallet]
-> FoldM
     (Eff effs)
     EmulatorEvent
     ([(PaymentPubKeyHash, WalletNumber)] -> EvaluationResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map WalletNumber Value -> [SimulatorWallet])
-> FoldM (Eff effs) EmulatorEvent (Map WalletNumber Value)
-> FoldM (Eff effs) EmulatorEvent [SimulatorWallet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((WalletNumber, Value) -> SimulatorWallet)
-> [(WalletNumber, Value)] -> [SimulatorWallet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WalletNumber -> Value -> SimulatorWallet)
-> (WalletNumber, Value) -> SimulatorWallet
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WalletNumber -> Value -> SimulatorWallet
SimulatorWallet) ([(WalletNumber, Value)] -> [SimulatorWallet])
-> (Map WalletNumber Value -> [(WalletNumber, Value)])
-> Map WalletNumber Value
-> [SimulatorWallet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WalletNumber Value -> [(WalletNumber, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList) ([WalletNumber]
-> FoldM (Eff effs) EmulatorEvent (Map WalletNumber Value)
forall (effs :: [* -> *]).
[WalletNumber] -> EmulatorEventFoldM effs (Map WalletNumber Value)
fees [WalletNumber]
wallets)
            FoldM
  (Eff effs)
  EmulatorEvent
  ([(PaymentPubKeyHash, WalletNumber)] -> EvaluationResult)
-> FoldM
     (Eff effs) EmulatorEvent [(PaymentPubKeyHash, WalletNumber)]
-> EmulatorEventFoldM effs EvaluationResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(PaymentPubKeyHash, WalletNumber)]
-> FoldM
     (Eff effs) EmulatorEvent [(PaymentPubKeyHash, WalletNumber)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((WalletNumber -> (PaymentPubKeyHash, WalletNumber))
-> [WalletNumber] -> [(PaymentPubKeyHash, WalletNumber)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletNumber -> (PaymentPubKeyHash, WalletNumber)
pkh [WalletNumber]
wallets)

-- | Evaluate a JSON payload from the Playground frontend against a given contract schema.
stage ::
       forall w s a.
       ( ContractConstraints s
       , JSON.ToJSON w
       , Monoid w
       )
    => Contract w s Text a
    -> BSL.ByteString
    -> BSL.ByteString
    -> Either PlaygroundError EvaluationResult
stage :: Contract w s Text a
-> ByteString
-> ByteString
-> Either PlaygroundError EvaluationResult
stage Contract w s Text a
contract ByteString
programJson ByteString
simulatorWalletsJson = do
    String
simulationJson :: String <- String -> ByteString -> Either PlaygroundError String
forall a.
FromJSON a =>
String -> ByteString -> Either PlaygroundError a
playgroundDecode String
"String" ByteString
programJson
    [Expression]
simulation :: [Expression] <-
        String -> ByteString -> Either PlaygroundError [Expression]
forall a.
FromJSON a =>
String -> ByteString -> Either PlaygroundError a
playgroundDecode String
"[Expression schema]" (ByteString -> Either PlaygroundError [Expression])
-> (String -> ByteString)
-> String
-> Either PlaygroundError [Expression]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSL.pack (String -> Either PlaygroundError [Expression])
-> String -> Either PlaygroundError [Expression]
forall a b. (a -> b) -> a -> b
$ String
simulationJson
    [SimulatorWallet]
simulatorWallets :: [SimulatorWallet] <-
        String -> ByteString -> Either PlaygroundError [SimulatorWallet]
forall a.
FromJSON a =>
String -> ByteString -> Either PlaygroundError a
playgroundDecode String
"[SimulatorWallet]" ByteString
simulatorWalletsJson
    let config :: EmulatorConfig
config = InitialChainState -> Params -> EmulatorConfig
Plutus.Trace.Playground.EmulatorConfig (Map Wallet Value -> InitialChainState
forall a b. a -> Either a b
Left (Map Wallet Value -> InitialChainState)
-> Map Wallet Value -> InitialChainState
forall a b. (a -> b) -> a -> b
$ [SimulatorWallet] -> Map Wallet Value
toInitialDistribution [SimulatorWallet]
simulatorWallets) Params
forall a. Default a => a
def
        allWallets :: [WalletNumber]
allWallets = SimulatorWallet -> WalletNumber
simulatorWalletWallet (SimulatorWallet -> WalletNumber)
-> [SimulatorWallet] -> [WalletNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SimulatorWallet]
simulatorWallets
        final :: Either
  PlaygroundError
  (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
final = Eff
  '[]
  (Either
     PlaygroundError
     (Of EvaluationResult (Either EmulatorErr (), EmulatorState)))
-> Either
     PlaygroundError
     (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
forall a. Eff '[] a -> a
run
            (Eff
   '[]
   (Either
      PlaygroundError
      (Of EvaluationResult (Either EmulatorErr (), EmulatorState)))
 -> Either
      PlaygroundError
      (Of EvaluationResult (Either EmulatorErr (), EmulatorState)))
-> Eff
     '[]
     (Either
        PlaygroundError
        (Of EvaluationResult (Either EmulatorErr (), EmulatorState)))
-> Either
     PlaygroundError
     (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
forall a b. (a -> b) -> a -> b
$ Eff
  '[Error PlaygroundError]
  (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
-> Eff
     '[]
     (Either
        PlaygroundError
        (Of EvaluationResult (Either EmulatorErr (), EmulatorState)))
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError
            (Eff
   '[Error PlaygroundError]
   (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
 -> Eff
      '[]
      (Either
         PlaygroundError
         (Of EvaluationResult (Either EmulatorErr (), EmulatorState))))
-> Eff
     '[Error PlaygroundError]
     (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
-> Eff
     '[]
     (Either
        PlaygroundError
        (Of EvaluationResult (Either EmulatorErr (), EmulatorState)))
forall a b. (a -> b) -> a -> b
$ FoldM (Eff '[Error PlaygroundError]) EmulatorEvent EvaluationResult
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[Error PlaygroundError])
     (Either EmulatorErr (), EmulatorState)
-> Eff
     '[Error PlaygroundError]
     (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
forall (effs :: [* -> *]) a b.
FoldM (Eff effs) EmulatorEvent b
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Eff effs (Of b a)
foldEmulatorStreamM @'[Error PlaygroundError] ([WalletNumber]
-> FoldM
     (Eff '[Error PlaygroundError]) EmulatorEvent EvaluationResult
forall (effs :: [* -> *]).
[WalletNumber] -> EmulatorEventFoldM effs EvaluationResult
evaluationResultFold [WalletNumber]
allWallets)
            (Stream
   (Of (LogMessage EmulatorEvent))
   (Eff '[Error PlaygroundError])
   (Either EmulatorErr (), EmulatorState)
 -> Eff
      '[Error PlaygroundError]
      (Of EvaluationResult (Either EmulatorErr (), EmulatorState)))
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[Error PlaygroundError])
     (Either EmulatorErr (), EmulatorState)
-> Eff
     '[Error PlaygroundError]
     (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
forall a b. (a -> b) -> a -> b
$ EmulatorConfig
-> Contract w s Text ()
-> PlaygroundTrace ()
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[Error PlaygroundError])
     (Either EmulatorErr (), EmulatorState)
forall w (s :: Row *) e (effs :: [* -> *]) a.
(ContractConstraints s, Show e, ToJSON e, ToJSON w, Monoid w) =>
EmulatorConfig
-> Contract w s e ()
-> PlaygroundTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
runPlaygroundStream EmulatorConfig
config (Contract w s Text a -> Contract w s Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Contract w s Text a
contract) ((Expression -> PlaygroundTrace ())
-> [Expression] -> PlaygroundTrace ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Expression -> PlaygroundTrace ()
expressionToTrace [Expression]
simulation)

    case Either
  PlaygroundError
  (Of EvaluationResult (Either EmulatorErr (), EmulatorState))
final of
        Left PlaygroundError
err     -> PlaygroundError -> Either PlaygroundError EvaluationResult
forall a b. a -> Either a b
Left (PlaygroundError -> Either PlaygroundError EvaluationResult)
-> (PlaygroundError -> PlaygroundError)
-> PlaygroundError
-> Either PlaygroundError EvaluationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PlaygroundError
OtherError (String -> PlaygroundError)
-> (PlaygroundError -> String)
-> PlaygroundError
-> PlaygroundError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaygroundError -> String
forall a. Show a => a -> String
show (PlaygroundError -> Either PlaygroundError EvaluationResult)
-> PlaygroundError -> Either PlaygroundError EvaluationResult
forall a b. (a -> b) -> a -> b
$ PlaygroundError
err
        Right Of EvaluationResult (Either EmulatorErr (), EmulatorState)
result -> EvaluationResult -> Either PlaygroundError EvaluationResult
forall a b. b -> Either a b
Right (Of EvaluationResult (Either EmulatorErr (), EmulatorState)
-> EvaluationResult
forall a b. Of a b -> a
fst' Of EvaluationResult (Either EmulatorErr (), EmulatorState)
result)

toInitialDistribution :: [SimulatorWallet] -> Map Wallet Value
toInitialDistribution :: [SimulatorWallet] -> Map Wallet Value
toInitialDistribution = [(Wallet, Value)] -> Map Wallet Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Wallet, Value)] -> Map Wallet Value)
-> ([SimulatorWallet] -> [(Wallet, Value)])
-> [SimulatorWallet]
-> Map Wallet Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimulatorWallet -> (Wallet, Value))
-> [SimulatorWallet] -> [(Wallet, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SimulatorWallet WalletNumber
w Value
v) -> (WalletNumber -> Wallet
fromWalletNumber WalletNumber
w, Value
v))

expressionToTrace :: Expression -> PlaygroundTrace ()
expressionToTrace :: Expression -> PlaygroundTrace ()
expressionToTrace = \case
    AddBlocks Integer
blcks -> Eff
  '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
    EmulatedWalletAPI]
  Slot
-> PlaygroundTrace ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff
   '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
     EmulatedWalletAPI]
   Slot
 -> PlaygroundTrace ())
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     Slot
-> PlaygroundTrace ()
forall a b. (a -> b) -> a -> b
$ Natural
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Natural -> Eff effs Slot
Trace.waitNSlots (Natural
 -> Eff
      '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
        EmulatedWalletAPI]
      Slot)
-> Natural
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     Slot
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
blcks
    AddBlocksUntil Slot
slot -> Eff
  '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
    EmulatedWalletAPI]
  Slot
-> PlaygroundTrace ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff
   '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
     EmulatedWalletAPI]
   Slot
 -> PlaygroundTrace ())
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     Slot
-> PlaygroundTrace ()
forall a b. (a -> b) -> a -> b
$ Slot
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Slot -> Eff effs Slot
Trace.waitUntilSlot Slot
slot
    PayToWallet {WalletNumber
sender :: WalletNumber
sender :: forall a. ContractCall a -> WalletNumber
sender, WalletNumber
recipient :: WalletNumber
recipient :: forall a. ContractCall a -> WalletNumber
recipient, Value
amount :: Value
amount :: forall a. ContractCall a -> Value
amount} -> Eff
  '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
    EmulatedWalletAPI]
  TxId
-> PlaygroundTrace ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff
   '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
     EmulatedWalletAPI]
   TxId
 -> PlaygroundTrace ())
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     TxId
-> PlaygroundTrace ()
forall a b. (a -> b) -> a -> b
$ Wallet
-> Wallet
-> Value
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     TxId
forall (effs :: [* -> *]).
Member EmulatedWalletAPI effs =>
Wallet -> Wallet -> Value -> Eff effs TxId
Trace.payToWallet (WalletNumber -> Wallet
fromWalletNumber WalletNumber
sender) (WalletNumber -> Wallet
fromWalletNumber WalletNumber
recipient) Value
amount
    CallEndpoint {WalletNumber
caller :: WalletNumber
caller :: forall a. ContractCall a -> WalletNumber
caller, argumentValues :: forall a. ContractCall a -> FunctionSchema a
argumentValues=FunctionSchema { EndpointDescription
endpointDescription :: EndpointDescription
endpointDescription :: forall a. FunctionSchema a -> EndpointDescription
endpointDescription, argument :: forall a. FunctionSchema a -> a
argument = Value
rawArgument}} ->
        let fromString :: Value -> Maybe ByteString
fromString (JSON.String Text
string) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
string
            fromString Value
_                    = Maybe ByteString
forall a. Maybe a
Nothing
        in case Value -> Maybe ByteString
fromString Value
rawArgument of
            Just ByteString
string ->
                case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode ByteString
string of
                    Left String
errs ->
                        EmulatorRuntimeError -> PlaygroundTrace ()
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError
                            (EmulatorRuntimeError -> PlaygroundTrace ())
-> EmulatorRuntimeError -> PlaygroundTrace ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> EmulatorRuntimeError
EmulatorJSONDecodingError
                              (String
"Error extracting JSON from arguments. Expected an array of JSON strings. " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                        String -> String
forall a. Show a => a -> String
show String
errs)
                              Value
rawArgument
                    Right Value
argument -> do
                        Wallet -> String -> Value -> PlaygroundTrace ()
forall (effs :: [* -> *]).
Member RunContractPlayground effs =>
Wallet -> String -> Value -> Eff effs ()
Trace.callEndpoint (WalletNumber -> Wallet
fromWalletNumber WalletNumber
caller) (EndpointDescription -> String
getEndpointDescription EndpointDescription
endpointDescription) Value
argument
            Maybe ByteString
Nothing ->
                EmulatorRuntimeError -> PlaygroundTrace ()
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError
                    (EmulatorRuntimeError -> PlaygroundTrace ())
-> EmulatorRuntimeError -> PlaygroundTrace ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> EmulatorRuntimeError
EmulatorJSONDecodingError
                      (String
"Expected a String, but got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
rawArgument)
                      Value
rawArgument