refactored funds

This commit is contained in:
Lars Brünjes 2021-05-10 15:37:14 +02:00
parent 2643aa2cb2
commit 395ebef4a8
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
6 changed files with 57 additions and 27 deletions

View file

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

View file

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

View file

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

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

View file

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

View file

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