claudiomaradonna/plutus-pioneer-program
1
0
Fork 0
mirror of https://github.com/FiloSpaTeam/plutus-pioneer-program.git synced 2024-11-22 06:42:00 +01:00
Code Issues Projects Releases Packages Wiki Activity

swap contract with tests

Browse source
This commit is contained in:
Lars Brünjes 2021-05-09 22:21:34 +02:00
parent bb2e6ee45b
commit e5fa37a0b5
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
4 changed files with 125 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
code/week06/plutus-pioneer-program-week06.cabal
View file

@ -17,6 +17,7 @@ library
build-depends: aeson
, base ^>=4.14.1.0
, containers
, data-default
, freer-extras
, playground-common
, plutus-contract

7
code/week06/src/Week06/Oracle/Core.hs
View file

@ -38,7 +38,6 @@ import PlutusTx.Prelude hiding (Semigroup(..), unless)
import Ledger hiding (singleton)
import Ledger.Constraints as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import Ledger.Ada as Ada
import Ledger.Value as Value
import Plutus.Contracts.Currency as Currency
import Prelude (Semigroup (..))
@ -46,7 +45,7 @@ import Prelude (Semigroup (..))
data Oracle = Oracle
{ oSymbol :: !CurrencySymbol
, oOperator :: !PubKeyHash
, oFee :: !Value
, oFee :: !Integer
, oAsset :: !AssetClass
} deriving (Show, Generic, FromJSON, ToJSON)
@ -74,7 +73,7 @@ oracleValue o f = do
{-# INLINABLE mkOracleValidator #-}
mkOracleValidator :: Oracle -> Integer -> OracleRedeemer -> ScriptContext -> Bool
mkOracleValidator _ _ Use _ = False
mkOracleValidator _ _ Use _ = True
mkOracleValidator oracle _ Update ctx =
traceIfFalse "operator signature missing" (txSignedBy info $ oOperator oracle) &&
traceIfFalse "token missing from input" inputHasToken &&
@ -134,7 +133,7 @@ startOracle op = do
oracle = Oracle
{ oSymbol = cs
, oOperator = pkh
, oFee = Ada.lovelaceValueOf $ opFees op
, oFee = opFees op
, oAsset = AssetClass (opSymbol op, opToken op)
}
logInfo @String $ "forged oracle state token for oracle " ++ show oracle

70
code/week06/src/Week06/Oracle/Swap.hs
View file

@ -14,27 +14,35 @@
module Week06.Oracle.Swap
( offerSwap
, retrieveSwaps
, useSwap
) where
import Control.Monad hiding (fmap)
import Data.Aeson (FromJSON, ToJSON)
import Data.List (find)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import Data.Monoid (Last (..))
import Data.Text (Text, pack)
import GHC.Generics (Generic)
import Data.Text (Text)
import Plutus.Contract as Contract hiding (when)
import qualified PlutusTx
import PlutusTx.Prelude hiding (Semigroup(..), unless, mapMaybe)
import PlutusTx.Prelude hiding (Semigroup(..), (<$>), unless, mapMaybe, find)
import Ledger hiding (singleton)
import Ledger.Constraints as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import Ledger.Ada as Ada
import Ledger.Ada as Ada hiding (divide)
import Ledger.Value as Value
import Prelude (Semigroup (..))
import Prelude (Semigroup (..), (<$>))
import Week06.Oracle.Core
{-# INLINABLE price #-}
price :: Integer -> Integer -> Integer
price lovelace exchangeRate = (lovelace * exchangeRate) `divide` 1000000
{-# INLINABLE lovelaces #-}
lovelaces :: Value -> Integer
lovelaces = Ada.getLovelace . Ada.fromValue
{-# INLINABLE mkSwapValidator #-}
mkSwapValidator :: Oracle -> Address -> PubKeyHash -> () -> ScriptContext -> Bool
mkSwapValidator oracle addr pkh () ctx =
@ -75,9 +83,9 @@ mkSwapValidator oracle addr pkh () ctx =
let
lovelaceIn = case findOwnInput ctx of
Nothing -> traceError "own input not found"
Just i -> Ada.getLovelace $ Ada.fromValue $ txOutValue $ txInInfoResolved i
Just i -> lovelaces $ txOutValue $ txInInfoResolved i
in
lovelaceIn * oracleValue'
price lovelaceIn oracleValue'
sellerPaid :: Bool
sellerPaid =
@ -145,3 +153,49 @@ retrieveSwaps oracle = do
ledgerTx <- submitTxConstraintsWith @Swapping lookups tx
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
let amt = assetClassValueOf funds $ oAsset oracle
logInfo @String $ "available assets: " ++ show amt
m <- findOracle oracle
case m of
Nothing -> logInfo @String "oracle not found"
Just (oref, o, x) -> do
logInfo @String $ "found oracle, exchange rate " ++ show x
pkh <- pubKeyHash <$> Contract.ownPubKey
swaps <- findSwaps oracle (/= pkh)
case find (f amt x) swaps of
Nothing -> logInfo @String "no suitable swap found"
Just (oref', o', pkh') -> do
let v = txOutValue (txOutTxOut o) <> lovelaceValueOf (oFee oracle)
p = assetClassValue (oAsset oracle) $ price (lovelaces $ txOutValue $ txOutTxOut o') x
lookups = Constraints.otherScript (swapValidator oracle) <>
Constraints.otherScript (oracleValidator oracle) <>
Constraints.unspentOutputs (Map.fromList [(oref, o), (oref', o')])
tx = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData Use) <>
Constraints.mustSpendScriptOutput oref' (Redeemer $ PlutusTx.toData ()) <>
Constraints.mustPayToOtherScript
(validatorHash $ oracleValidator oracle)
(Datum $ PlutusTx.toData x)
v <>
Constraints.mustPayToPubKey pkh' p
ledgerTx <- submitTxConstraintsWith @Swapping lookups tx
awaitTxConfirmed $ txId ledgerTx
logInfo @String $ "made swap with price " ++ show (Value.flattenValue p)
where
getPrice :: Integer -> TxOutTx -> Integer
getPrice x o = price (lovelaces $ txOutValue $ txOutTxOut o) x
f :: Integer -> Integer -> (TxOutRef, TxOutTx, PubKeyHash) -> Bool
f amt x (_, o, _) = getPrice x o <= amt

64
code/week06/src/Week06/Oracle/Test.hs
View file

@ -4,6 +4,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
@ -15,18 +16,37 @@ module Week06.Oracle.Test where
import Control.Monad hiding (fmap)
import Control.Monad.Freer.Extras as Extras
import Data.Default (Default (..))
import qualified Data.Map as Map
import Data.Monoid (Last (..))
import Data.Text (Text)
import Ledger
import Ledger.Value as Value
import Ledger.Ada as Ada
import Plutus.Contract as Contract hiding (when)
import Plutus.Trace.Emulator as Emulator
import PlutusTx.Prelude hiding (Semigroup(..), unless)
import Prelude (Semigroup(..))
import Wallet.Emulator.Wallet
import Week06.Oracle.Core
import Week06.Oracle.Swap
assetSymbol :: CurrencySymbol
assetSymbol = "ff"
assetToken :: TokenName
assetToken = "USDT"
test :: IO ()
test = runEmulatorTraceIO myTrace
test = runEmulatorTraceIO' def emCfg myTrace
where
emCfg :: EmulatorConfig
emCfg = EmulatorConfig $ Left $ Map.fromList [(Wallet i, v) | i <- [1 .. 10]]
v :: Value
v = Ada.lovelaceValueOf 100_000_000 <>
Value.singleton assetSymbol assetToken 100_000_000
checkOracle :: Oracle -> Contract () BlockchainActions Text a
checkOracle oracle = do
@ -39,25 +59,39 @@ checkOracle oracle = do
myTrace :: EmulatorTrace ()
myTrace = do
let op = OracleParams
{ opFees = 1000000
, opSymbol = "ff"
, opToken = "USDT"
{ opFees = 1_000_000
, opSymbol = assetSymbol
, opToken = assetToken
}
h <- activateContractWallet (Wallet 1) $ runOracle op
void $ Emulator.waitNSlots 1
oracle <- getOracle h
void $ activateContractWallet (Wallet 2) $ checkOracle oracle
callEndpoint @"update" h 42
void $ Emulator.waitNSlots 3
callEndpoint @"update" h 666
void $ Emulator.waitNSlots 10
void $ activateContractWallet (Wallet 2) (offerSwap oracle 12000000 :: Contract () BlockchainActions Text ())
void $ Emulator.waitNSlots 10
void $ activateContractWallet (Wallet 2) (offerSwap oracle 18000000 :: Contract () BlockchainActions Text ())
void $ Emulator.waitNSlots 10
void $ activateContractWallet (Wallet 2) (retrieveSwaps oracle :: Contract () BlockchainActions Text ())
void $ Emulator.waitNSlots 10
void $ activateContractWallet (Wallet 2) $ checkOracle oracle
callEndpoint @"update" h 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 ())
void $ Emulator.waitNSlots 3
void $ activateContractWallet (Wallet 5) (useSwap oracle :: Contract () BlockchainActions Text ())
void $ Emulator.waitNSlots 3
callEndpoint @"update" h 1_700_000
void $ Emulator.waitNSlots 3
void $ activateContractWallet (Wallet 5) (useSwap oracle :: Contract () BlockchainActions Text ())
void $ Emulator.waitNSlots 3
callEndpoint @"update" h 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 ())
void $ Emulator.waitNSlots 3
where
getOracle :: ContractHandle (Last Oracle) OracleSchema Text -> EmulatorTrace Oracle