Permalink
Browse files

Add a reference to currently validating TxIn in PendingTx.

  • Loading branch information...
nau committed Jan 11, 2019
1 parent 8ab5550 commit 30652b169d10980d6b11dbe7d28cbeff71beb847
@@ -55,9 +55,9 @@ contributionScript cmp = ValidatorScript val where
--
-- 3. A 'PubKey'. This is the data script. It is provided by the producing transaction (the contribution)
--
-- 4. A 'PendingTx' value. It contains information about the current transaction and is provided by the slot leader.
-- 4. A 'PendingTx value. It contains information about the current transaction and is provided by the slot leader.
-- See note [PendingTx]
\Campaign{..} (act :: CampaignAction) (con :: PubKey) (p :: PendingTx') ->
\Campaign{..} (act :: CampaignAction) (con :: PubKey) (p :: PendingTx) ->
let

-- In Haskell we can define new operators. We import
@@ -1,8 +1,8 @@
-- | A game with two players. Player 1 thinks of a secret word
-- and uses its hash, and the game validator script, to lock
-- some funds (the prize) in a pay-to-script transaction output.
-- Player 2 guesses the word by attempting to spend the transaction
-- output. If the guess is correct, the validator script releases the funds.
-- Player 2 guesses the word by attempting to spend the transaction
-- output. If the guess is correct, the validator script releases the funds.
-- If it isn't, the funds stay locked.
module Language.PlutusTx.Coordination.Contracts.Game where

@@ -22,7 +22,7 @@ PlutusTx.makeLift ''HashedString
-- create a data script for the guessing game by hashing the string
-- and lifting the hash to its on-chain representation
mkDataScript :: String -> DataScript
mkDataScript word =
mkDataScript word =
let hashedWord = plcSHA2_256 (C.pack word)
in DataScript (Ledger.lifted (HashedString hashedWord))

@@ -33,18 +33,18 @@ PlutusTx.makeLift ''ClearString
-- create a redeemer script for the guessing game by lifting the
-- string to its on-chain representation
mkRedeemerScript :: String -> RedeemerScript
mkRedeemerScript word =
mkRedeemerScript word =
let clearWord = C.pack word
in RedeemerScript (Ledger.lifted (ClearString clearWord))

-- | The validator script of the game.
-- | The validator script of the game.
gameValidator :: ValidatorScript
gameValidator = ValidatorScript (Ledger.fromCompiledCode $$(PlutusTx.compile [||
-- The code between the '[||' and '||]' quotes is on-chain code.
\(ClearString guess) (HashedString actual) (p :: PendingTx') ->
\(ClearString guess) (HashedString actual) (p :: PendingTx) ->

-- inside the on-chain code we can write $$(P.xxx) to use functions
-- from the PlutusTx Prelude (imported qualified at the top of the
-- from the PlutusTx Prelude (imported qualified at the top of the
-- module)
if $$(P.equalsByteString) actual ($$(P.sha2_256) guess)
then ()
@@ -58,8 +58,8 @@ gameAddress = Ledger.scriptAddress gameValidator

-- | The "lock" contract endpoint. See note [Contract endpoints]
lock :: String -> Value -> MockWallet ()
lock word value =
-- 'payToScript_' is a function of the wallet API. It takes a script
lock word value =
-- 'payToScript_' is a function of the wallet API. It takes a script
-- address, a value and a data script, and submits a transaction that
-- pays the value to the address, using the data script.
--
@@ -70,24 +70,24 @@ lock word value =

-- | The "guess" contract endpoint. See note [Contract endpoints]
guess :: String -> MockWallet ()
guess word =
-- 'collectFromScript' is a function of the wallet API. It consumes the
-- unspent transaction outputs at a script address and pays them to a
-- public key address owned by this wallet. It takes the validator script
guess word =
-- 'collectFromScript' is a function of the wallet API. It consumes the
-- unspent transaction outputs at a script address and pays them to a
-- public key address owned by this wallet. It takes the validator script
-- and the redeemer scripts as arguments.
--
-- Note that before we can use 'collectFromScript', we need to tell the
-- wallet to start watching the address for transaction outputs (because
-- Note that before we can use 'collectFromScript', we need to tell the
-- wallet to start watching the address for transaction outputs (because
-- the wallet does not keep track of the UTXO set of the entire chain).
collectFromScript gameValidator (mkRedeemerScript word)

-- | The "startGame" contract endpoint, telling the wallet to start watching
-- | The "startGame" contract endpoint, telling the wallet to start watching
-- the address of the game script. See note [Contract endpoints]
startGame :: MockWallet ()
startGame =
-- 'startWatching' is a function of the wallet API. It instructs the wallet
-- to keep track of all outputs at the address. Player 2 needs to call
-- 'startGame' before Player 1 uses the 'lock' endpoint, to ensure that
startGame =
-- 'startWatching' is a function of the wallet API. It instructs the wallet
-- to keep track of all outputs at the address. Player 2 needs to call
-- 'startGame' before Player 1 uses the 'lock' endpoint, to ensure that
-- Player 2's wallet is aware of the game address.
startWatching gameAddress

@@ -97,26 +97,26 @@ $(mkFunction 'startGame)

{- Note [Contract endpoints]
A contract endpoint is a function that uses the wallet API to interact with the
A contract endpoint is a function that uses the wallet API to interact with the
blockchain. We can look at contract endpoints from two different points of view.
1. Contract users
Contract endpoints are the visible interface of the contract. They provide a
UI (HTML form) for entering the parameters of the actions we may take as part
Contract endpoints are the visible interface of the contract. They provide a
UI (HTML form) for entering the parameters of the actions we may take as part
of the contract.
2. Contract authors
As contract authors we define endpoints as functions that return a value of
type 'MockWallet ()'. This type indicates that the function uses the wallet API
to produce and spend transaction outputs on the blockchain.
As contract authors we define endpoints as functions that return a value of
type 'MockWallet ()'. This type indicates that the function uses the wallet API
to produce and spend transaction outputs on the blockchain.
Endpoints can have any number of parameters: 'lock' has two
parameters, 'guess' has one and 'startGame' has none. For each endpoint we
include a call to 'mkFunction' at the end of the contract definition. This
causes the Haskell compiler to generate a schema for the endpoint. The Plutus
Playground then uses this schema to present an HTML form to the user where the
Endpoints can have any number of parameters: 'lock' has two
parameters, 'guess' has one and 'startGame' has none. For each endpoint we
include a call to 'mkFunction' at the end of the contract definition. This
causes the Haskell compiler to generate a schema for the endpoint. The Plutus
Playground then uses this schema to present an HTML form to the user where the
parameters can be entered.
-}
@@ -85,7 +85,7 @@ validatorScriptHash =
validatorScript :: Vesting -> ValidatorScript
validatorScript v = ValidatorScript val where
val = Ledger.applyScript inner (Ledger.lifted v)
inner = Ledger.fromCompiledCode $$(PlutusTx.compile [|| \Vesting{..} () VestingData{..} (p :: PendingTx') ->
inner = Ledger.fromCompiledCode $$(PlutusTx.compile [|| \Vesting{..} () VestingData{..} (p :: PendingTx) ->
let

eqPk :: PubKey -> PubKey -> Bool
@@ -36,7 +36,7 @@ import qualified Language.PlutusTx as PlutusTx
import Ledger (DataScript (..), Signature(..), PubKey (..),
TxId', ValidatorScript (..), Value (..), scriptTxIn, Slot(..))
import qualified Ledger as Ledger
import Ledger.Validation (PendingTx (..), PendingTxIn (..), PendingTxOut, ValidatorHash)
import Ledger.Validation (PendingTx (..), PendingTxIn (..), PendingTxOut)
import qualified Ledger.Validation as Validation
import Wallet (EventHandler (..), EventTrigger, Range (..), WalletAPI (..),
WalletDiagnostics (..), andT, slotRangeT, fundsAtAddressT, throwOtherError,
@@ -124,7 +124,7 @@ contributionScript cmp = ValidatorScript val where

-- See note [Contracts and Validator Scripts] in
-- Language.Plutus.Coordination.Contracts
inner = Ledger.fromCompiledCode $$(PlutusTx.compile [|| (\Campaign{..} (act :: CampaignAction) (a :: CampaignActor) (p :: PendingTx ValidatorHash) ->
inner = Ledger.fromCompiledCode $$(PlutusTx.compile [|| (\Campaign{..} (act :: CampaignAction) (a :: CampaignActor) (p :: PendingTx) ->
let

infixr 3 &&
@@ -31,8 +31,8 @@ import GHC.Generics (Generic)
import qualified Language.PlutusTx as PlutusTx
import Ledger (DataScript (..), Slot(..), PubKey, TxOutRef', Value (..), ValidatorScript (..), scriptTxIn, scriptTxOut)
import qualified Ledger as Ledger
import Ledger.Validation (OracleValue (..), PendingTx (..), PendingTxOut (..),
PendingTxOutType (..), ValidatorHash)
import Ledger.Validation (OracleValue (..), PendingTx (..), PendingTxIn(..), PendingTxOut (..),
PendingTxOutType (..))
import qualified Ledger.Validation as Validation
import Wallet (WalletAPI (..), WalletAPIError, throwOtherError, pubKey, createTxAndSubmit)

@@ -194,10 +194,13 @@ validatorScript :: Future -> ValidatorScript
validatorScript ft = ValidatorScript val where
val = Ledger.applyScript inner (Ledger.lifted ft)
inner = Ledger.fromCompiledCode $$(PlutusTx.compile [||
\Future{..} (r :: FutureRedeemer) FutureData{..} (p :: (PendingTx ValidatorHash)) ->
\Future{..} (r :: FutureRedeemer) FutureData{..} (p :: PendingTx) ->

let
PendingTx _ outs _ _ (Slot sl) ownHash = p
PendingTx _ outs _ _ (Slot sl) (PendingTxIn _ witness _) = p
ownHash = case witness of
Left (vhash, _) -> vhash
_ -> $$(PlutusTx.error) ()

eqPk :: PubKey -> PubKey -> Bool
eqPk = $$(Validation.eqPubKey)
@@ -26,7 +26,7 @@ PlutusTx.makeLift ''ClearString

gameValidator :: ValidatorScript
gameValidator = ValidatorScript (Ledger.fromCompiledCode $$(PlutusTx.compile [||
\(ClearString guess') (HashedString actual) (_ :: PendingTx ValidatorHash) ->
\(ClearString guess') (HashedString actual) (_ :: PendingTx) ->

if $$(P.equalsByteString) actual ($$(P.sha2_256) guess')
then ()
@@ -12,8 +12,7 @@ module Language.PlutusTx.Coordination.Contracts.Swap(
import qualified Language.PlutusTx as PlutusTx
import Ledger (Slot, PubKey, ValidatorScript (..), Value (..))
import qualified Ledger as Ledger
import Ledger.Validation (OracleValue (..), PendingTx (..), PendingTxIn (..), PendingTxOut (..),
ValidatorHash)
import Ledger.Validation (OracleValue (..), PendingTx (..), PendingTxIn (..), PendingTxOut (..))
import qualified Ledger.Validation as Validation

import Prelude (Bool (..), Eq (..), Int, Num (..), Ord (..))
@@ -58,7 +57,7 @@ type SwapOracle = OracleValue (Ratio Int)
-- Language.Plutus.Coordination.Contracts
swapValidator :: Swap -> ValidatorScript
swapValidator _ = ValidatorScript result where
result = Ledger.fromCompiledCode $$(PlutusTx.compile [|| (\(redeemer :: SwapOracle) SwapOwners{..} (p :: PendingTx ValidatorHash) Swap{..} ->
result = Ledger.fromCompiledCode $$(PlutusTx.compile [|| (\(redeemer :: SwapOracle) SwapOwners{..} (p :: PendingTx) Swap{..} ->
let
infixr 3 &&
(&&) :: Bool -> Bool -> Bool
@@ -106,7 +106,7 @@ validatorScriptHash =
validatorScript :: Vesting -> ValidatorScript
validatorScript v = ValidatorScript val where
val = Ledger.applyScript inner (Ledger.lifted v)
inner = Ledger.fromCompiledCode $$(PlutusTx.compile [|| \Vesting{..} () VestingData{..} (p :: PendingTx ValidatorHash) ->
inner = Ledger.fromCompiledCode $$(PlutusTx.compile [|| \Vesting{..} () VestingData{..} (p :: PendingTx) ->
let

eqBs :: ValidatorHash -> ValidatorHash -> Bool
@@ -135,7 +135,12 @@ lkpOutputs = traverse (\t -> traverse (lkpTxOut . txInRef) (t, t)) . Set.toList

-- | Matching pair of transaction input and transaction output.
data InOutMatch =
ScriptMatch Ledger.ValidatorScript Ledger.RedeemerScript DataScript (Ledger.Address (Digest SHA256))
ScriptMatch
TxIn'
Ledger.ValidatorScript
Ledger.RedeemerScript
DataScript
(Ledger.Address (Digest SHA256))
| PubKeyMatch PubKey Signature
deriving (Eq, Ord, Show)

@@ -144,7 +149,7 @@ data InOutMatch =
matchInputOutput :: ValidationMonad m => TxIn' -> TxOut' -> m InOutMatch
matchInputOutput i txo = case (txInType i, txOutType txo) of
(Ledger.ConsumeScriptAddress v r, Ledger.PayToScript d) ->
pure $ ScriptMatch v r d (txOutAddress txo)
pure $ ScriptMatch i v r d (txOutAddress txo)
(Ledger.ConsumePublicKeyAddress sig, Ledger.PayToPubKey pk) ->
pure $ PubKeyMatch pk sig
_ -> throwError $ InOutTypeMismatch i txo
@@ -154,20 +159,20 @@ matchInputOutput i txo = case (txInType i, txOutType txo) of
-- correct and script evaluation has to terminate successfully. If this is a
-- pay-to-pubkey output then the signature needs to match the public key that
-- locks it.
checkMatch :: ValidationMonad m => PendingTx () -> InOutMatch -> m ()
checkMatch :: ValidationMonad m => PendingTx -> InOutMatch -> m ()
checkMatch v = \case
ScriptMatch vl r d a
ScriptMatch txin vl r d a
| a /= Ledger.scriptAddress vl ->
throwError $ InvalidScriptHash d
| otherwise ->
| otherwise -> do
pTxIn <- mkIn txin
let v' = ValidationData
$ lifted
$ v { pendingTxOwnHash = Validation.plcValidatorDigest (Ledger.getAddress a) }
$ v { pendingTxIn = pTxIn }
(logOut, success) = Ledger.runScript v' vl r d
in
if success
then pure ()
else throwError $ ScriptFailure logOut
if success
then pure ()
else throwError $ ScriptFailure logOut
PubKeyMatch pk sig ->
if sig `Ledger.signedBy` pk
then pure ()
@@ -192,7 +197,7 @@ checkPositiveValues t =
else throwError $ NegativeValue t

-- | Encode the current transaction and slot in PLC.
validationData :: ValidationMonad m => Slot -> Tx -> m (PendingTx ())
validationData :: ValidationMonad m => Slot -> Tx -> m PendingTx
validationData h tx = rump <$> ins where
ins = traverse mkIn $ Set.toList $ txInputs tx

@@ -202,7 +207,8 @@ validationData h tx = rump <$> ins where
, pendingTxForge = txForge tx
, pendingTxFee = txFee tx
, pendingTxSlot = h
, pendingTxOwnHash = ()
, pendingTxIn = head inputs
-- this is changed accordingly in `checkMatch` during validation
}

mkOut :: TxOut' -> Validation.PendingTxOut
@@ -12,7 +12,6 @@ module Ledger.Validation
(
-- * Pending transactions and related types
PendingTx(..)
, PendingTx'
, PendingTxOut(..)
, PendingTxOutRef(..)
, PendingTxIn(..)
@@ -106,16 +105,15 @@ data PendingTxIn = PendingTxIn
} deriving (Generic)

-- | A pending transaction as seen by validator scripts.
data PendingTx a = PendingTx
data PendingTx = PendingTx
{ pendingTxInputs :: [PendingTxIn] -- ^ Transaction inputs
, pendingTxOutputs :: [PendingTxOut]
, pendingTxFee :: Value
, pendingTxForge :: Value
, pendingTxSlot :: Slot
, pendingTxOwnHash :: a -- ^ Hash of the validator script that is currently running
} deriving (Functor, Generic)

type PendingTx' = PendingTx ValidatorHash
, pendingTxIn :: PendingTxIn
-- ^ PendingTxIn being validated
} deriving (Generic)

{- Note [Oracles]
I'm not sure how oracles are going to work eventually, so I'm going to use this
@@ -228,9 +226,9 @@ plcDigest :: Digest SHA256 -> BSL.ByteString
plcDigest = serialise

-- | Check if a transaction was signed by a public key
txSignedBy :: Q (TExp (PendingTx ValidatorHash -> PubKey -> Bool))
txSignedBy :: Q (TExp (PendingTx -> PubKey -> Bool))
txSignedBy = [||
\(p :: PendingTx ValidatorHash) (PubKey k) ->
\(p :: PendingTx) (PubKey k) ->
let
PendingTx txins _ _ _ _ _ = p

@@ -74,10 +74,10 @@ PlutusTx.makeLift ''Contributor
Now that we know the types of data and redeemer scripts, we automatically know the signature of the validator script:

```haskell
type CampaignValidator = CampaignAction -> Contributor -> PendingTx' -> ()
type CampaignValidator = CampaignAction -> Contributor -> PendingTx -> ()
```

`CampaignValidator` is a function that takes three parameters -- `CampaignAction`, `Contributor`, and `PendingTx'` and produces a unit value `()` or fails with an error.
`CampaignValidator` is a function that takes three parameters -- `CampaignAction`, `Contributor`, and `PendingTx` and produces a unit value `()` or fails with an error.

If we want to implement `CampaignValidator` we need to know the parameters of the campaign, so that we can check if the selected `CampaignAction` is allowed. In Haskell we can do this by writing a function `mkValidator :: Campaign -> CampaignValidator` that takes a `Campaign` and produces a `CampaignValidator`. However, we can't implement `mkValidator` like this, because we need to wrap it in Template Haskell quotes so that it can be compiled to Plutus Core. We therefore define `mkValidator` in PlutusTx:

@@ -92,7 +92,7 @@ mkValidatorScript campaign = ValidatorScript val where
Anything between the `[||` and `||]` quotes is going to be _on-chain code_ and anything outside the quotes is _off-chain code_. We can now implement a lambda function that looks like `mkValidator`, starting with its parameters:

```haskell
\(c :: Campaign) (act :: CampaignAction) (con :: Contributor) (p :: PendingTx') ->
\(c :: Campaign) (act :: CampaignAction) (con :: Contributor) (p :: PendingTx) ->
```

Before we check whether `act` is permitted, we define a number of intermediate values that will make the checking code much more readable. These definitions are placed inside a `let` block, which is closed by a corresponding `in` below.
@@ -109,7 +109,7 @@ Before we check whether `act` is permitted, we define a number of intermediate v

There is no standard library of functions that are automatically in scope for on-chain code, so we need to import the ones that we want to use from the `Validation` module using the `\$\$()` splicing operator.

Next, we pattern match on the structure of the `PendingTx'` value `p` to get the Validation information we care about:
Next, we pattern match on the structure of the `PendingTx` value `p` to get the Validation information we care about:

```haskell
PendingTx ins outs _ _ (Slot currentSlot) _ = p

0 comments on commit 30652b1

Please sign in to comment.