-
Notifications
You must be signed in to change notification settings - Fork 213
/
BasicAppConstraints.hs
90 lines (77 loc) · 3.5 KB
/
BasicAppConstraints.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
module BasicAppConstraints where
-- BLOCK0
import BasicApps (SplitData (SplitData, amount, recipient1, recipient2), SplitSchema, mkSplitData)
import Ledger (Ada, ChainIndexTxOut, PaymentPubKeyHash, ScriptContext, TxOutRef)
import Ledger.Ada qualified as Ada
import Ledger.Constraints (MkTxError, TxConstraints, UnbalancedTx)
import Ledger.Constraints qualified as Constraints
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract (Contract, Promise, collectFromScript, endpoint, submitTxConstraintsSpending, utxosAt)
import Control.Monad (void)
import Data.Either (Either)
import Data.Foldable (foldMap)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Text qualified as T
import GHC.Generics (Generic)
import PlutusTx qualified
import PlutusTx.Prelude (Bool, mappend, ($), (-), (.))
import Prelude (Show, flip, (<>))
-- BLOCK1
-- | Create constraints that will be used to spend a locked transaction output
-- from the script address.
--
-- These constraints will be used in the validation script as well as in the
-- transaction creation step.
{-# INLINABLE splitDataConstraints #-}
splitDataConstraints :: SplitData -> TxConstraints () SplitData
splitDataConstraints SplitData{recipient1, recipient2, amount} =
Constraints.mustPayToPubKey recipient1 (Ada.toValue half)
`mappend` Constraints.mustPayToPubKey recipient2 (Ada.toValue $ amount - half)
where
half = Ada.divide amount 2
-- BLOCK2
-- | The validation logic is generated with `checkScriptContext` based on the set
-- of constraints.
{-# INLINABLE validateSplit #-}
validateSplit :: SplitData -> () -> ScriptContext -> Bool
validateSplit splitData _ =
Constraints.checkScriptContext (splitDataConstraints splitData)
-- BLOCK3
splitValidator :: Scripts.TypedValidator Split
splitValidator = Scripts.mkTypedValidator @Split
$$(PlutusTx.compile [|| validateSplit ||])
$$(PlutusTx.compile [|| wrap ||]) where
wrap = Scripts.mkUntypedValidator @SplitData @()
-- BLOCK4
unlock :: Promise () SplitSchema T.Text ()
unlock = endpoint @"unlock" (unlockFunds . mkSplitData)
-- | Creates a transaction which spends all script outputs from a script address,
-- sums the value of the scripts outputs and splits it between two payment keys.
unlockFunds :: SplitData -> Contract () SplitSchema T.Text ()
unlockFunds splitData = do
-- Get the address of the Split validator
let contractAddress = Scripts.validatorAddress splitValidator
-- Get all utxos that are locked by the Split validator
utxos <- utxosAt contractAddress
-- Generate constraints which will spend all utxos locked by the Split
-- validator and split the value evenly between the two payment keys.
let constraints = collectFromScript utxos ()
<> splitDataConstraints splitData
-- Create, Balance and submit the transaction
void $ submitTxConstraintsSpending splitValidator utxos constraints
-- BLOCK5