{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TypeApplications   #-}
{-| Example trace for the uniswap contract
-}
module Plutus.Contracts.Uniswap.Trace(
    uniswapTrace
    --
    , setupTokens
    , tokenNames
    , wallets
    , increaseTransactionLimits
    , increaseTransactionLimitsOpts
    ) where

import Cardano.Node.Emulator.Internal.Node.Params qualified as Params
import Control.Lens (over)
import Control.Monad (forM_, when)
import Control.Monad.Freer.Error (throwError)
import Data.Map qualified as Map
import Data.Monoid qualified as Monoid
import Data.Semigroup qualified as Semigroup
import Data.Void (Void)
import Ledger
import Ledger.Tx.Constraints hiding (adjustUnbalancedTx)
import Plutus.Contract as Contract hiding (throwError)
import Plutus.Contract.Test qualified as Test
import Plutus.Contracts.Currency qualified as Currency
import Plutus.Contracts.Uniswap.OffChain as OffChain
import Plutus.Contracts.Uniswap.Types as Types
import Plutus.Script.Utils.Ada (adaSymbol, adaToken)
import Plutus.Script.Utils.Value qualified as Value
import Plutus.Trace.Emulator (EmulatorRuntimeError (GenericError), EmulatorTrace)
import Plutus.Trace.Emulator qualified as Emulator
import Wallet.Emulator (Wallet (..), knownWallet, knownWallets, mockWalletAddress)

-- | Set up a liquidity pool and call the "add" endpoint
uniswapTrace :: EmulatorTrace ()
uniswapTrace :: EmulatorTrace ()
uniswapTrace = do
    ContractHandle
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
cidInit <- Wallet
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
-> ContractInstanceTag
-> Eff
     EmulatorEffects
     (ContractHandle
        (Maybe (Last OneShotCurrency))
        ('R
           '[ "Create native token"
              ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
        CurrencyError)
forall (contract :: * -> Row * -> * -> * -> *) (s :: Row *) e w a
       (effs :: [* -> *]).
(IsContract contract, ContractConstraints s, Show e, FromJSON e,
 ToJSON e, ToJSON w, Monoid w, FromJSON w,
 Member StartContract effs) =>
Wallet
-> contract w s e a
-> ContractInstanceTag
-> Eff effs (ContractHandle w s e)
Emulator.activateContract (Integer -> Wallet
knownWallet Integer
1) Contract
  (Maybe (Last OneShotCurrency)) CurrencySchema CurrencyError ()
Contract
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
  ()
setupTokens ContractInstanceTag
"init"
    Slot
_ <- Natural -> Eff EmulatorEffects Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Natural -> Eff effs Slot
Emulator.waitNSlots Natural
5
    CurrencySymbol
cs <- ContractHandle
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
-> Eff EmulatorEffects (Maybe (Last OneShotCurrency))
forall w (s :: Row *) e (effs :: [* -> *]).
(Member RunContract effs, ContractConstraints s, FromJSON e,
 FromJSON w, ToJSON w) =>
ContractHandle w s e -> Eff effs w
Emulator.observableState ContractHandle
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
cidInit Eff EmulatorEffects (Maybe (Last OneShotCurrency))
-> (Maybe (Last OneShotCurrency)
    -> Eff EmulatorEffects CurrencySymbol)
-> Eff EmulatorEffects CurrencySymbol
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just (Semigroup.Last OneShotCurrency
cur) -> CurrencySymbol -> Eff EmulatorEffects CurrencySymbol
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OneShotCurrency -> CurrencySymbol
Currency.currencySymbol OneShotCurrency
cur)
                Maybe (Last OneShotCurrency)
_                         -> EmulatorRuntimeError -> Eff EmulatorEffects CurrencySymbol
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (EmulatorRuntimeError -> Eff EmulatorEffects CurrencySymbol)
-> EmulatorRuntimeError -> Eff EmulatorEffects CurrencySymbol
forall a b. (a -> b) -> a -> b
$ String -> EmulatorRuntimeError
GenericError String
"failed to create currency"
    let coins :: Map TokenName (Coin a)
coins = [(TokenName, Coin a)] -> Map TokenName (Coin a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TokenName
tn, CurrencySymbol -> TokenName -> Coin a
forall a. CurrencySymbol -> TokenName -> Coin a
Types.mkCoin CurrencySymbol
cs TokenName
tn) | TokenName
tn <- [TokenName]
tokenNames]
        ada :: Coin a
ada   = CurrencySymbol -> TokenName -> Coin a
forall a. CurrencySymbol -> TokenName -> Coin a
Types.mkCoin CurrencySymbol
adaSymbol TokenName
adaToken

    ContractHandle
  (Last (Either Text Uniswap)) EmptySchema ContractError
