mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-22 06:42:00 +01:00
refactored funds
This commit is contained in:
parent
2643aa2cb2
commit
395ebef4a8
6 changed files with 57 additions and 27 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
41
code/week06/src/Week06/Oracle/Funds.hs
Normal file
41
code/week06/src/Week06/Oracle/Funds.hs
Normal file
|
@ -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'
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue