{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Week08.TraceTokenSale where import Control.Monad hiding (fmap) import Control.Monad.Freer.Extras as Extras import Data.Default (Default (..)) import qualified Data.Map as Map import Data.Monoid (Last (..)) import Ledger import Ledger.Value import Ledger.Ada as Ada import Plutus.Trace.Emulator as Emulator import PlutusTx.Prelude import Wallet.Emulator.Wallet import Week08.TokenSale test :: IO () test = runEmulatorTraceIO' def emCfg myTrace where emCfg :: EmulatorConfig emCfg = EmulatorConfig $ Left $ Map.fromList [ (Wallet w, v) | w <- [1 .. 3] ] v :: Value v = Ada.lovelaceValueOf 1000_000_000 <> assetClassValue token1 1000 <> assetClassValue token2 1000 currency1, currency2 :: CurrencySymbol currency1 = "aa" currency2 = "bb" name1, name2 :: TokenName name1 = "A" name2 = "B" token1, token2 :: AssetClass token1 = AssetClass (currency1, name1) token2 = AssetClass (currency2, name2) myTrace :: EmulatorTrace () myTrace = do h <- activateContractWallet (Wallet 1) startTS' callEndpoint @"start" h (currency1, name1) void $ Emulator.waitNSlots 5 Last m <- observableState h case m of Nothing -> Extras.logError @String "error starting token sale" Just ts -> do Extras.logInfo $ "started token sale " ++ show ts h1 <- activateContractWallet (Wallet 1) $ useTS ts h2 <- activateContractWallet (Wallet 2) $ useTS ts h3 <- activateContractWallet (Wallet 3) $ useTS ts callEndpoint @"set price" h1 1_000_000 void $ Emulator.waitNSlots 5 callEndpoint @"set price" h2 2_000_000 void $ Emulator.waitNSlots 5 callEndpoint @"add tokens" h1 100 void $ Emulator.waitNSlots 5 callEndpoint @"add tokens" h2 10 void $ Emulator.waitNSlots 5 callEndpoint @"buy tokens" h2 20 void $ Emulator.waitNSlots 5 callEndpoint @"buy tokens" h3 5 void $ Emulator.waitNSlots 5 callEndpoint @"withdraw" h1 (40, 10_000_000) void $ Emulator.waitNSlots 5 callEndpoint @"withdraw" h2 (40, 10_000_000) void $ Emulator.waitNSlots 5