mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-15 11:22:38 +01:00
finished first PAB version
This commit is contained in:
parent
b5ce65494d
commit
c1d2a27d34
6 changed files with 29 additions and 47 deletions
5
code/week06/.gitignore
vendored
5
code/week06/.gitignore
vendored
|
@ -1 +1,6 @@
|
|||
dist-newstyle/
|
||||
oracle.cid
|
||||
W2.cid
|
||||
W3.cid
|
||||
W4.cid
|
||||
W5.cid
|
||||
|
|
|
@ -39,9 +39,9 @@ import qualified Plutus.PAB.Webserver.Server as PAB.Server
|
|||
import qualified Plutus.Contracts.Currency as Currency
|
||||
|
||||
import Wallet.Emulator.Types (Wallet (..), walletPubKey)
|
||||
import Wallet.Types (ContractInstanceId (..))
|
||||
|
||||
import qualified Week06.Oracle.Core as Oracle
|
||||
import qualified Week06.Oracle.Funds as Oracle
|
||||
import qualified Week06.Oracle.Swap as Oracle
|
||||
|
||||
main :: IO ()
|
||||
|
@ -49,14 +49,18 @@ main = void $ Simulator.runSimulationWith handlers $ do
|
|||
Simulator.logString @(Builtin OracleContracts) "Starting Oracle PAB webserver. Press enter to exit."
|
||||
shutdown <- PAB.Server.startServerDebug
|
||||
|
||||
forM_ wallets $ \w ->
|
||||
void $ Simulator.activateContract w Funds
|
||||
|
||||
cidInit <- Simulator.activateContract (Wallet 1) Init
|
||||
cs <- waitForLast cidInit
|
||||
_ <- Simulator.waitUntilFinished cidInit
|
||||
|
||||
cidOracle <- Simulator.activateContract (Wallet 1) $ Oracle cs
|
||||
liftIO $ writeFile "oracle.cid" $ show $ unContractInstanceId cidOracle
|
||||
oracle <- waitForLast cidOracle
|
||||
|
||||
forM_ wallets $ \w ->
|
||||
when (w /= Wallet 1) $ do
|
||||
cid <- Simulator.activateContract w $ Swap oracle
|
||||
liftIO $ writeFile ('W' : show (getWallet w) ++ ".cid") $ show $ unContractInstanceId cid
|
||||
|
||||
void $ liftIO getLine
|
||||
shutdown
|
||||
|
@ -67,7 +71,7 @@ waitForLast cid =
|
|||
Success (Last (Just x)) -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
data OracleContracts = Init | Oracle CurrencySymbol | Funds | Swap Oracle.Oracle
|
||||
data OracleContracts = Init | Oracle CurrencySymbol | Swap Oracle.Oracle
|
||||
deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
|
||||
|
||||
instance Pretty OracleContracts where
|
||||
|
@ -96,12 +100,10 @@ handleOracleContracts = handleBuiltin getSchema getContract where
|
|||
getSchema = \case
|
||||
Init -> endpointsToSchemas @Empty
|
||||
Oracle _ -> endpointsToSchemas @(Oracle.OracleSchema .\\ BlockchainActions)
|
||||
Funds -> endpointsToSchemas @Empty
|
||||
Swap _ -> endpointsToSchemas @(Oracle.SwapSchema .\\ BlockchainActions)
|
||||
getContract = \case
|
||||
Init -> SomeBuiltin initContract
|
||||
Oracle cs -> SomeBuiltin $ Oracle.runOracle $ oracleParams cs
|
||||
Funds -> SomeBuiltin $ Oracle.ownFunds'
|
||||
Swap oracle -> SomeBuiltin $ Oracle.swap oracle
|
||||
|
||||
handlers :: SimulatorEffectHandlers (Builtin OracleContracts)
|
||||
|
|
|
@ -12,7 +12,6 @@ library
|
|||
hs-source-dirs: src
|
||||
exposed-modules: Week06.Oracle.Core
|
||||
Week06.Oracle.Funds
|
||||
Week06.Oracle.Playground
|
||||
Week06.Oracle.Swap
|
||||
Week06.Oracle.Test
|
||||
build-depends: aeson
|
||||
|
|
|
@ -1,33 +0,0 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Week06.Oracle.Playground where
|
||||
|
||||
import Control.Monad hiding (fmap)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Text (Text)
|
||||
import Data.Void (Void)
|
||||
import GHC.Generics (Generic)
|
||||
import Plutus.Contract as Contract hiding (when)
|
||||
import Plutus.Trace.Emulator as Emulator
|
||||
import qualified PlutusTx
|
||||
import PlutusTx.Prelude hiding (Semigroup(..), unless)
|
||||
import Ledger hiding (singleton)
|
||||
import Ledger.Constraints as Constraints
|
||||
import qualified Ledger.Typed.Scripts as Scripts
|
||||
import Ledger.Value as Value
|
||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
|
||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||
import Playground.Types (KnownCurrency (..))
|
||||
import Prelude (Semigroup (..))
|
||||
import Text.Printf (printf)
|
||||
import Wallet.Emulator.Wallet
|
|
@ -20,6 +20,7 @@ import Control.Monad hiding (fmap)
|
|||
import Data.List (find)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.Monoid (Last (..))
|
||||
import Data.Text (Text)
|
||||
import Plutus.Contract as Contract hiding (when)
|
||||
import qualified PlutusTx
|
||||
|
@ -196,24 +197,31 @@ type SwapSchema =
|
|||
.\/ Endpoint "offer" Integer
|
||||
.\/ Endpoint "retrieve" ()
|
||||
.\/ Endpoint "use" ()
|
||||
.\/ Endpoint "funds" ()
|
||||
|
||||
swap :: Oracle -> Contract () SwapSchema Text ()
|
||||
swap oracle = (offer `select` retrieve `select` use) >> swap oracle
|
||||
swap :: Oracle -> Contract (Last Value) SwapSchema Text ()
|
||||
swap oracle = (offer `select` retrieve `select` use `select` funds) >> swap oracle
|
||||
where
|
||||
offer :: Contract () SwapSchema Text ()
|
||||
offer :: Contract (Last Value) SwapSchema Text ()
|
||||
offer = h $ do
|
||||
amt <- endpoint @"offer"
|
||||
offerSwap oracle amt
|
||||
|
||||
retrieve :: Contract () SwapSchema Text ()
|
||||
retrieve :: Contract (Last Value) SwapSchema Text ()
|
||||
retrieve = h $ do
|
||||
endpoint @"retrieve"
|
||||
retrieveSwaps oracle
|
||||
|
||||
use :: Contract () SwapSchema Text ()
|
||||
use :: Contract (Last Value) SwapSchema Text ()
|
||||
use = h $ do
|
||||
endpoint @"use"
|
||||
useSwap oracle
|
||||
|
||||
h :: Contract () SwapSchema Text () -> Contract () SwapSchema Text ()
|
||||
funds :: Contract (Last Value) SwapSchema Text ()
|
||||
funds = h $ do
|
||||
endpoint @"funds"
|
||||
v <- ownFunds
|
||||
tell $ Last $ Just v
|
||||
|
||||
h :: Contract (Last Value) SwapSchema Text () -> Contract (Last Value) SwapSchema Text ()
|
||||
h = handleError logError
|
||||
|
|
|
@ -74,6 +74,7 @@ myTrace = do
|
|||
callEndpoint @"update" h1 1_500_000
|
||||
void $ Emulator.waitNSlots 3
|
||||
|
||||
void $ activateContractWallet (Wallet 1) ownFunds'
|
||||
void $ activateContractWallet (Wallet 3) ownFunds'
|
||||
void $ activateContractWallet (Wallet 4) ownFunds'
|
||||
void $ activateContractWallet (Wallet 5) ownFunds'
|
||||
|
|
Loading…
Reference in a new issue