started with oracle PAB

This commit is contained in:
Lars Brünjes 2021-05-10 11:11:08 +02:00
parent af90b54f0e
commit 2643aa2cb2
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
7 changed files with 164 additions and 21 deletions

79
code/week06/app/oracle.hs Normal file
View file

@ -0,0 +1,79 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Main
( main
) where
import Control.Monad (void)
import Control.Monad.Freer (Eff, Member, interpret, type (~>))
import Control.Monad.Freer.Error (Error)
import Control.Monad.Freer.Extras.Log (LogMsg)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Aeson (FromJSON, ToJSON)
import Data.Text.Prettyprint.Doc (Pretty (..), viaShow)
import GHC.Generics (Generic)
import Plutus.Contract (BlockchainActions, ContractError)
import Plutus.PAB.Effects.Contract (ContractEffect (..))
import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\), endpointsToSchemas, handleBuiltin)
import Plutus.PAB.Effects.ContractTest.Uniswap as US
import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg)
import Plutus.PAB.Simulator (SimulatorEffectHandlers)
import qualified Plutus.PAB.Simulator as Simulator
import Plutus.PAB.Types (PABError (..))
import qualified Plutus.PAB.Webserver.Server as PAB.Server
import Wallet.Emulator.Types (Wallet (..))
import qualified Week06.Oracle.Core as Oracle
import qualified Week06.Oracle.Swap as Oracle
main :: IO ()
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
void $ liftIO getLine
shutdown
data OracleContracts = Oracle | Swap Oracle.Oracle
deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
instance Pretty OracleContracts where
pretty = viaShow
oracleParams :: Oracle.OracleParams
oracleParams = Oracle.OracleParams
{ Oracle.opFees = 1_000_000
, Oracle.opSymbol = "ff"
, Oracle.opToken = "USDT"
}
handleOracleContracts ::
( Member (Error PABError) effs
, Member (LogMsg (PABMultiAgentMsg (Builtin OracleContracts))) effs
)
=> ContractEffect (Builtin OracleContracts)
~> Eff effs
handleOracleContracts = handleBuiltin getSchema getContract where
getSchema = \case
Oracle -> endpointsToSchemas @(Oracle.OracleSchema .\\ BlockchainActions)
Swap _ -> endpointsToSchemas @(Oracle.SwapSchema .\\ BlockchainActions)
getContract = \case
Oracle -> SomeBuiltin $ Oracle.runOracle oracleParams
Swap oracle -> SomeBuiltin $ Oracle.swap oracle
handlers :: SimulatorEffectHandlers (Builtin OracleContracts)
handlers =
Simulator.mkSimulatorHandlers @(Builtin OracleContracts) []
$ interpret handleOracleContracts

View file

@ -19,6 +19,7 @@ source-repository-package
plutus-contract
plutus-ledger
plutus-ledger-api
plutus-pab
plutus-tx
plutus-tx-plugin
plutus-use-cases
@ -32,6 +33,9 @@ source-repository-package
-- not on Hackage, and so need to be pulled in as `source-repository-package`s themselves. Make sure to
-- re-update this section from the template when you do an upgrade.
-- This is also needed so evenful-sql-common will build with a
-- newer version of persistent. See stack.yaml for the mirrored
-- configuration.
package eventful-sql-common
ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances
@ -48,6 +52,15 @@ allow-newer:
constraints:
-- aws-lambda-haskell-runtime-wai doesn't compile with newer versions
aws-lambda-haskell-runtime <= 3.0.3
-- big breaking change here, inline-r doens't have an upper bound
, singletons < 3.0
-- breaks eventful even more than it already was
, persistent-template < 2.12
-- See the note on nix/pkgs/default.nix:agdaPackages for why this is here.
-- (NOTE this will change to ieee754 in newer versions of nixpkgs).
extra-packages: ieee, filemanip
-- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year)
source-repository-package
@ -65,12 +78,6 @@ source-repository-package
location: https://github.com/input-output-hk/cardano-crypto.git
tag: f73079303f663e028288f9f4a9e08bcca39a923e
-- Needs a fix (https://github.com/wenkokke/unlit/pull/11) and a Hackage release
source-repository-package
type: git
location: https://github.com/michaelpj/unlit.git
tag: 9ca1112093c5ffd356fc99c7dafa080e686dd748
source-repository-package
type: git
location: https://github.com/input-output-hk/cardano-base

View file

@ -2,3 +2,5 @@ cradle:
cabal:
- path: "./src"
component: "lib:plutus-pioneer-program-week06"
- path: "./app/oracle.hs"
component: "exe:oracle"

View file

@ -29,3 +29,17 @@ library
, text
default-language: Haskell2010
ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise
executable oracle
main-is: oracle.hs
hs-source-dirs: app
ghc-options: -threaded
build-depends: aeson
, base ^>= 4.14.1.0
, freer-extras
, freer-simple
, plutus-contract
, plutus-ledger
, plutus-pab
, plutus-pioneer-program-week06
, prettyprinter

View file

@ -42,13 +42,14 @@ import Ledger.Value as Value
import Ledger.Ada as Ada
import Plutus.Contracts.Currency as Currency
import Prelude (Semigroup (..))
import qualified Prelude as Prelude
data Oracle = Oracle
{ oSymbol :: !CurrencySymbol
, oOperator :: !PubKeyHash
, oFee :: !Integer
, oAsset :: !AssetClass
} deriving (Show, Generic, FromJSON, ToJSON)
} deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord)
PlutusTx.makeLift ''Oracle

