added asset to Oracle

code/week06/plutus-pioneer-program-week06.cabal

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

code/week06/src/Week06/Oracle/Core.hs

@@ -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
+data OracleParams = OracleParams
-startOracle fees = do
+    { 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 :: OracleParams -> Contract (Last Oracle) OracleSchema Text ()
-runOracle fees = do
+runOracle op = do
-    oracle <- startOracle fees
+    oracle <- startOracle op
     tell $ Last $ Just oracle
     go oracle
   where

code/week06/src/Week06/Oracle/Test.hs

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

code/week06/src/Week06/Oracle/User.hs

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