-
Notifications
You must be signed in to change notification settings - Fork 3
/
ContractUtils.purs
92 lines (85 loc) · 2.88 KB
/
ContractUtils.purs
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
module Seath.Test.Examples.Addition.ContractUtils
( buildAdditionCoreConfig
, initialSeathContract
) where
import Contract.Monad (Contract, liftedE, liftedM)
import Contract.PlutusData (toData)
import Contract.ScriptLookups as ScriptLookups
import Contract.Scripts
( PlutusScript
, Validator
, ValidatorHash
, applyArgs
, validatorHash
)
import Contract.TextEnvelope (decodeTextEnvelope, plutusScriptV2FromEnvelope)
import Contract.Transaction (awaitTxConfirmed, submitTxFromConstraints)
import Contract.TxConstraints (DatumPresence(DatumInline), mustPayToScript)
import Control.Applicative (pure)
import Control.Monad (bind, (>>=))
import Data.BigInt (BigInt)
import Data.Monoid (mempty)
import Data.Newtype (class Newtype, wrap)
import Data.Tuple.Nested (type (/\), (/\))
import Data.Unit (unit)
import Prelude (discard, ($))
import Seath.Core.Types (CoreConfiguration(CoreConfiguration))
import Seath.Network.Utils (getPublicKeyHash)
import Seath.Test.Examples.Addition.Actions as Addition
import Seath.Test.Examples.Addition.Types
( AdditionAction
, AdditionDatum(AdditionDatum)
, AdditionParams
, AdditionRedeemer
, AdditionState
, AdditionValidator
, initialState
)
import Seath.Test.Examples.Addition.Validator (validatorScript)
newtype ActionNumber = ActionNumber Int
derive instance Newtype ActionNumber _
initialSeathContract :: Contract AdditionState
initialSeathContract = do
validator /\ hash <- getValidatorAndHash unit
let
lookups :: ScriptLookups.ScriptLookups AdditionValidator
lookups = ScriptLookups.validator validator
datum = AdditionDatum $ { lockedAmount: initialState }
constraints = mustPayToScript hash
(wrap $ toData datum)
DatumInline
mempty
-- logInfo' $ "datum: " <> (show :: Datum -> String) (wrap $ toData datum)
transactionId <- submitTxFromConstraints lookups constraints
awaitTxConfirmed transactionId
pure initialState
importValidator :: AdditionParams -> Contract PlutusScript
importValidator params = do
validator <- liftedM "can't decode validator" $ pure
( decodeTextEnvelope validatorScript
>>= plutusScriptV2FromEnvelope
)
liftedE $ pure (applyArgs validator [ toData params ])
getValidatorAndHash :: AdditionParams -> Contract (Validator /\ ValidatorHash)
getValidatorAndHash params = do
script <- importValidator params
let validator = wrap script
pure $ validator /\ validatorHash validator
buildAdditionCoreConfig
∷ Contract
( CoreConfiguration
AdditionAction
BigInt
AdditionValidator
AdditionDatum
AdditionRedeemer
)
buildAdditionCoreConfig = do
validatorHash <- Addition.fixedValidatorHash
leaderPkh <- getPublicKeyHash
pure $ CoreConfiguration
{ leader: leaderPkh
, stateValidatorHash: validatorHash
, actionHandler: Addition.handleAction
, queryBlockchainState: Addition.queryBlockchainState
}