finished first PAB version

This commit is contained in:
Lars Brünjes 2021-05-10 18:51:51 +02:00
parent b5ce65494d
commit c1d2a27d34
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
6 changed files with 29 additions and 47 deletions

View file

@ -1 +1,6 @@
dist-newstyle/
oracle.cid
W2.cid
W3.cid
W4.cid
W5.cid

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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'