mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-21 22:32:00 +01:00
added asset to Oracle
This commit is contained in:
Lars Brünjes
parent
99c82929d6
commit
127a1432c2
4 changed files with 196 additions and 7 deletions
|
|
@ -13,6 +13,7 @@ library
|
|||
exposed-modules: Week06.Oracle.Core
|
||||
Week06.Oracle.Playground
|
||||
Week06.Oracle.Test
|
||||
Week06.Oracle.User
|
||||
build-depends: aeson
|
||||
, base ^>=4.14.1.0
|
||||
, containers
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@ module Week06.Oracle.Core
|
|||
, oracleValidator
|
||||
, oracleAddress
|
||||
, OracleSchema
|
||||
, OracleParams (..)
|
||||
, runOracle
|
||||
, findOracle
|
||||
) where
|
||||
|
|
@ -45,6 +46,7 @@ data Oracle = Oracle
|
|||
{ oSymbol :: !CurrencySymbol
|
||||
, oOperator :: !PubKeyHash
|
||||
, oFee :: !Value
|
||||
, oAsset :: !AssetClass
|
||||
} deriving (Show, Generic, FromJSON, ToJSON)
|
||||
|
||||
PlutusTx.makeLift ''Oracle
|
||||
|
|
@ -114,15 +116,22 @@ oracleValidator = Scripts.validatorScript . oracleInst
|
|||
oracleAddress :: Oracle -> Ledger.Address
|
||||
oracleAddress = scriptAddress . oracleValidator
|
||||
|
||||
startOracle :: forall w s. HasBlockchainActions s => Integer -> Contract w s Text Oracle
|
||||
startOracle fees = do
|
||||
data OracleParams = OracleParams
|
||||
{ opFees :: !Integer
|
||||
, opSymbol :: !CurrencySymbol
|
||||
, opToken :: !TokenName
|
||||
} deriving (Show, Generic, FromJSON, ToJSON)
|
||||
|
||||
startOracle :: forall w s. HasBlockchainActions s => OracleParams -> Contract w s Text Oracle
|
||||
startOracle op = do
|
||||
pkh <- pubKeyHash <$> Contract.ownPubKey
|
||||
osc <- mapError (pack . show) (forgeContract pkh [(oracleTokenName, 1)] :: Contract w s CurrencyError OneShotCurrency)
|
||||
let cs = Currency.currencySymbol osc
|
||||
oracle = Oracle
|
||||
{ oSymbol = cs
|
||||
, oOperator = pkh
|
||||
, oFee = Ada.lovelaceValueOf fees
|
||||
, oFee = Ada.lovelaceValueOf $ opFees op
|
||||
, oAsset = AssetClass (opSymbol op, opToken op)
|
||||
}
|
||||
logInfo @String $ "forged oracle state token for oracle " ++ show oracle
|
||||
return oracle
|
||||
|
|
@ -161,9 +170,9 @@ findOracle oracle = do
|
|||
|
||||
type OracleSchema = BlockchainActions .\/ Endpoint "update" Integer
|
||||
|
||||
runOracle :: Integer -> Contract (Last Oracle) OracleSchema Text ()
|
||||
runOracle fees = do
|
||||
oracle <- startOracle fees
|
||||
runOracle :: OracleParams -> Contract (Last Oracle) OracleSchema Text ()
|
||||
runOracle op = do
|
||||
oracle <- startOracle op
|
||||
tell $ Last $ Just oracle
|
||||
go oracle
|
||||
where
|
||||
|
|
|
|||
|
|
@ -37,7 +37,12 @@ checkOracle oracle = do
|
|||
|
||||
myTrace :: EmulatorTrace ()
|
||||
myTrace = do
|
||||
h <- activateContractWallet (Wallet 1) $ runOracle 1000000
|
||||
let op = OracleParams
|
||||
{ opFees = 1000000
|
||||
, opSymbol = "ff"
|
||||
, opToken = "USDT"
|
||||
}
|
||||
h <- activateContractWallet (Wallet 1) $ runOracle op
|
||||
void $ Emulator.waitNSlots 1
|
||||
oracle <- getOracle h
|
||||
void $ activateContractWallet (Wallet 2) $ checkOracle oracle
|
||||
|
|
|
|||
174
code/week06/src/Week06/Oracle/User.hs
Normal file
174
code/week06/src/Week06/Oracle/User.hs
Normal file
|
|
@ -0,0 +1,174 @@
|
|||
{-# 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.User
|
||||
( Oracle (..)
|
||||
, OracleRedeemer (..)
|
||||
, oracleTokenName
|
||||
, oracleAsset
|
||||
, oracleInst
|
||||
, oracleValidator
|
||||
, oracleAddress
|
||||
, OracleSchema
|
||||
, runOracle
|
||||
, findOracle
|
||||
) where
|
||||
|
||||
import Control.Monad hiding (fmap)
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Monoid (Last (..))
|
||||
import Data.Text (Text, pack)
|
||||
import GHC.Generics (Generic)
|
||||
import Plutus.Contract as Contract hiding (when)
|
||||
import qualified PlutusTx
|
||||
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 (..))
|
||||
|
||||
data Oracle = Oracle
|
||||
{ oSymbol :: !CurrencySymbol
|
||||
, oOperator :: !PubKeyHash
|
||||
, oFee :: !Value
|
||||
} deriving (Show, Generic, FromJSON, ToJSON)
|
||||
|
||||
PlutusTx.makeLift ''Oracle
|
||||
|
||||
data OracleRedeemer = Update | Use
|
||||
deriving Show
|
||||
|
||||
PlutusTx.unstableMakeIsData ''OracleRedeemer
|
||||
|
||||
{-# INLINABLE oracleTokenName #-}
|
||||
oracleTokenName :: TokenName
|
||||
oracleTokenName = TokenName emptyByteString
|
||||
|
||||
{-# INLINABLE oracleAsset #-}
|
||||
oracleAsset :: Oracle -> AssetClass
|
||||
oracleAsset oracle = AssetClass (oSymbol oracle, oracleTokenName)
|
||||
|
||||
{-# INLINABLE mkOracleValidator #-}
|
||||
mkOracleValidator :: Oracle -> Integer -> OracleRedeemer -> ScriptContext -> Bool
|
||||
mkOracleValidator _ _ Use _ = False
|
||||
mkOracleValidator oracle _ Update ctx =
|
||||
traceIfFalse "operator signature missing" (txSignedBy info $ oOperator oracle) &&
|
||||
traceIfFalse "token missing from input" inputHasToken &&
|
||||
traceIfFalse "token missing from output" outputHasToken &&
|
||||
traceIfFalse "invalid output datum" validOutputDatum
|
||||
where
|
||||
info :: TxInfo
|
||||
info = scriptContextTxInfo ctx
|
||||
|
||||
inputHasToken :: Bool
|
||||
inputHasToken = case findOwnInput ctx of
|
||||
Nothing -> False
|
||||
Just i -> assetClassValueOf (txOutValue $ txInInfoResolved i) (oracleAsset oracle) == 1
|
||||
|
||||
ownOutput :: TxOut
|
||||
ownOutput = case getContinuingOutputs ctx of
|
||||
[o] -> o
|
||||
_ -> traceError "expected exactly one oracle output"
|
||||
|
||||
outputHasToken :: Bool
|
||||
outputHasToken = assetClassValueOf (txOutValue ownOutput) (oracleAsset oracle) == 1
|
||||
|
||||
validOutputDatum :: Bool
|
||||
validOutputDatum = case txOutDatum ownOutput of
|
||||
Nothing -> False
|
||||
Just dh -> case findDatum dh info of
|
||||
Nothing -> False
|
||||
Just (Datum d) -> case PlutusTx.fromData d of
|
||||
Nothing -> False
|
||||
Just (_ :: Integer) -> True
|
||||
|
||||
data Oracling
|
||||
instance Scripts.ScriptType Oracling where
|
||||
type instance DatumType Oracling = Integer
|
||||
type instance RedeemerType Oracling = OracleRedeemer
|
||||
|
||||
oracleInst :: Oracle -> Scripts.ScriptInstance Oracling
|
||||
oracleInst oracle = Scripts.validator @Oracling
|
||||
($$(PlutusTx.compile [|| mkOracleValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle)
|
||||
$$(PlutusTx.compile [|| wrap ||])
|
||||
where
|
||||
wrap = Scripts.wrapValidator @Integer @OracleRedeemer
|
||||
|
||||
oracleValidator :: Oracle -> Validator
|
||||
oracleValidator = Scripts.validatorScript . oracleInst
|
||||
|
||||
oracleAddress :: Oracle -> Ledger.Address
|
||||
oracleAddress = scriptAddress . oracleValidator
|
||||
|
||||
startOracle :: forall w s. HasBlockchainActions s => Integer -> Contract w s Text Oracle
|
||||
startOracle fees = do
|
||||
pkh <- pubKeyHash <$> Contract.ownPubKey
|
||||
osc <- mapError (pack . show) (forgeContract pkh [(oracleTokenName, 1)] :: Contract w s CurrencyError OneShotCurrency)
|
||||
let cs = Currency.currencySymbol osc
|
||||
oracle = Oracle
|
||||
{ oSymbol = cs
|
||||
, oOperator = pkh
|
||||
, oFee = Ada.lovelaceValueOf fees
|
||||
}
|
||||
logInfo @String $ "forged oracle state token for oracle " ++ show oracle
|
||||
return oracle
|
||||
|
||||
updateOracle :: forall w s. HasBlockchainActions s => Oracle -> Integer -> Contract w s Text ()
|
||||
updateOracle oracle x = do
|
||||
m <- findOracle oracle
|
||||
let c = Constraints.mustPayToTheScript x $ assetClassValue (oracleAsset oracle) 1
|
||||
case m of
|
||||
Nothing -> do
|
||||
ledgerTx <- submitTxConstraints (oracleInst oracle) c
|
||||
awaitTxConfirmed $ txId ledgerTx
|
||||
logInfo @String $ "set initial oracle value to " ++ show x
|
||||
Just (oref, o, _) -> do
|
||||
let lookups = Constraints.unspentOutputs (Map.singleton oref o) <>
|
||||
Constraints.scriptInstanceLookups (oracleInst oracle) <>
|
||||
Constraints.otherScript (oracleValidator oracle)
|
||||
tx = c <> Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData Update)
|
||||
ledgerTx <- submitTxConstraintsWith @Oracling lookups tx
|
||||
awaitTxConfirmed $ txId ledgerTx
|
||||
logInfo @String $ "updated oracle value to " ++ show x
|
||||
|
||||
findOracle :: forall w s. HasBlockchainActions s => Oracle -> Contract w s Text (Maybe (TxOutRef, TxOutTx, Integer))
|
||||
findOracle oracle = do
|
||||
utxos <- Map.filter f <$> utxoAt (oracleAddress oracle)
|
||||
return $ case Map.toList utxos of
|
||||
[(oref, o)] -> do
|
||||
dh <- txOutDatumHash $ txOutTxOut o
|
||||
(Datum d) <- Map.lookup dh $ txData $ txOutTxTx o
|
||||
x <- PlutusTx.fromData d
|
||||
return (oref, o, x)
|
||||
_ -> Nothing
|
||||
where
|
||||
f :: TxOutTx -> Bool
|
||||
f o = assetClassValueOf (txOutValue $ txOutTxOut o) (oracleAsset oracle) == 1
|
||||
|
||||
type OracleSchema = BlockchainActions .\/ Endpoint "update" Integer
|
||||
|
||||
runOracle :: Integer -> Contract (Last Oracle) OracleSchema Text ()
|
||||
runOracle fees = do
|
||||
oracle <- startOracle fees
|
||||
tell $ Last $ Just oracle
|
||||
go oracle
|
||||
where
|
||||
go :: Oracle -> Contract (Last Oracle) OracleSchema Text a
|
||||
go oracle = do
|
||||
x <- endpoint @"update"
|
||||
updateOracle oracle x
|
||||
go oracle
|
||||
Loading…
Reference in a new issue