View file

@ -12,9 +12,8 @@
{-# LANGUAGE TypeOperators #-}
module Week06.Oracle.Swap
( offerSwap
, retrieveSwaps
, useSwap
( SwapSchema
, swap
) where
import Control.Monad hiding (fmap)
@ -199,3 +198,37 @@ useSwap oracle = do
f :: Integer -> Integer -> (TxOutRef, TxOutTx, PubKeyHash) -> Bool
f amt x (_, o, _) = getPrice x o <= amt
type SwapSchema =
BlockchainActions
.\/ 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
where
offer :: Contract (Last Value) SwapSchema Text ()
offer = h $ do
amt <- endpoint @"offer"
offerSwap oracle amt
retrieve :: Contract (Last Value) SwapSchema Text ()
retrieve = h $ do
endpoint @"retrieve"
retrieveSwaps oracle
use :: Contract (Last Value) 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 = handleError logError

View file

@ -64,35 +64,42 @@ myTrace = do
, opToken = assetToken
}
h <- activateContractWallet (Wallet 1) $ runOracle op
h1 <- activateContractWallet (Wallet 1) $ runOracle op
void $ Emulator.waitNSlots 1
oracle <- getOracle h
oracle <- getOracle h1
void $ activateContractWallet (Wallet 2) $ checkOracle oracle
callEndpoint @"update" h 1_500_000
callEndpoint @"update" h1 1_500_000
void $ Emulator.waitNSlots 3
void $ activateContractWallet (Wallet 3) (offerSwap oracle 10_000_000 :: Contract () BlockchainActions Text ())
void $ activateContractWallet (Wallet 4) (offerSwap oracle 20_000_000 :: Contract () BlockchainActions Text ())
h3 <- activateContractWallet (Wallet 3) $ swap oracle
h4 <- activateContractWallet (Wallet 4) $ swap oracle
h5 <- activateContractWallet (Wallet 5) $ swap oracle
callEndpoint @"offer" h3 10_000_000
callEndpoint @"offer" h4 20_000_000
void $ Emulator.waitNSlots 3
void $ activateContractWallet (Wallet 5) (useSwap oracle :: Contract () BlockchainActions Text ())
callEndpoint @"use" h5 ()
void $ Emulator.waitNSlots 3
callEndpoint @"update" h 1_700_000
callEndpoint @"update" h1 1_700_000
void $ Emulator.waitNSlots 3
void $ activateContractWallet (Wallet 5) (useSwap oracle :: Contract () BlockchainActions Text ())
callEndpoint @"use" h5 ()
void $ Emulator.waitNSlots 3
callEndpoint @"update" h 1_800_000
callEndpoint @"update" h1 1_800_000
void $ Emulator.waitNSlots 3
void $ activateContractWallet (Wallet 3) (retrieveSwaps oracle :: Contract () BlockchainActions Text ())
void $ activateContractWallet (Wallet 4) (retrieveSwaps oracle :: Contract () BlockchainActions Text ())
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