cidStart <- Wallet
-> Contract
     (Last (Either Text Uniswap)) EmptySchema ContractError ()
-> ContractInstanceTag
-> Eff
     EmulatorEffects
     (ContractHandle
        (Last (Either Text Uniswap)) EmptySchema ContractError)
forall (contract :: * -> Row * -> * -> * -> *) (s :: Row *) e w a
       (effs :: [* -> *]).
(IsContract contract, ContractConstraints s, Show e, FromJSON e,
 ToJSON e, ToJSON w, Monoid w, FromJSON w,
 Member StartContract effs) =>
Wallet
-> contract w s e a
-> ContractInstanceTag
-> Eff effs (ContractHandle w s e)
Emulator.activateContract (Integer -> Wallet
knownWallet Integer
1) Contract (Last (Either Text Uniswap)) EmptySchema ContractError ()
ownerEndpoint ContractInstanceTag
"start"
    Slot
_ <- Natural -> Eff EmulatorEffects Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Natural -> Eff effs Slot
Emulator.waitNSlots Natural
5
    Uniswap
us <- ContractHandle
  (Last (Either Text Uniswap)) EmptySchema ContractError
-> Eff EmulatorEffects (Last (Either Text Uniswap))
forall w (s :: Row *) e (effs :: [* -> *]).
(Member RunContract effs, ContractConstraints s, FromJSON e,
 FromJSON w, ToJSON w) =>
ContractHandle w s e -> Eff effs w
Emulator.observableState ContractHandle
  (Last (Either Text Uniswap)) EmptySchema ContractError
cidStart Eff EmulatorEffects (Last (Either Text Uniswap))
-> (Last (Either Text Uniswap) -> Eff EmulatorEffects Uniswap)
-> Eff EmulatorEffects Uniswap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Monoid.Last (Just (Right Uniswap
v)) -> Uniswap -> Eff EmulatorEffects Uniswap
forall (f :: * -> *) a. Applicative f => a -> f a
pure Uniswap
v
                Last (Either Text Uniswap)
