Permalink
Browse files

Merge pull request #469 from input-output-hk/anemish/fix-signatures-api

Remove [Signature] from UtxoIndex and PendingTx API.
  • Loading branch information...
j-mueller committed Jan 11, 2019
2 parents 940e72b + 0f47ba7 commit 8ab55503829af8098e407f49f82e58e978ef046a
@@ -2,7 +2,7 @@
-- This is the fully parallel version that collects all contributions
-- in a single transaction.
--
-- Note [Transactions in the crowdfunding campaign] explains the structure of
-- Note [Transactions in the crowdfunding campaign] explains the structure of
-- this contract on the blockchain.
module Language.PlutusTx.Coordination.Contracts.CrowdFunding where

@@ -22,17 +22,17 @@ data Campaign = Campaign
, campaignCollectionDeadline :: Slot
-- ^ The date by which the campaign owner has to collect the funds
, campaignOwner :: PubKey
-- ^ Public key of the campaign owner. This key is entitled to retrieve the
-- ^ Public key of the campaign owner. This key is entitled to retrieve the
-- funds if the campaign is successful.
} deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''Campaign

-- | Action that can be taken by the participants in this contract. A value of
-- `CampaignAction` is provided as the redeemer. The validator script then
-- checks if the conditions for performing this action are met.
--
data CampaignAction = Collect | Refund
-- `CampaignAction` is provided as the redeemer. The validator script then
-- checks if the conditions for performing this action are met.
--
data CampaignAction = Collect Signature | Refund Signature
deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''CampaignAction
@@ -43,7 +43,7 @@ PlutusTx.makeLift ''CampaignAction
contributionScript :: Campaign -> ValidatorScript
contributionScript cmp = ValidatorScript val where
val = Ledger.applyScript mkValidator (Ledger.lifted cmp)
mkValidator = Ledger.fromCompiledCode $$(PlutusTx.compile [||
mkValidator = Ledger.fromCompiledCode $$(PlutusTx.compile [||

-- The validator script is a function of four arguments:
-- 1. The 'Campaign' definition. This argument is provided by the Plutus client, using 'Ledger.applyScript'.
@@ -62,46 +62,49 @@ contributionScript cmp = ValidatorScript val where

-- In Haskell we can define new operators. We import
-- `PlutusTx.and` from the Prelude here so that we can use it
-- in infix position rather than prefix (which would require a
-- in infix position rather than prefix (which would require a
-- lot of additional brackets)
infixr 3 &&
(&&) :: Bool -> Bool -> Bool
(&&) = $$(PlutusTx.and)

-- We pattern match on the pending transaction `p` to get the

signedBy :: PubKey -> Signature -> Bool
signedBy (PubKey pk) (Signature s) = pk == s

-- We pattern match on the pending transaction `p` to get the
-- information we need:
-- `ps` is the list of inputs of the transaction
-- `outs` is the list of outputs
-- `h` is the current slot number
PendingTx ps outs _ _ (Slot h) _ _ = p
PendingTx ps outs _ _ (Slot h) _ = p

-- `deadline` is the campaign deadline, but we need it as an
-- `deadline` is the campaign deadline, but we need it as an
-- `Int` so that we can compare it with other integers.
deadline :: Int
deadline = let Slot h' = campaignDeadline in h'


-- `collectionDeadline` is the campaign collection deadline as
-- `collectionDeadline` is the campaign collection deadline as
-- an `Int`
collectionDeadline :: Int
collectionDeadline = let Slot h' = campaignCollectionDeadline in h'

-- `target` is the campaign target as
-- `target` is the campaign target as
-- an `Int`
target :: Int
target = let Value v = campaignTarget in v

-- `totalInputs` is the sum of the values of all transation
-- inputs. We ise `foldr` from the Prelude to go through the

-- `totalInputs` is the sum of the values of all transation
-- inputs. We ise `foldr` from the Prelude to go through the
-- list and sum up the values.
totalInputs :: Int
totalInputs =
let v (PendingTxIn _ _ (Value vl)) = vl in
$$(P.foldr) (\i total -> total + v i) 0 ps

isValid = case act of
Refund -> -- the "refund" branch
Refund sig -> -- the "refund" branch
let

contributorTxOut :: PendingTxOut -> Bool
@@ -113,12 +116,15 @@ contributionScript cmp = ValidatorScript val where
-- of the contributor (this key is provided as the data script `con`)
contributorOnly = $$(P.all) contributorTxOut outs

refundable = h >= collectionDeadline && contributorOnly && $$(txSignedBy) p con
refundable = h >= collectionDeadline && contributorOnly && con `signedBy` sig

in refundable
Collect -> -- the "successful campaign" branch
Collect sig -> -- the "successful campaign" branch
let
payToOwner = h >= deadline && h < collectionDeadline && totalInputs >= target && $$(txSignedBy) p campaignOwner
payToOwner = h >= deadline
&& h < collectionDeadline
&& totalInputs >= target
&& campaignOwner `signedBy` sig
in payToOwner
in
if isValid then () else $$(P.error) () ||])
@@ -132,35 +138,40 @@ campaignAddress = Ledger.scriptAddress . contributionScript
contribute :: Campaign -> Value -> MockWallet ()
contribute cmp value = do
_ <- if value <= 0 then throwOtherError "Must contribute a positive value" else pure ()
keyPair <- myKeyPair
ownPK <- ownPubKey
let sig = signature keyPair
let ds = DataScript (Ledger.lifted ownPK)

-- `payToScript` is a function of the wallet API. It takes a campaign
-- address, value, and data script, and generates a transaction that
-- `payToScript` is a function of the wallet API. It takes a campaign
-- address, value, and data script, and generates a transaction that
-- pays the value to the script. `tx` is bound to this transaction. We need
-- to hold on to it because we are going to use it in the refund handler.
-- If we were not interested in the transaction produced by `payToScript`
-- we could have used `payeToScript_`, which has the same effect but
-- If we were not interested in the transaction produced by `payToScript`
-- we could have used `payeToScript_`, which has the same effect but
-- discards the result.
tx <- payToScript (campaignAddress cmp) value ds

logMsg "Submitted contribution"

-- `register` adds a blockchain event handler on the `refundTrigger`
-- `register` adds a blockchain event handler on the `refundTrigger`
-- event. It instructs the wallet to start watching the addresses mentioned
-- in the trigger definition and run the handler when the refund condition
-- is true.
register (refundTrigger cmp) (refundHandler (Ledger.hashTx tx) cmp)
register (refundTrigger cmp) (refundHandler (Ledger.hashTx tx) sig cmp)


logMsg "Registered refund trigger"

-- | Register a [[EventHandler]] to collect all the funds of a campaign
--
scheduleCollection :: Campaign -> MockWallet ()
scheduleCollection cmp = register (collectFundsTrigger cmp) (EventHandler (\_ -> do
scheduleCollection cmp = do
keyPair <- myKeyPair
let sig = signature keyPair
register (collectFundsTrigger cmp) (EventHandler (\_ -> do
logMsg "Collecting funds"
let redeemerScript = Ledger.RedeemerScript (Ledger.lifted Collect)
let redeemerScript = Ledger.RedeemerScript (Ledger.lifted $ Collect sig)
collectFromScript (contributionScript cmp) redeemerScript))

-- | An event trigger that fires when a refund of campaign contributions can be claimed
@@ -176,17 +187,17 @@ collectFundsTrigger c = andT
(slotRangeT (Interval (campaignDeadline c) (campaignCollectionDeadline c)))

-- | Claim a refund of our campaign contribution
refundHandler :: TxId' -> Campaign -> EventHandler MockWallet
refundHandler txid cmp = EventHandler (\_ -> do
refundHandler :: TxId' -> Signature -> Campaign -> EventHandler MockWallet
refundHandler txid signature cmp = EventHandler (\_ -> do
logMsg "Claiming refund"
let validatorScript = contributionScript cmp
redeemerScript = Ledger.RedeemerScript (Ledger.lifted Refund)
redeemerScript = Ledger.RedeemerScript (Ledger.lifted $ Refund signature)

-- `collectFromScriptTxn` generates a transaction that spends the unspent
-- transaction outputs at the address of the validator scripts, *but* only
-- those outputs that were produced by the transaction `txid`. We use it
-- here to ensure that we don't attempt to claim back other contributors'
-- funds (if we did that, the validator script would fail and the entire
-- those outputs that were produced by the transaction `txid`. We use it
-- here to ensure that we don't attempt to claim back other contributors'
-- funds (if we did that, the validator script would fail and the entire
-- transaction would be invalid).
collectFromScriptTxn validatorScript redeemerScript txid)

@@ -219,7 +230,7 @@ In both cases, the validator script is run twice. In the first case there is a s

{- note [RecordWildCards]
We can use the syntax "Campaign{..}" here because the 'RecordWildCards'
We can use the syntax "Campaign{..}" here because the 'RecordWildCards'
extension is enabled automatically by the Playground backend.
The extension is documented here:
@@ -23,7 +23,6 @@ submitInvalidTxn = do
, txOutputs = []
, txForge = 2
, txFee = 0
, txSignatures = []
}
submitTxn tx

@@ -53,18 +53,18 @@ vestFunds vst value = do
payToScript_ contractAddress value dataScript

-- | Register this wallet as the owner of the vesting scheme. At each of the
-- two dates (tranche 1, tranche 2) we take out the funds that have been
-- two dates (tranche 1, tranche 2) we take out the funds that have been
-- released so far.
-- This function has to be called before the funds are vested, so that the
-- This function has to be called before the funds are vested, so that the
-- wallet can start watching the contract address for changes.
registerVestingOwner :: Vesting -> MockWallet ()
registerVestingOwner v = do
ourPubKey <- ownPubKey
let
let
o = vestingOwner v
addr = Ledger.scriptAddress (validatorScript v)
_ <- if o /= ourPubKey
then throwOtherError "Vesting scheme is not owned by this wallet"
_ <- if o /= ourPubKey
then throwOtherError "Vesting scheme is not owned by this wallet"
else startWatching addr

register (tranche2Trigger v) (tranche2Handler v)
@@ -73,7 +73,7 @@ registerVestingOwner v = do
-- (as explained in the script code, below) but doing so requires some
-- low-level code dealing with the transaction outputs, because we don't
-- have a nice interface for this in 'Wallet.API' yet.


validatorScriptHash :: Vesting -> ValidatorHash
validatorScriptHash =
@@ -95,7 +95,7 @@ validatorScript v = ValidatorScript val where
(&&) :: Bool -> Bool -> Bool
(&&) = $$(P.and)

PendingTx _ os _ _ (Slot h) _ _ = p
PendingTx _ os _ _ (Slot h) _ = p
VestingTranche (Slot d1) (Value a1) = vestingTranche1
VestingTranche (Slot d2) (Value a2) = vestingTranche2

@@ -141,7 +141,7 @@ validatorScript v = ValidatorScript val where
if isValid then () else $$(P.error) () ||])

tranche1Trigger :: Vesting -> EventTrigger
tranche1Trigger v =
tranche1Trigger v =
let VestingTranche dt1 _ = vestingTranche1 v in
(slotRangeT (Interval dt1 (succ dt1)))

@@ -154,7 +154,7 @@ tranche2Handler vesting = EventHandler (\_ -> do
collectFromScript vlscript redeemerScript)

tranche2Trigger :: Vesting -> EventTrigger
tranche2Trigger v =
tranche2Trigger v =
let VestingTranche dt2 _ = vestingTranche2 v in
(slotRangeT (Interval dt2 (succ dt2)))

@@ -33,13 +33,14 @@ import qualified Data.Set as Set
import GHC.Generics (Generic)

import qualified Language.PlutusTx as PlutusTx
import Ledger (DataScript (..), PubKey (..), TxId', ValidatorScript (..), Value (..), scriptTxIn, Slot(..))
import Ledger (DataScript (..), Signature(..), PubKey (..),
TxId', ValidatorScript (..), Value (..), scriptTxIn, Slot(..))
import qualified Ledger as Ledger
import Ledger.Validation (PendingTx (..), PendingTxIn (..), PendingTxOut, ValidatorHash)
import qualified Ledger.Validation as Validation
import Wallet (EventHandler (..), EventTrigger, Range (..), WalletAPI (..),
WalletDiagnostics (..), andT, slotRangeT, fundsAtAddressT, throwOtherError,
ownPubKeyTxOut, payToScript, pubKey, signAndSubmit)
ownPubKeyTxOut, payToScript, pubKey, createTxAndSubmit, signature)

import Prelude (Bool (..), Int, Num (..), Ord (..), fst, snd, succ, ($), (.),
(<$>), (==))
@@ -56,7 +57,7 @@ type CampaignActor = PubKey

PlutusTx.makeLift ''Campaign

data CampaignAction = Collect | Refund
data CampaignAction = Collect Signature | Refund Signature
deriving Generic

PlutusTx.makeLift ''CampaignAction
@@ -83,15 +84,17 @@ collect :: (WalletAPI m, WalletDiagnostics m) => Campaign -> m ()
collect cmp = register (collectFundsTrigger cmp) $ EventHandler $ \_ -> do
logMsg "Collecting funds"
am <- watchedAddresses
keyPair <- myKeyPair
let sig = signature keyPair
let scr = contributionScript cmp
contributions = am ^. at (campaignAddress cmp) . to (Map.toList . fromMaybe Map.empty)
red = Ledger.RedeemerScript $ Ledger.lifted Collect
red = Ledger.RedeemerScript $ Ledger.lifted $ Collect sig
con (r, _) = scriptTxIn r scr red
ins = con <$> contributions
value = getSum $ foldMap (Sum . Ledger.txOutValue . snd) contributions

oo <- ownPubKeyTxOut value
void $ signAndSubmit (Set.fromList ins) [oo]
void $ createTxAndSubmit (Set.fromList ins) [oo]


-- | The address of a [[Campaign]]
@@ -130,10 +133,10 @@ contributionScript cmp = ValidatorScript val where

-- | Check that a pending transaction is signed by the private key
-- of the given public key.
signedByT :: PendingTx ValidatorHash -> CampaignActor -> Bool
signedByT = $$(Validation.txSignedBy)
signedBy :: PubKey -> Signature -> Bool
signedBy (PubKey pk) (Signature s) = pk == s

PendingTx ps outs _ _ (Slot h) _ _ = p
PendingTx ps outs _ _ (Slot h) _ = p

deadline :: Int
deadline = let Slot h' = campaignDeadline in h'
@@ -151,7 +154,7 @@ contributionScript cmp = ValidatorScript val where
$$(PlutusTx.foldr) (\i total -> total + v i) 0 ps

isValid = case act of
Refund -> -- the "refund" branch
Refund sig -> -- the "refund" branch
let
-- Check that all outputs are paid to the public key
-- of the contributor (that is, to the `a` argument of the data script)
@@ -163,15 +166,15 @@ contributionScript cmp = ValidatorScript val where

refundable = h > collectionDeadline &&
contributorOnly &&
signedByT p a
a `signedBy` sig

in refundable
Collect -> -- the "successful campaign" branch
Collect sig -> -- the "successful campaign" branch
let
payToOwner = h > deadline &&
h <= collectionDeadline &&
totalInputs >= target &&
signedByT p campaignOwner
campaignOwner `signedBy` sig
in payToOwner
in
if isValid then () else $$(PlutusTx.error) ()) ||])
@@ -193,14 +196,16 @@ refund :: (WalletAPI m, WalletDiagnostics m) => TxId' -> Campaign -> EventHandle
refund txid cmp = EventHandler $ \_ -> do
logMsg "Claiming refund"
am <- watchedAddresses
keyPair <- myKeyPair
let sig = signature keyPair
let adr = campaignAddress cmp
utxo = fromMaybe Map.empty $ am ^. at adr
ourUtxo = Map.toList $ Map.filterWithKey (\k _ -> txid == Ledger.txOutRefId k) utxo
scr = contributionScript cmp
red = Ledger.RedeemerScript $ Ledger.lifted Refund
red = Ledger.RedeemerScript $ Ledger.lifted $ Refund sig
i ref = scriptTxIn ref scr red
inputs = Set.fromList $ i . fst <$> ourUtxo
value = getSum $ foldMap (Sum . Ledger.txOutValue . snd) ourUtxo

out <- ownPubKeyTxOut value
void $ signAndSubmit inputs [out]
void $ createTxAndSubmit inputs [out]
Oops, something went wrong.

0 comments on commit 8ab5550

Please sign in to comment.