diff --git a/code/week06/.gitignore b/code/week06/.gitignore index c33954f..2bbd0a6 100644 --- a/code/week06/.gitignore +++ b/code/week06/.gitignore @@ -1 +1,6 @@ dist-newstyle/ +oracle.cid +W2.cid +W3.cid +W4.cid +W5.cid diff --git a/code/week06/app/oracle.hs b/code/week06/app/oracle.hs index 0487ab6..436f1d4 100644 --- a/code/week06/app/oracle.hs +++ b/code/week06/app/oracle.hs @@ -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) diff --git a/code/week06/plutus-pioneer-program-week06.cabal b/code/week06/plutus-pioneer-program-week06.cabal index f20ea9e..389db5b 100644 --- a/code/week06/plutus-pioneer-program-week06.cabal +++ b/code/week06/plutus-pioneer-program-week06.cabal @@ -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 diff --git a/code/week06/src/Week06/Oracle/Playground.hs b/code/week06/src/Week06/Oracle/Playground.hs deleted file mode 100644 index f2e2906..0000000 --- a/code/week06/src/Week06/Oracle/Playground.hs +++ /dev/null @@ -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 diff --git a/code/week06/src/Week06/Oracle/Swap.hs b/code/week06/src/Week06/Oracle/Swap.hs index 834d587..03024b3 100644 --- a/code/week06/src/Week06/Oracle/Swap.hs +++ b/code/week06/src/Week06/Oracle/Swap.hs @@ -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 diff --git a/code/week06/src/Week06/Oracle/Test.hs b/code/week06/src/Week06/Oracle/Test.hs index dfb1a65..aa11769 100644 --- a/code/week06/src/Week06/Oracle/Test.hs +++ b/code/week06/src/Week06/Oracle/Test.hs @@ -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'