_                            -> EmulatorRuntimeError -> Eff EmulatorEffects Uniswap
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (EmulatorRuntimeError -> Eff EmulatorEffects Uniswap)
-> EmulatorRuntimeError -> Eff EmulatorEffects Uniswap
forall a b. (a -> b) -> a -> b
$ String -> EmulatorRuntimeError
GenericError String
"initialisation failed"
    ContractHandle
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
cid1 <- Wallet
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Eff
     EmulatorEffects
     (ContractHandle
        (Last (Either Text UserContractState))
        ('R
           '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
              "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
              "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
              "funds" ':-> (EndpointValue (), ActiveEndpoint),
              "pools" ':-> (EndpointValue (), ActiveEndpoint),
              "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
              "stop" ':-> (EndpointValue (), ActiveEndpoint),
              "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
        Void)
forall (contract :: * -> Row * -> * -> * -> *) w (s :: Row *) e
       (effs :: [* -> *]).
(IsContract contract, ContractConstraints s, Show e, ToJSON e,
 FromJSON e, ToJSON w, FromJSON w, Member StartContract effs,
 Monoid w) =>
Wallet -> contract w s e () -> Eff effs (ContractHandle w s e)
Emulator.activateContractWallet (Integer -> Wallet
knownWallet Integer
2) (Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise (Promise
   (Last (Either Text UserContractState))
   ('R
      '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
         "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
         "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
         "funds" ':-> (EndpointValue (), ActiveEndpoint),
         "pools" ':-> (EndpointValue (), ActiveEndpoint),
         "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
         "stop" ':-> (EndpointValue (), ActiveEndpoint),
         "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
   Void
   ()
 -> Contract
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      ())
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall a b. (a -> b) -> a -> b
$ Uniswap
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
userEndpoints Uniswap
us)
    ContractHandle
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
cid2 <- Wallet
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Eff
     EmulatorEffects
     (ContractHandle
        (Last (Either Text UserContractState))
        ('R
           '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
              "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
              "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
              "funds" ':-> (EndpointValue (), ActiveEndpoint),
              "pools" ':-> (EndpointValue (), ActiveEndpoint),
              "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
              "stop" ':-> (EndpointValue (), ActiveEndpoint),
              "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
        Void)
forall (contract :: * -> Row * -> * -> * -> *) w (s :: Row *) e
       (effs :: [* -> *]).
(IsContract contract, ContractConstraints s, Show e, ToJSON e,
 FromJSON e, ToJSON w, FromJSON w, Member StartContract effs,
 Monoid w) =>
Wallet -> contract w s e () -> Eff effs (ContractHandle w s e)
Emulator.activateContractWallet (Integer -> Wallet
knownWallet Integer
3) (Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise (Promise
   (Last (Either Text UserContractState))
   ('R
      '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
         "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
         "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
         "funds" ':-> (EndpointValue (), ActiveEndpoint),
         "pools" ':-> (EndpointValue (), ActiveEndpoint),
         "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
         "stop" ':-> (EndpointValue (), ActiveEndpoint),
         "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
   Void
   ()
 -> Contract
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      ())
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall a b. (a -> b) -> a -> b
$ Uniswap
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
userEndpoints Uniswap
us)
    Slot
_ <- Natural -> Eff EmulatorEffects Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Natural -> Eff effs Slot
Emulator.waitNSlots Natural
5

    let cp :: CreateParams
cp = Coin A -> Coin B -> Amount A -> Amount B -> CreateParams
OffChain.CreateParams Coin A
forall a. Coin a
ada (Map TokenName (Coin B)
forall a. Map TokenName (Coin a)
coins Map TokenName (Coin B) -> TokenName -> Coin B
forall k a. Ord k => Map k a -> k -> a
Map.! TokenName
"A") Amount A
20_000_000 Amount B
500000

    ContractHandle
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
-> CreateParams -> EmulatorTrace ()
forall (l :: Symbol) ep w (s :: Row *) e (effs :: [* -> *]).
(ToJSON ep, ContractConstraints s, HasEndpoint l ep s,
 Member RunContract effs) =>
ContractHandle w s e -> ep -> Eff effs ()
Emulator.callEndpoint @"create" ContractHandle
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
cid1 CreateParams
cp
    Slot
_ <- Natural -> Eff EmulatorEffects Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Natural -> Eff effs Slot
Emulator.waitNSlots Natural
5

    let ap :: AddParams
ap = AddParams :: Coin A -> Coin B -> Amount A -> Amount B -> AddParams
AddParams{apCoinA :: Coin A
apCoinA = Coin A
forall a. Coin a
ada, apCoinB :: Coin B
apCoinB = Map TokenName (Coin B)
forall a. Map TokenName (Coin a)
coins Map TokenName (Coin B) -> TokenName -> Coin B
forall k a. Ord k => Map k a -> k -> a
Map.! TokenName
"A", apAmountA :: Amount A
apAmountA = Amount A
1000, apAmountB :: Amount B
apAmountB = Amount B
5000}
    ContractHandle
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
-> AddParams -> EmulatorTrace ()
forall (l :: Symbol) ep w (s :: Row *) e (effs :: [* -> *]).
(ToJSON ep, ContractConstraints s, HasEndpoint l ep s,
 Member RunContract effs) =>
ContractHandle w s e -> ep -> Eff effs ()
Emulator.callEndpoint @"add" ContractHandle
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
cid2 AddParams
ap
    Slot
_ <- Natural -> Eff EmulatorEffects Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Natural -> Eff effs Slot
Emulator.waitNSlots Natural
5
    () -> EmulatorTrace ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Create some sample tokens and distribute them to
--   the emulated wallets
setupTokens :: Contract (Maybe (Semigroup.Last Currency.OneShotCurrency)) Currency.CurrencySchema Currency.CurrencyError ()
setupTokens :: Contract
  (Maybe (Last OneShotCurrency)) CurrencySchema CurrencyError ()
setupTokens = do
    CardanoAddress
ownAddr <- Contract
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
  CardanoAddress
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e CardanoAddress
Contract.ownAddress
    OneShotCurrency
cur   <- CardanoAddress
-> [(TokenName, Integer)]
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     OneShotCurrency
forall w (s :: Row *) e.
AsCurrencyError e =>
CardanoAddress
-> [(TokenName, Integer)] -> Contract w s e OneShotCurrency
Currency.mintContract CardanoAddress
ownAddr [(TokenName
tn, Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Wallet] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Wallet]
wallets) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
amount) | TokenName
tn <- [TokenName]
tokenNames]
    let cs :: CurrencySymbol
cs = OneShotCurrency -> CurrencySymbol
Currency.currencySymbol OneShotCurrency
cur
        v :: Value
v  = [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat [CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton CurrencySymbol
cs TokenName
tn Integer
amount | TokenName
tn <- [TokenName]
tokenNames]

    [Wallet]
-> (Wallet
    -> Contract
         (Maybe (Last OneShotCurrency))
         ('R
            '[ "Create native token"
               ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
         CurrencyError
         ())
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Wallet]
wallets ((Wallet
  -> Contract
       (Maybe (Last OneShotCurrency))
       ('R
          '[ "Create native token"
             ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
       CurrencyError
       ())
 -> Contract
      (Maybe (Last OneShotCurrency))
      ('R
         '[ "Create native token"
            ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
      CurrencyError
      ())
-> (Wallet
    -> Contract
         (Maybe (Last OneShotCurrency))
         ('R
            '[ "Create native token"
               ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
         CurrencyError
         ())
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall a b. (a -> b) -> a -> b
$ \Wallet
w -> do
        let addr :: CardanoAddress
addr = Wallet -> CardanoAddress
mockWalletAddress Wallet
w
        Bool
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CardanoAddress
addr CardanoAddress -> CardanoAddress -> Bool
forall a. Eq a => a -> a -> Bool
/= CardanoAddress
ownAddr) (Contract
   (Maybe (Last OneShotCurrency))
   ('R
      '[ "Create native token"
         ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
   CurrencyError
   ()
 -> Contract
      (Maybe (Last OneShotCurrency))
      ('R
         '[ "Create native token"
            ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
      CurrencyError
      ())
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall a b. (a -> b) -> a -> b
$ do
            ScriptLookups Void
-> TxConstraints (RedeemerType Void) (DatumType Void)
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints @Void ScriptLookups Void
forall a. Monoid a => a
mempty (Address -> Value -> TxConstraints Void Void
forall i o. Address -> Value -> TxConstraints i o
mustPayToAddress (CardanoAddress -> Address
forall era. AddressInEra era -> Address
Ledger.toPlutusAddress CardanoAddress
addr) Value
v)
              Contract
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
  UnbalancedTx
-> (UnbalancedTx
    -> Contract
         (Maybe (Last OneShotCurrency))
         ('R
            '[ "Create native token"
               ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
         CurrencyError
         UnbalancedTx)
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
  UnbalancedTx
-> (UnbalancedTx
    -> Contract
         (Maybe (Last OneShotCurrency))
         ('R
            '[ "Create native token"
               ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
         CurrencyError
         ())
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed

    Maybe (Last OneShotCurrency)
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall w (s :: Row *) e. w -> Contract w s e ()
tell (Maybe (Last OneShotCurrency)
 -> Contract
      (Maybe (Last OneShotCurrency))
      ('R
         '[ "Create native token"
            ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
      CurrencyError
      ())
-> Maybe (Last OneShotCurrency)
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall a b. (a -> b) -> a -> b
$ Last OneShotCurrency -> Maybe (Last OneShotCurrency)
forall a. a -> Maybe a
Just (Last OneShotCurrency -> Maybe (Last OneShotCurrency))
-> Last OneShotCurrency -> Maybe (Last OneShotCurrency)
forall a b. (a -> b) -> a -> b
$ OneShotCurrency -> Last OneShotCurrency
forall a. a -> Last a
Semigroup.Last OneShotCurrency
cur

  where
    amount :: Integer
amount = Integer
1000000

wallets :: [Wallet]
wallets :: [Wallet]
wallets = Int -> [Wallet] -> [Wallet]
forall a. Int -> [a] -> [a]
take Int
4 [Wallet]
knownWallets

tokenNames :: [Value.TokenName]
tokenNames :: [TokenName]
tokenNames = [TokenName
"A", TokenName
"B", TokenName
"C", TokenName
"D"]

-- Uniswap needs the maximum transaction size to be increased by a factor of 10 to be able to run.
increaseTransactionLimits :: Params.Params -> Params.Params
increaseTransactionLimits :: Params -> Params
increaseTransactionLimits = Natural -> Natural -> Natural -> Params -> Params
Params.increaseTransactionLimits' Natural
10 Natural
1 Natural
1

increaseTransactionLimitsOpts :: Test.CheckOptions -> Test.CheckOptions
increaseTransactionLimitsOpts :: CheckOptions -> CheckOptions
increaseTransactionLimitsOpts = ASetter CheckOptions CheckOptions Params Params
-> (Params -> Params) -> CheckOptions -> CheckOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((EmulatorConfig -> Identity EmulatorConfig)
-> CheckOptions -> Identity CheckOptions
Lens' CheckOptions EmulatorConfig
Test.emulatorConfig ((EmulatorConfig -> Identity EmulatorConfig)
 -> CheckOptions -> Identity CheckOptions)
-> ((Params -> Identity Params)
    -> EmulatorConfig -> Identity EmulatorConfig)
-> ASetter CheckOptions CheckOptions Params Params
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Params -> Identity Params)
-> EmulatorConfig -> Identity EmulatorConfig
Lens' EmulatorConfig Params
Emulator.params) Params -> Params
increaseTransactionLimits