-
Notifications
You must be signed in to change notification settings - Fork 213
/
BasicApps.hs
132 lines (106 loc) · 4.49 KB
/
BasicApps.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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
{-# 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 BasicApps where
-- BLOCK0
import Control.Monad (void)
import Data.Aeson (FromJSON, ToJSON)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Ledger (Ada, PaymentPubKeyHash (unPaymentPubKeyHash), ScriptContext (ScriptContext, scriptContextTxInfo),
valuePaidTo)
import Ledger.Ada qualified as Ada
import Ledger.Constraints qualified as Constraints
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract (Contract, Endpoint, Promise, collectFromScript, endpoint, logInfo, selectList,
submitTxConstraints, submitTxConstraintsSpending, type (.\/), utxosAt)
import PlutusTx qualified
import PlutusTx.Prelude (Bool, Semigroup ((<>)), ($), (&&), (-), (.), (>=))
import Prelude qualified as Haskell
import Schema (ToSchema)
import Wallet.Emulator.Wallet (Wallet, mockWalletPaymentPubKeyHash)
-- BLOCK1
data SplitData =
SplitData
{ recipient1 :: PaymentPubKeyHash -- ^ First recipient of the funds
, recipient2 :: PaymentPubKeyHash -- ^ Second recipient of the funds
, amount :: Ada -- ^ How much Ada we want to lock
}
deriving stock (Haskell.Show, Generic)
-- For a 'real' application use 'makeIsDataIndexed' to ensure the output is stable over time
PlutusTx.unstableMakeIsData ''SplitData
PlutusTx.makeLift ''SplitData
-- BLOCK2
validateSplit :: SplitData -> () -> ScriptContext -> Bool
validateSplit SplitData{recipient1, recipient2, amount} _ ScriptContext{scriptContextTxInfo} =
let half = Ada.divide amount 2 in
Ada.fromValue (valuePaidTo scriptContextTxInfo (unPaymentPubKeyHash recipient1)) >= half &&
Ada.fromValue (valuePaidTo scriptContextTxInfo (unPaymentPubKeyHash recipient2)) >= (amount - half)
-- BLOCK3
data Split
instance Scripts.ValidatorTypes Split where
type instance RedeemerType Split = ()
type instance DatumType Split = SplitData
splitValidator :: Scripts.TypedValidator Split
splitValidator = Scripts.mkTypedValidator @Split
$$(PlutusTx.compile [|| validateSplit ||])
$$(PlutusTx.compile [|| wrap ||]) where
wrap = Scripts.mkUntypedValidator @SplitData @()
-- BLOCK4
data LockArgs =
LockArgs
{ recipient1Wallet :: Wallet
, recipient2Wallet :: Wallet
, totalAda :: Ada
}
deriving stock (Haskell.Show, Generic)
deriving anyclass (ToJSON, FromJSON, ToSchema)
type SplitSchema =
Endpoint "lock" LockArgs
.\/ Endpoint "unlock" LockArgs
-- BLOCK5
lock :: Promise () SplitSchema T.Text ()
lock = endpoint @"lock" (lockFunds . mkSplitData)
unlock :: Promise () SplitSchema T.Text ()
unlock = endpoint @"unlock" (unlockFunds . mkSplitData)
-- BLOCK6
mkSplitData :: LockArgs -> SplitData
mkSplitData LockArgs{recipient1Wallet, recipient2Wallet, totalAda} =
SplitData
{ recipient1 = mockWalletPaymentPubKeyHash recipient1Wallet
, recipient2 = mockWalletPaymentPubKeyHash recipient2Wallet
, amount = totalAda
}
-- BLOCK7
lockFunds :: SplitData -> Contract () SplitSchema T.Text ()
lockFunds s@SplitData{amount} = do
logInfo $ "Locking " <> Haskell.show amount
let constraints = Constraints.mustPayToTheScript s (Ada.toValue amount)
void $ submitTxConstraints splitValidator constraints
-- BLOCK8
unlockFunds :: SplitData -> Contract () SplitSchema T.Text ()
unlockFunds SplitData{recipient1, recipient2, amount} = do
let contractAddress = Scripts.validatorAddress splitValidator
utxos <- utxosAt contractAddress
let half = Ada.divide amount 2
tx =
collectFromScript utxos ()
<> Constraints.mustPayToPubKey recipient1 (Ada.toValue half)
<> Constraints.mustPayToPubKey recipient2 (Ada.toValue $ amount - half)
void $ submitTxConstraintsSpending splitValidator utxos tx
-- BLOCK9
endpoints :: Contract () SplitSchema T.Text ()
-- BLOCK10
endpoints = selectList [lock, unlock]
-- BLOCK11