mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-15 03:12:34 +01:00
95 lines
2.9 KiB
Haskell
95 lines
2.9 KiB
Haskell
|
{-# 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
|