From 395ebef4a8f45202efee2b84e7b6452aefa696d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= Date: Mon, 10 May 2021 15:37:14 +0200 Subject: [PATCH] refactored funds --- code/week06/app/oracle.hs | 2 + .../plutus-pioneer-program-week06.cabal | 1 + code/week06/src/Week06/Oracle/Core.hs | 2 +- code/week06/src/Week06/Oracle/Funds.hs | 41 +++++++++++++++++++ code/week06/src/Week06/Oracle/Swap.hs | 29 ++++--------- code/week06/src/Week06/Oracle/Test.hs | 9 ++-- 6 files changed, 57 insertions(+), 27 deletions(-) create mode 100644 code/week06/src/Week06/Oracle/Funds.hs diff --git a/code/week06/app/oracle.hs b/code/week06/app/oracle.hs index d4a4824..8f618b5 100644 --- a/code/week06/app/oracle.hs +++ b/code/week06/app/oracle.hs @@ -43,6 +43,8 @@ main = void $ Simulator.runSimulationWith handlers $ do Simulator.logString @(Builtin OracleContracts) "Starting Oracle PAB webserver on port 8080. Press enter to exit." shutdown <- PAB.Server.startServerDebug + cidOracle <- Simulator.activateContract (Wallet 1) Oracle + void $ liftIO getLine shutdown diff --git a/code/week06/plutus-pioneer-program-week06.cabal b/code/week06/plutus-pioneer-program-week06.cabal index 1115adb..f02dcc1 100644 --- a/code/week06/plutus-pioneer-program-week06.cabal +++ b/code/week06/plutus-pioneer-program-week06.cabal @@ -11,6 +11,7 @@ License-files: LICENSE library hs-source-dirs: src exposed-modules: Week06.Oracle.Core + Week06.Oracle.Funds Week06.Oracle.Playground Week06.Oracle.Swap Week06.Oracle.Test diff --git a/code/week06/src/Week06/Oracle/Core.hs b/code/week06/src/Week06/Oracle/Core.hs index 6427de6..1a1a8ea 100644 --- a/code/week06/src/Week06/Oracle/Core.hs +++ b/code/week06/src/Week06/Oracle/Core.hs @@ -152,7 +152,7 @@ startOracle op = do , oFee = opFees op , oAsset = AssetClass (opSymbol op, opToken op) } - logInfo @String $ "forged oracle state token for oracle " ++ show oracle + logInfo @String $ "started oracle " ++ show oracle return oracle updateOracle :: forall w s. HasBlockchainActions s => Oracle -> Integer -> Contract w s Text () diff --git a/code/week06/src/Week06/Oracle/Funds.hs b/code/week06/src/Week06/Oracle/Funds.hs new file mode 100644 index 0000000..9e6519f --- /dev/null +++ b/code/week06/src/Week06/Oracle/Funds.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Week06.Oracle.Funds + ( ownFunds + , ownFunds' + ) where + +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Data.Monoid (Last (..)) +import Data.Text (Text) +import Plutus.Contract as Contract hiding (when) +import PlutusTx.Prelude hiding ((<$>)) +import Prelude ((<$>)) +import Ledger hiding (singleton) +import Ledger.Value as Value + +ownFunds :: HasBlockchainActions s => Contract w s Text Value +ownFunds = do + pk <- ownPubKey + utxos <- utxoAt $ pubKeyAddress pk + let v = mconcat $ Map.elems $ txOutValue . txOutTxOut <$> utxos + logInfo @String $ "own funds: " ++ show (Value.flattenValue v) + return v + +ownFunds' :: Contract (Last Value) BlockchainActions Text () +ownFunds' = do + handleError logError $ ownFunds >>= tell . Last . Just + void $ Contract.waitNSlots 1 + ownFunds' diff --git a/code/week06/src/Week06/Oracle/Swap.hs b/code/week06/src/Week06/Oracle/Swap.hs index 1482119..834d587 100644 --- a/code/week06/src/Week06/Oracle/Swap.hs +++ b/code/week06/src/Week06/Oracle/Swap.hs @@ -20,7 +20,6 @@ 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 @@ -33,6 +32,7 @@ import Ledger.Value as Value import Prelude (Semigroup (..), (<$>)) import Week06.Oracle.Core +import Week06.Oracle.Funds {-# INLINABLE price #-} price :: Integer -> Integer -> Integer @@ -153,14 +153,6 @@ retrieveSwaps oracle = do awaitTxConfirmed $ txId ledgerTx logInfo @String $ "retrieved " ++ show (length xs) ++ " swap(s)" -ownFunds :: HasBlockchainActions s => Contract w s Text Value -ownFunds = do - pk <- ownPubKey - utxos <- utxoAt $ pubKeyAddress pk - let v = mconcat $ Map.elems $ txOutValue . txOutTxOut <$> utxos - logInfo @String $ "own funds: " ++ show (Value.flattenValue v) - return v - useSwap :: forall w s. HasBlockchainActions s => Oracle -> Contract w s Text () useSwap oracle = do funds <- ownFunds @@ -204,31 +196,24 @@ type SwapSchema = .\/ Endpoint "offer" Integer .\/ Endpoint "retrieve" () .\/ Endpoint "use" () - .\/ Endpoint "funds" () -swap :: Oracle -> Contract (Last Value) SwapSchema Text () -swap oracle = (offer `select` retrieve `select` use `select` funds) >> swap oracle +swap :: Oracle -> Contract () SwapSchema Text () +swap oracle = (offer `select` retrieve `select` use) >> swap oracle where - offer :: Contract (Last Value) SwapSchema Text () + offer :: Contract () SwapSchema Text () offer = h $ do amt <- endpoint @"offer" offerSwap oracle amt - retrieve :: Contract (Last Value) SwapSchema Text () + retrieve :: Contract () SwapSchema Text () retrieve = h $ do endpoint @"retrieve" retrieveSwaps oracle - use :: Contract (Last Value) SwapSchema Text () + use :: Contract () SwapSchema Text () use = h $ do endpoint @"use" useSwap oracle - 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 :: Contract () SwapSchema Text () -> Contract () SwapSchema Text () h = handleError logError diff --git a/code/week06/src/Week06/Oracle/Test.hs b/code/week06/src/Week06/Oracle/Test.hs index f27f07c..dfb1a65 100644 --- a/code/week06/src/Week06/Oracle/Test.hs +++ b/code/week06/src/Week06/Oracle/Test.hs @@ -30,6 +30,7 @@ import Prelude (Semigroup(..)) import Wallet.Emulator.Wallet import Week06.Oracle.Core +import Week06.Oracle.Funds import Week06.Oracle.Swap assetSymbol :: CurrencySymbol @@ -73,6 +74,10 @@ myTrace = do callEndpoint @"update" h1 1_500_000 void $ Emulator.waitNSlots 3 + void $ activateContractWallet (Wallet 3) ownFunds' + void $ activateContractWallet (Wallet 4) ownFunds' + void $ activateContractWallet (Wallet 5) ownFunds' + h3 <- activateContractWallet (Wallet 3) $ swap oracle h4 <- activateContractWallet (Wallet 4) $ swap oracle h5 <- activateContractWallet (Wallet 5) $ swap oracle @@ -96,10 +101,6 @@ myTrace = do callEndpoint @"retrieve" h3 () callEndpoint @"retrieve" h4 () void $ Emulator.waitNSlots 3 - - callEndpoint @"funds" h3 () - callEndpoint @"funds" h4 () - callEndpoint @"funds" h5 () where getOracle :: ContractHandle (Last Oracle) OracleSchema Text -> EmulatorTrace Oracle getOracle h = do