diff --git a/default.nix b/default.nix index 26c4951968d..1681f61a3da 100644 --- a/default.nix +++ b/default.nix @@ -58,6 +58,7 @@ let plutus-exe = addRealTimeTestLogs (filterSource super.plutus-exe); core-to-plc = doHaddockHydra (addRealTimeTestLogs (filterSource super.core-to-plc)); plutus-th = doHaddockHydra (addRealTimeTestLogs (filterSource super.plutus-th)); + plutus-use-cases = addRealTimeTestLogs (filterSource super.plutus-use-cases); }; }; other = rec { diff --git a/pkgs/default.nix b/pkgs/default.nix index 4e12009038c..e26fc5ec28b 100644 --- a/pkgs/default.nix +++ b/pkgs/default.nix @@ -55669,6 +55669,37 @@ doHaddock = false; description = "TH frontend to the Plutus compiler"; license = stdenv.lib.licenses.bsd3; +}) {}; +"plutus-use-cases" = callPackage +({ + mkDerivation +, base +, core-to-plc +, language-plutus-core +, mtl +, plutus-th +, stdenv +, template-haskell +, transformers +}: +mkDerivation { + +pname = "plutus-use-cases"; +version = "0.1.0.0"; +src = ./../plutus-use-cases; +libraryHaskellDepends = [ +base +core-to-plc +language-plutus-core +mtl +plutus-th +template-haskell +transformers +]; +doHaddock = false; +description = "Collection of smart contracts to develop the plutus/wallet interface"; +license = stdenv.lib.licenses.bsd3; + }) {}; "pointed" = callPackage ({ diff --git a/plutus-use-cases/LICENSE b/plutus-use-cases/LICENSE new file mode 100644 index 00000000000..a94365be350 --- /dev/null +++ b/plutus-use-cases/LICENSE @@ -0,0 +1,11 @@ +Copyright Input Output (c) 2018 + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/plutus-use-cases/README.md b/plutus-use-cases/README.md new file mode 100644 index 00000000000..ea477fb03c7 --- /dev/null +++ b/plutus-use-cases/README.md @@ -0,0 +1,2 @@ +# plutus-use-cases + diff --git a/plutus-use-cases/plutus-use-cases.cabal b/plutus-use-cases/plutus-use-cases.cabal new file mode 100644 index 00000000000..eb1ed132473 --- /dev/null +++ b/plutus-use-cases/plutus-use-cases.cabal @@ -0,0 +1,45 @@ +cabal-version: 2.0 +name: plutus-use-cases +version: 0.1.0.0 +license: BSD3 +license-file: LICENSE +build-type: Simple +copyright: Copyright: (c) 2018 Input Output +maintainer: jann.mueller@iohk.io +stability: experimental +author: Manuel M T Chakravarty, Jann Müller +synopsis: + Collection of smart contracts to develop the plutus/wallet interface +description: + Collection of smart contracts to develop the plutus/wallet interface. +category: Language +extra-doc-files: README.md + +source-repository head + type: git + location: https://github.com/input-output-hk/plutus-prototype + +library + hs-source-dirs: src + build-depends: + base -any, + mtl -any, + template-haskell -any, + transformers -any, + plutus-th -any, + language-plutus-core -any, + core-to-plc -any + default-language: Haskell2010 + default-extensions: ExplicitForAll ScopedTypeVariables + DeriveGeneric StandaloneDeriving DeriveLift + GeneralizedNewtypeDeriving DeriveFunctor DeriveFoldable + DeriveTraversable + exposed-modules: + Language.Plutus.Coordination.Plutus + Language.Plutus.Coordination.Contracts + Language.Plutus.Coordination.Contracts.CrowdFunding + Language.Plutus.Coordination.Contracts.Swap + ghc-options: + -Wall -Wnoncanonical-monad-instances + -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints -Widentities diff --git a/plutus-use-cases/src/Language/Plutus/Coordination/Contracts.hs b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts.hs new file mode 100644 index 00000000000..17b612bf856 --- /dev/null +++ b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts.hs @@ -0,0 +1,33 @@ +module Language.Plutus.Coordination.Contracts( + -- * Example contracts + module CrowdFunding, + module Swap + ) where + +import Language.Plutus.Coordination.Contracts.CrowdFunding as CrowdFunding +import Language.Plutus.Coordination.Contracts.Swap as Swap + +{- Note [Contracts and Validator Scripts] + +Central to both examples are the validator scripts in +`CrowdFunding.contributionScript` and `Swap.swapValidator`. In both cases we +construct a PLC script using the core-to-plutus plugin (with Template Haskell +and the `plc` marker respectively). + +The validator scripts currently have a type + +Redeemer -> DataScript -> PendingTx -> a -> () + +Where `a` is a parameter specific to the contract (supplied by the user before +the contract begins). The actual signature of a validator script looks like + +Redeemer -> DataScript -> PendingTx -> () + +So, in the future, the Plutus coordinating code has to translate the `a` value +to PLC and apply it to the function. This could be done with a type class +(similar to aeson's ToJSON). + +In order to validate transactions, cardano nodes have to do the same with +`PendingTx` which holds information about the transaction. + +-} diff --git a/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/CrowdFunding.hs b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/CrowdFunding.hs new file mode 100644 index 00000000000..0714d5f0207 --- /dev/null +++ b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/CrowdFunding.hs @@ -0,0 +1,165 @@ +-- | Crowdfunding contract implemented using the [[Plutus]] interface. +-- This is the fully parallel version that collects all contributions +-- in a single transaction. This is, of course, limited by the maximum +-- number of inputs a transaction can have. +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -fplugin=Language.Plutus.CoreToPLC.Plugin -fplugin-opt Language.Plutus.CoreToPLC.Plugin:dont-typecheck #-} +module Language.Plutus.Coordination.Contracts.CrowdFunding ( + Campaign(..) + -- * Functionality for campaign contributors + , contribute + , contributionScript + , refund + , refundTrigger + -- * Functionality for campaign owners + , collect + , collectFundsTrigger + ) where + +import Language.Plutus.Coordination.Plutus +import Language.Plutus.TH (plutusT) +import qualified Language.Plutus.CoreToPLC.Primitives as Prim + +import Prelude (Bool (..), Either (..), Num (..), Ord (..), succ, sum, ($)) + +-- | A crowdfunding campaign. +data Campaign = Campaign + { campaignDeadline :: !BlockHeight + , campaignTarget :: !Value + , campaignCollectionDeadline :: !BlockHeight + , campaignOwner :: !PubKey + } + +-- | Contribute funds to the campaign (contributor) +-- +contribute :: Campaign -> Value -> TxM [TxOutRef] +contribute c value = do + assert (value > 0) + contributorPubKey <- lookupMyPubKey + myPayment <- createPayment (value + standardTxFee) + let validator = contributionScript c contributorPubKey + o = TxOutScript + value + (hash validator) + 0 -- TODO: contributorPubKey ought to be lifted into PLC at coordination runtime as the data script + submitTransaction Tx + { txInputs = Left myPayment -- TODO: Change to [myPayment] when we can have a list of inputs + , txOutputs = Left o + } + -- the transaction above really ought to be merely a transaction *template* and the transaction fee ought to be + -- added by the Wallet API Plutus library on the basis of the size and other costs of the transaction + +-- | The validator script that determines whether the campaign owner can +-- retrieve the funds or the contributors can claim a refund. +-- +-- Assume there is a campaign `c :: Campaign` with two contributors +-- (identified by public key pc_1 and pc_2) and one campaign owner (pco). +-- Each contributor creates a transaction, t_1 and t_2, whose outputs are +-- locked by the scripts `contributionScript c pc_1` and `contributionScript +-- c pc_1` respectively. +-- There are two outcomes for the campaign. +-- 1. Campaign owner collects the funds from both contributors. In this case +-- the owner creates a single transaction with two inputs, referring to +-- t_1 and t_2. Each input contains the script `contributionScript c` +-- specialised to a contributor. This case is covered by the +-- definition for `payToOwner` below. +-- 2. Refund. In this case each contributor creates a transaction with a +-- single input claiming back their part of the funds. This case is +-- covered by the `refundable` branch. +contributionScript :: + Campaign + -> PubKey + -> PlutusTx +contributionScript _ _ = PlutusTx inner where + + -- See note [Contracts and Validator Scripts] in + -- Language.Plutus.Coordination.Contracts + inner = $$(plutusT [|| (\() () p Campaign{..} contribPubKey -> + let + -- | Check that a transaction input is signed by the private key of the given + -- public key. + signedBy :: TxIn -> PubKey -> Bool + signedBy = Prim.error + + infixr 3 && + (&&) :: Bool -> Bool -> Bool + (&&) = Prim.error + + -- | Check that a pending transaction is signed by the private key + -- of the given public key. + signedByT :: PendingTx -> PubKey -> Bool + signedByT = Prim.error + + PendingTx pendingTxBlockHeight _ pendingTxTransaction = p + + isValid = case pendingTxTransaction of + Tx (Right (t1, t2)) _ -> -- the "successful campaign" branch + let + TxIn (TxOutRef v1 _ _) _ _ _ = t1 + TxIn (TxOutRef v2 _ _) _ _ _ = t2 + pledgedFunds = v1 + v2 + + payToOwner = pendingTxBlockHeight > campaignDeadline && + pendingTxBlockHeight <= campaignCollectionDeadline && + pledgedFunds >= campaignTarget && + signedByT p campaignOwner + in payToOwner + Tx (Left t) _ -> -- the "refund" branch + let + -- Check that a refund transaction only spends the + -- amount that was pledged by the contributor + -- identified by `contribPubKey` + contributorOnly = signedBy t contribPubKey + refundable = pendingTxBlockHeight > campaignCollectionDeadline && + contributorOnly && + signedByT p contribPubKey + -- In case of a refund, we can only collect the funds that + -- were committed by this contributor + in refundable + in + if isValid then () else Prim.error) ||]) + +-- | Given the campaign data and the output from the contributing transaction, +-- make a trigger that fires when the transaction can be refunded. +refundTrigger :: Campaign -> Address -> EventTrigger +refundTrigger Campaign{..} t = And + (FundsAtAddress [t] (GEQ 1)) + (BlockHeightRange (GEQ $ succ campaignCollectionDeadline)) + +-- | Given the public key of the campaign owner, generate an event trigger that +-- fires when the funds can be collected. +collectFundsTrigger :: Campaign -> [Address] -> EventTrigger +collectFundsTrigger Campaign{..} ts = And + (FundsAtAddress ts $ GEQ campaignTarget) + (BlockHeightRange $ Interval campaignDeadline campaignCollectionDeadline) + +refund :: Campaign -> TxOutRef -> TxM [TxOutRef] +refund c ref = do + kp <- lookupMyKeyPair + let scr = contributionScript c (pubKey kp) + o = TxOutPubKey value (pubKey kp) + i = txInSign ref scr unitPLC unitPLC kp + submitTransaction $ Tx { + txInputs = Left i, + txOutputs = Left o + } where + value = txOutRefValue ref - standardTxFee -- TODO: Fee should be inserted by wallet + +-- | Collect all campaign funds (campaign owner) +-- +-- +collect :: Campaign -> (TxOutRef, PubKey) -> (TxOutRef, PubKey) -> TxM [TxOutRef] +collect cmp (o1, ck1) (o2, ck2) = do + ownerKeyPair <- lookupMyKeyPair + let oo = TxOutPubKey value (pubKey ownerKeyPair) + scr = contributionScript cmp + submitTransaction Tx + { txInputs = Right ( + txInSign o1 (scr ck1) unitPLC unitPLC ownerKeyPair, + txInSign o2 (scr ck2) unitPLC unitPLC ownerKeyPair) + , txOutputs = Left oo + } + where + value = sum [txOutRefValue outRef | outRef <- [o1, o2]] + standardTxFee diff --git a/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/Swap.hs b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/Swap.hs new file mode 100644 index 00000000000..c9cf0576367 --- /dev/null +++ b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/Swap.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +-- Disabled until we can use the Num.(*) for `Ratio Int` +-- {-# OPTIONS -fplugin=Language.Plutus.CoreToPLC.Plugin #-} +module Language.Plutus.Coordination.Contracts.Swap( + Swap(..), + swapValidator + ) where + +import Language.Plutus.Coordination.Plutus +import Language.Plutus.CoreToPLC.Plugin (plc) +import qualified Language.Plutus.CoreToPLC.Primitives as Prim + +import Data.Ratio (Ratio) +-- Ord, Num and Eq are recognised by core-to-plc +import Prelude (Bool, Either (..), Eq (..), Int, Num (..), Ord (..)) + +-- | A swap is an agreement to exchange cashflows at future dates. To keep +-- things simple, this is an interest rate swap (meaning that the cashflows are +-- interest payments on the same principal amount but with two different +-- interest rates, of which one is fixed and one is floating (varying with +-- time)) with only a single payment date. +-- +-- At the beginning of the contract, the fixed rate is set to the expected +-- future value of the floating rate (so if the floating rate behaves as +-- expected, the two payments will be exactly equal). +-- +data Swap = Swap + { swapNotionalAmt :: !Value + , swapObservationTime :: !BlockHeight + , swapFixedRate :: !(Ratio Int) -- ^ Interest rate fixed at the beginning of the contract + , swapFloatingRate :: !Int -- ^ Interest rate whose value will be observed (by an oracle) on the day of the payment + , swapFixedLeg :: !PubKey + , swapFloatingLeg :: !PubKey + , swapMargin :: !Value -- ^ Margin deposited at the beginning of the contract to protect against default (one party failing to pay) + , swapOracle :: !PubKey -- ^ Public key of the oracle (see note [Oracles] in [[Language.Plutus.Coordination.Plutus]]) + } + +-- | Validator script for the two transactions that initialise the swap. +-- See note [Swap Transactions] +-- See note [Contracts and Validator Scripts] in +-- Language.Plutus.Coordination.Contracts +swapValidator :: Swap -> PlutusTx +swapValidator _ = PlutusTx result where + result = plc (\(redeemer :: OracleValue (Ratio Int)) () PendingTx{..} Swap{..} -> + let + infixr 3 && + (&&) :: Bool -> Bool -> Bool + (&&) = Prim.error + + mn :: Int -> Int -> Int + mn a b = if a < b then a else b + + mx :: Int -> Int -> Int + mx a b = if a > b then a else b + + extractVerifyAt :: OracleValue (Ratio Int) -> PubKey -> Int -> BlockHeight -> Ratio Int + extractVerifyAt = Prim.error + + round :: Ratio Int -> Int + round = Prim.error + + -- | Convert an [[Int]] to a [[Ratio Int]] + fromInt :: Int -> Ratio Int + fromInt = Prim.error + + signedBy :: TxIn -> PubKey -> Bool + signedBy = Prim.error + + infixr 3 || + (||) :: Bool -> Bool -> Bool + (||) = Prim.error + + isPubKeyOutput :: TxOut a -> PubKey -> Bool + isPubKeyOutput = Prim.error + + -- Verify the authenticity of the oracle value and compute + -- the payments. + rt = extractVerifyAt redeemer swapOracle swapFloatingRate swapObservationTime + + rtDiff :: Ratio Int + rtDiff = rt - swapFixedRate + amt = swapNotionalAmt + + amt' :: Ratio Int + amt' = fromInt amt + + delta :: Ratio Int + delta = amt' * rtDiff + + fixedPayment :: Int + fixedPayment = round (amt' + delta) + + floatPayment :: Int + floatPayment = round (amt' - delta) + + -- Compute the payouts (initial margin +/- the sum of the two + -- payments), ensuring that it is at least 0 and does not exceed + -- the total amount of money at stake (2 * margin) + clamp :: Int -> Int + clamp x = mn 0 (mx (2 * swapMargin) x) + fixedRemainder = clamp (swapMargin - fixedPayment + floatPayment) + floatRemainder = clamp (swapMargin - floatPayment + fixedPayment) + + -- The transaction must have one input from each of the + -- participants. + -- NOTE: Partial match until we have lists + Tx (Right (t1, t2)) (Right (o1, o2)) = pendingTxTransaction + + -- Each participant must deposit the margin. But we don't know the + -- order in which the participant's deposits are included in the + -- inputs. So we use the two predicates iP1 and iP2 to check + -- for the two possible orderings (in `inConditions`) + + -- True if the transaction input is the margin payment of the + -- fixed leg + iP1 :: TxIn -> Bool + iP1 t = signedBy t swapFixedLeg && txOutRefValue (txInOutRef t) == swapMargin + + -- True if the transaction input is the margin payment of the + -- floating leg + iP2 :: TxIn -> Bool + iP2 t = signedBy t swapFloatingLeg && txOutRefValue (txInOutRef t) == swapMargin + + inConditions = (iP1 t1 && iP2 t2) || (iP1 t2 && iP2 t1) + + -- The transaction must have two outputs, one for each of the + -- participants, which equal the margin adjusted by the difference + -- between fixed and floating payment + + -- True if the output is the payment of the fixed leg. + ol1 :: TxOut a -> Bool + ol1 o = isPubKeyOutput o swapFixedLeg && txOutValue o <= fixedRemainder + + -- True if the output is the payment of the floating leg. + ol2 :: TxOut a -> Bool + ol2 o = isPubKeyOutput o swapFloatingLeg && txOutValue o <= floatRemainder + + -- NOTE: I didn't include a check that the chain height is greater + -- than the observation time. This is because the chain height is + -- already part of the oracle value and we trust the oracle. + + outConditions = (ol1 o1 && ol2 o2) || (ol1 o2 && ol2 o1) + + + in + if inConditions && outConditions then () else Prim.error + ) + +{- Note [Swap Transactions] + +The swap involves three transactions at two different times. + +1. At t=0. Each participant deposits the margin. The outputs are locked with + the same validator script, `swapValidator` +2. At t=n. The value of the floating rate, and consequently the values of the + two payments are determined. Each participant gets their margin plus or + minus the actual payment. + +There is a risk of losing out if the interest rate moves outside the range of +fixedRate +/- (margin / notional amount). In a real financial contract this +would be dealt with by agreeing a "Variation Margin". This means that the +margin is adjusted at predefined dates before the actual payment is due. If one +of the parties fails to make the variation margin payment, the contract ends +prematurely and the other party gets to keep both margins. + +Plutus should be able to handle variation margins in a series of validation +scripts. But it seems to me that they could get quite messy so I don't want to +write them by hand :) We can probably use TH to generate them at compile time. + +-} diff --git a/plutus-use-cases/src/Language/Plutus/Coordination/Plutus.hs b/plutus-use-cases/src/Language/Plutus/Coordination/Plutus.hs new file mode 100644 index 00000000000..b997187209e --- /dev/null +++ b/plutus-use-cases/src/Language/Plutus/Coordination/Plutus.hs @@ -0,0 +1,257 @@ +-- | This is a mock of (parts of) the Plutus API +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS -fplugin=Language.Plutus.CoreToPLC.Plugin #-} +-- | A model of the types involved in transactions, and of the wallet API. +module Language.Plutus.Coordination.Plutus (-- * Transactions and related types + Address + , PubKey(..) + , KeyPair + , pubKey + , Value + , Tx(..) + , TxIn(..) + , TxOut(..) + , mkAddress + , TxOutRef(..) + , standardTxFee + , txOutValue + , txOutDataScript + , txOutValidatorScriptHash + -- * API operations + , TxM + , Hash + , hash + , Redeemer + , Validator + , DataScript + , PlutusTx(..) + , unitPLC + , BlockHeight + , PendingTx(..) + , submitTransaction + , assert + , lookupMyKeyPair + , lookupMyPubKey + , createPayment + , txInSign + , Range(..) + , EventTrigger(..) + , Signed(..) + , OracleValue(..) + ) where + +import Control.Applicative (Alternative (..)) +import Control.Monad.State (State) +import Control.Monad.Trans.Maybe (MaybeT (..)) +import Language.Plutus.CoreToPLC.Plugin (PlcCode, plc) + +newtype Signed a = Signed (PubKey, a) + +{- Note [Oracles] + +I'm not sure how oracles are going to work eventually, so I'm going to use this +definition for now: + +* Oracles are identified by their public key +* An oracle can produce "observations", which are values annotated with time + (block height). These observations are signed by the oracle. +* To use an oracle value inside a validator script, it has to be provided as the + data script of the transaction that consumes the output locked by the + validator script. + +An example of this can be found in the +Language.Plutus.Coordination.Contracts.Swap.swapValidator script. + +-} + +-- `OracleValue a` is the value observed at a time signed by +-- an oracle. +newtype OracleValue a = OracleValue (Signed (BlockHeight, a)) + +-- | Cardano address +-- +newtype Address = Address Int + deriving (Eq, Ord, Show, Read) + +-- | Ada value +-- +type Value = Int + +newtype Hash = Hash Int + deriving (Eq, Ord, Show, Read) + +hash :: a -> Hash +hash _ = Hash 10 + +-- | Public key +-- +data PubKey = PubKey + +-- | Public key pair (no lift instance, because we never ought to put it into a +-- transaction) +-- +data KeyPair + +data TxState + +-- | Transaction monad for coordination layer computations; provides access to +-- the blockchain +-- +type TxM a = MaybeT (State TxState) a + +-- | Submit the given transaction to the blockchain +submitTransaction :: Tx -> TxM [TxOutRef] +submitTransaction = const empty + +-- | Verify that a condition is true. +assert :: Bool -> TxM () +assert = const empty + +-- | Get the users's public key. Part of the wallet interface +lookupMyPubKey :: TxM PubKey +lookupMyPubKey = pubKey <$> lookupMyKeyPair + +-- | Extract the public key from a key pair. +pubKey :: KeyPair -> PubKey +pubKey = const PubKey + +-- | Part of the wallet interface +lookupMyKeyPair :: TxM KeyPair +lookupMyKeyPair = empty + +-- | Create an input that spends the given value (part of the wallet interface) +-- +createPayment :: Value -> TxM TxIn +createPayment = const empty + +-- | A UTxO transaction specification +-- +-- In this model the number of inputs and outputs of a transaction is +-- limited to a maximum of 2. This will change when we can translate recursive +-- types in the core-to-plc plugin. +data Tx = Tx + { txInputs :: Either TxIn (TxIn, TxIn) -- TODO: Change to [TxIn] + , txOutputs :: Either (TxOut Int) (TxOut Int, TxOut Int) -- TODO: Change to [TxOut Int] + } + +-- | UTxO input +-- +data TxIn = TxIn + { txInOutRef :: !TxOutRef -- ^ Output consumed by this transaction + , txInValidator :: !Hash -- ^ Validator script of the transaction output (TODO: This should be the actual script, not the hash; Change to Validator when recursive types are supported - same for redeemer and data scripts.) + , txInRedeemer :: !Hash -- ^ Redeemer + , txInDataScript :: !Hash -- ^ Data script (TODO: Not sure if we should have 1 data script per transaction or 1 data script per transaction input) + } + +-- | Construct an input that can spend the given output (assuming it was payed +-- to an address in our wallet.) Part of the wallet interface +-- +txInSign :: TxOutRef -> Validator -> Redeemer -> DataScript -> KeyPair -> TxIn +txInSign to v r d _ = TxIn to (hash v) (hash r) (hash d) + +-- | Reference to an unspent output +-- See https://github.com/input-output-hk/plutus-prototype/tree/master/docs/extended-utxo#extension-to-transaction-outputs +-- +data TxOutRef = + TxOutRef + { + txOutRefValue :: !Value -- We assume this is added by the library. TODO: In cardano-sl this is a "ValueDistribution" (map of keys to values) + , txOutRefValidatorHash :: !Hash -- Hash of validator script. The validator script has to be submitted by the consumer of the outputs referenced by this TxOutRef. + , txOutRefDataScriptHash :: !Hash -- Hash of data script used by the creator of the transaction. + } + +type BlockHeight = Int + +-- | Information about a pending transaction used by validator scripts. +-- See https://github.com/input-output-hk/plutus-prototype/tree/master/docs/extended-utxo#blockchain-state-available-to-validator-scripts +data PendingTx = PendingTx { + pendingTxBlockHeight :: !BlockHeight -- ^ Block height exl. current transaction + , pendingTxHash :: !Hash -- ^ Hash of the transaction that is being validated + , pendingTxTransaction :: !Tx + } + +-- | UTxO output +-- +data TxOut a = TxOutPubKey !Value !PubKey + | TxOutScript !Value !Hash !a + +-- | An address in cardano is a hash of the information in `TxOut` +mkAddress :: TxOut a -> Address +mkAddress = const (Address 5) + +txOutValue :: TxOut a -> Value +txOutValue = \case + TxOutPubKey v _ -> v + TxOutScript v _ _ -> v + +txOutDataScript :: TxOut a -> Maybe a +txOutDataScript = \case + TxOutScript _ _ r -> Just r + _ -> Nothing + +txOutValidatorScriptHash :: TxOut a -> Maybe Hash +txOutValidatorScriptHash = \case + TxOutScript _ h _ -> Just h + _ -> Nothing + +-- | PlutusTx code +-- +newtype PlutusTx = PlutusTx { getPlutusTx :: PlcCode } + +-- | A PLC script containing the `()` value, to be used as a placeholder for +-- data and redeemer scripts where we don't need them. +unitPLC :: PlutusTx +unitPLC = PlutusTx $ plc () + +-- | Some sort of transaction fee (we need to determine that more dynamically) +-- +standardTxFee :: Value +standardTxFee = 1 + +data Range a = + Interval a a -- inclusive-exclusive + | GEQ a + | LT a + +-- | Event triggers the Plutus client can register with the wallet. +data EventTrigger = + BlockHeightRange !(Range BlockHeight) -- ^ True when the block height is within the range + | FundsAtAddress [Address] !(Range Value) -- ^ True when the (unspent) funds at a list of addresses are within the range + | And EventTrigger EventTrigger -- ^ True when both triggers are true + | Or EventTrigger EventTrigger -- ^ True when at least one trigger is true + | PAlways -- ^ Always true + | PNever -- ^ Never true + +-- | Validator scripts expect two scripts and information about the current +-- txn. In the future this will be written in Plutus (with the help of TH) +-- and its return type will be `a` instead of `Maybe a`. +-- See https://github.com/input-output-hk/plutus-prototype/tree/master/docs/extended-utxo#extension-to-validator-scripts +-- +type Validator = PlutusTx + +type Redeemer = PlutusTx + +type DataScript = PlutusTx + +{- Note [Transaction Templates] + +Transaction templates are currently missing from this mock API and will be +added in the future. + +Transaction templates differ from transactions in at least two ways: + +1) They do not include a transaction fee (that is, the sum of their input + values equals the sum of their output values) +2) Part of their input value is not attributed to an address + +To turn a template into a transaction, the wallet +1) Adjusts either the input values or the output value to ensure that the + difference between inputs and outputs matches the transaction fee. +2) Expands the inputs to account for the missing funds (via coin selection). + +These two steps depend on each other because the transaction fee is a +function of the size of the transaction including its +inputs. + +-} diff --git a/release.nix b/release.nix index da6a26eb34a..7401303b3ed 100644 --- a/release.nix +++ b/release.nix @@ -20,6 +20,7 @@ let plutus-exe = supportedSystems; core-to-plc = supportedSystems; plutus-th = supportedSystems; + plutus-use-cases = supportedSystems; # don't need to build the spec on anything other than one platform plutus-core-spec = [ "x86_64-linux" ]; }; diff --git a/stack.yaml b/stack.yaml index 4c95d0d094d..50cd57bc60b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,6 +7,7 @@ packages: - plutus-exe - core-to-plc - plutus-th +- plutus-use-cases - location: git: https://github.com/input-output-hk/cardano-crypto