Skip to content

Commit 5f8f97e

Browse files
bladyjokerbladyjoker
authored
Merge pull request #82 from mlabs-haskell/bladyjoker/deployment-hashes-addresses
Include currency symbols and validator addresses with the deployment config
2 parents 9e9c9ae + fb03923 commit 5f8f97e

File tree

4 files changed

+58
-43
lines changed

4 files changed

+58
-43
lines changed

‎coop-hs-types/src/Coop/Types.hs‎

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -60,12 +60,16 @@ data CoopPlutus = CoopPlutus
6060

6161
-- | COOP deployment (per oracle)
6262
data CoopDeployment = CoopDeployment
63-
{ cd'coopAc :: AssetClass
63+
{ cd'coopAsset :: AssetClass
6464
-- ^ $COOP one-shot token denoting the COOP deployment
65-
, cd'fsMp :: MintingPolicy
65+
, cd'fsPolicy :: MintingPolicy
6666
-- ^ Deployed COOP Fact Statement minting policy
67-
, cd'fsV :: Validator
67+
, cd'fsSymbol :: CurrencySymbol
68+
-- ^ Deployed COOP $FS currency symbol (policy id)
69+
, cd'fsValidator :: Validator
6870
-- ^ Deployed COOP Fact Statement validator
71+
, cd'fsAddress :: Address
72+
-- ^ Deployed COOP Fact Statement validator address
6973
, cd'auth :: AuthDeployment
7074
-- ^ Deployed COOP authentication deployment
7175
}
@@ -137,14 +141,20 @@ data FsMpRedeemer = FsMpBurn | FsMpMint
137141

138142
-- | COOP Authentication deployment
139143
data AuthDeployment = AuthDeployment
140-
{ ad'authorityAc :: AssetClass
144+
{ ad'authorityAsset :: AssetClass
141145
-- ^ Authentication authority asset class $AA that can authorize minting $AUTH and $CERT tokens
142-
, ad'certV :: Validator
146+
, ad'certValidator :: Validator
143147
-- ^ @CertV Certificate validator holding $CERTs and CertDatums
144-
, ad'certMp :: MintingPolicy
148+
, ad'certAddress :: Address
149+
-- ^ @CertV Certificate validator address
150+
, ad'certPolicy :: MintingPolicy
145151
-- ^ Minting policy for $CERT tokens
146-
, ad'authMp :: MintingPolicy
147-
-- ^ Minting policy ofr $AUTH tokens
152+
, ad'certSymbol :: CurrencySymbol
153+
-- ^ Currency symbol (policy id) for $CERT tokens
154+
, ad'authPolicy :: MintingPolicy
155+
-- ^ Minting policy for $AUTH tokens
156+
, ad'authSymbol :: CurrencySymbol
157+
-- ^ Currency symbol (policy id) for $AUTH tokens
148158
}
149159
deriving stock (Show, Generic, Eq)
150160
deriving anyclass (ToJSON, FromJSON)

‎coop-pab/src/Coop/Pab.hs‎

Lines changed: 28 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ import Cardano.Proto.Aux (
2222
import Control.Lens ((&), (.~), (^.))
2323
import Control.Monad (guard, when)
2424
import Coop.Pab.Aux (Trx (Trx), currencyValue, datumFromTxOut, datumFromTxOutOrFail, deplAuthCs, deplAuthMp, deplCertCs, deplCertVAddress, deplFsCs, deplFsVAddress, deplFsVHash, findOutsAt, findOutsAt', findOutsAtHolding', findOutsAtHoldingCurrency, findOutsAtHoldingCurrency', hasCurrency, hashTxInputs, interval', minUtxoAdaValue, mkMintOneShotTrx, submitTrx, submitTrx', toDatum, toRedeemer)
25-
import Coop.Types (AuthBatchId, AuthDeployment (AuthDeployment, ad'authMp, ad'authorityAc, ad'certMp, ad'certV), AuthMpParams (AuthMpParams), AuthMpRedeemer (AuthMpBurn, AuthMpMint), AuthParams (AuthParams, ap'authTokenCs, ap'certTokenCs), CertDatum (CertDatum, cert'id, cert'validity), CertMpParams (CertMpParams), CertMpRedeemer (CertMpBurn, CertMpMint), CoopDeployment (CoopDeployment, cd'auth, cd'fsMp, cd'fsV), CoopPlutus (cp'fsV, cp'mkAuthMp, cp'mkCertMp, cp'mkFsMp, cp'mkOneShotMp), CoopState (CoopState), FactStatementId, FsDatum (FsDatum, fd'fsId, fs'gcAfter, fs'submitter), FsMpParams (FsMpParams), FsMpRedeemer (FsMpBurn, FsMpMint), cp'certV)
25+
import Coop.Types (AuthBatchId, AuthDeployment (AuthDeployment, ad'authPolicy, ad'authorityAsset, ad'certPolicy, ad'certValidator), AuthMpParams (AuthMpParams), AuthMpRedeemer (AuthMpBurn, AuthMpMint), AuthParams (AuthParams, ap'authTokenCs, ap'certTokenCs), CertDatum (CertDatum, cert'id, cert'validity), CertMpParams (CertMpParams), CertMpRedeemer (CertMpBurn, CertMpMint), CoopDeployment (CoopDeployment, cd'auth, cd'fsPolicy, cd'fsValidator), CoopPlutus (cp'fsV, cp'mkAuthMp, cp'mkCertMp, cp'mkFsMp, cp'mkOneShotMp), CoopState (CoopState), FactStatementId, FsDatum (FsDatum, fd'fsId, fs'gcAfter, fs'submitter), FsMpParams (FsMpParams), FsMpRedeemer (FsMpBurn, FsMpMint), cp'certV)
2626
import Data.Bool (bool)
2727
import Data.Foldable (toList)
2828
import Data.List (nub, partition)
@@ -103,32 +103,37 @@ deployCoop coopPlutus aaWallet atLeastAaQ aaQToMint = do
103103
mkAuthDeployment :: CoopPlutus -> AssetClass -> Integer -> AuthDeployment
104104
mkAuthDeployment coopPlutus aaAc atLeastAaQ =
105105
let authMpParams = AuthMpParams aaAc atLeastAaQ
106-
certMpParams = CertMpParams aaAc atLeastAaQ (mkValidatorAddress certV)
106+
certMpParams = CertMpParams aaAc atLeastAaQ certAddr
107107
certV = Validator $ cp'certV coopPlutus
108+
certAddr = mkValidatorAddress certV
108109
certMp = MintingPolicy $ applyArguments (cp'mkCertMp coopPlutus) [toData certMpParams]
110+
certSym = scriptCurrencySymbol certMp
109111
authMp = MintingPolicy $ applyArguments (cp'mkAuthMp coopPlutus) [toData authMpParams]
110-
in AuthDeployment aaAc certV certMp authMp
112+
authSym = scriptCurrencySymbol authMp
113+
in AuthDeployment aaAc certV certAddr certMp certSym authMp authSym
111114

112115
mkCoopDeployment :: CoopPlutus -> AssetClass -> AuthDeployment -> CoopDeployment
113116
mkCoopDeployment coopPlutus coopAc authDeployment =
114117
let fsV = Validator (cp'fsV coopPlutus)
118+
fsAddr = mkValidatorAddress fsV
115119
fsMp =
116120
MintingPolicy $
117121
applyArguments
118122
(cp'mkFsMp coopPlutus)
119123
[ toData
120124
( FsMpParams
121125
coopAc
122-
(mkValidatorAddress fsV)
126+
fsAddr
123127
(authParamsFromDeployment authDeployment)
124128
)
125129
]
126-
in CoopDeployment coopAc fsMp fsV authDeployment
130+
fsSym = scriptCurrencySymbol fsMp
131+
in CoopDeployment coopAc fsMp fsSym fsV fsAddr authDeployment
127132
where
128133
authParamsFromDeployment ad =
129134
AuthParams
130-
{ ap'authTokenCs = scriptCurrencySymbol (ad'authMp ad)
131-
, ap'certTokenCs = scriptCurrencySymbol (ad'certMp ad)
135+
{ ap'authTokenCs = scriptCurrencySymbol (ad'authPolicy ad)
136+
, ap'certTokenCs = scriptCurrencySymbol (ad'certPolicy ad)
132137
}
133138

134139
mintCertRedeemers :: CoopPlutus -> Integer -> Contract w s Text AssetClass
@@ -152,8 +157,8 @@ mintCertRedeemers coopPlutus q = do
152157

153158
mkMintCertTrx :: CoopDeployment -> PaymentPubKeyHash -> AssetClass -> POSIXTimeRange -> Map TxOutRef ChainIndexTxOut -> (Trx i o a, AssetClass)
154159
mkMintCertTrx coopDeployment self redeemerAc validityInterval aaOuts =
155-
let certMp = (ad'certMp . cd'auth) coopDeployment
156-
certV = (ad'certV . cd'auth) coopDeployment
160+
let certMp = (ad'certPolicy . cd'auth) coopDeployment
161+
certV = (ad'certValidator . cd'auth) coopDeployment
157162
certVAddr = validatorHash certV
158163
aaOrefs = Map.keys aaOuts
159164
certId = hashTxInputs aaOuts
@@ -204,8 +209,8 @@ burnCerts coopDeployment certRdmrAc = do
204209
when (null obsoleteCertOuts) (throwError "burnCerts: There should be some obsolete $CERT inputs")
205210

206211
(now, _) <- currentNodeClientTimeRange
207-
let certMp = (ad'certMp . cd'auth) coopDeployment
208-
certV = (ad'certV . cd'auth) coopDeployment
212+
let certMp = (ad'certPolicy . cd'auth) coopDeployment
213+
certV = (ad'certValidator . cd'auth) coopDeployment
209214
certRdmdrOrefs = Map.keys certRdmrOuts
210215
certOrefs = Map.keys obsoleteCertOuts
211216
certVal = foldMap (\out -> inv $ currencyValue (out ^. ciTxOutValue) certCs) (toList obsoleteCertOuts)
@@ -311,7 +316,7 @@ mintAuthAndCert coopDeployment authWallets nAuthTokensPerWallet certRdmrAc from
311316

312317
mkBurnAuthsTrx :: CoopDeployment -> PaymentPubKeyHash -> Map TxOutRef ChainIndexTxOut -> Trx i o a
313318
mkBurnAuthsTrx coopDeployment self authOuts = do
314-
let authMp = (ad'authMp . cd'auth) coopDeployment
319+
let authMp = (ad'authPolicy . cd'auth) coopDeployment
315320
authCs = scriptCurrencySymbol authMp
316321
authOrefs = Map.keys authOuts
317322
authVal = foldMap (\out -> inv $ currencyValue (out ^. ciTxOutValue) authCs) (toList authOuts)
@@ -339,10 +344,10 @@ getState coopDeployment = do
339344
let logI m = logInfo @String ("getState: " <> m)
340345
logI "Starting"
341346

342-
let certVAddr = mkValidatorAddress . ad'certV . cd'auth $ coopDeployment
343-
certCs = scriptCurrencySymbol . ad'certMp . cd'auth $ coopDeployment
344-
fsVAddr = mkValidatorAddress . cd'fsV $ coopDeployment
345-
fsCs = scriptCurrencySymbol . cd'fsMp $ coopDeployment
347+
let certVAddr = mkValidatorAddress . ad'certValidator . cd'auth $ coopDeployment
348+
certCs = scriptCurrencySymbol . ad'certPolicy . cd'auth $ coopDeployment
349+
fsVAddr = mkValidatorAddress . cd'fsValidator $ coopDeployment
350+
fsCs = scriptCurrencySymbol . cd'fsPolicy $ coopDeployment
346351

347352
certOuts <- findOutsAtHoldingCurrency certVAddr certCs
348353
fsOuts <- findOutsAtHoldingCurrency fsVAddr fsCs
@@ -372,19 +377,19 @@ findOutsAtCertV coopDeployment p = do
372377

373378
logI "Starting"
374379

375-
let certVAddr = (mkValidatorAddress . ad'certV . cd'auth) coopDeployment
380+
let certVAddr = (mkValidatorAddress . ad'certValidator . cd'auth) coopDeployment
376381
findOutsAt @CertDatum
377382
certVAddr
378383
(maybe False . p)
379384

380385
findOutsAtCertVWithCERT :: CoopDeployment -> Contract w s Text (Map TxOutRef ChainIndexTxOut)
381-
findOutsAtCertVWithCERT coopDeployment = findOutsAtCertV coopDeployment (\v _ -> hasCurrency v ((scriptCurrencySymbol . ad'certMp . cd'auth) coopDeployment))
386+
findOutsAtCertVWithCERT coopDeployment = findOutsAtCertV coopDeployment (\v _ -> hasCurrency v ((scriptCurrencySymbol . ad'certPolicy . cd'auth) coopDeployment))
382387

383388
findOutsAtHoldingAa :: PaymentPubKeyHash -> CoopDeployment -> Contract w s Text (Map TxOutRef ChainIndexTxOut)
384389
findOutsAtHoldingAa wallet coopDeployment = do
385390
let logI m = logInfo @String ("findOutsAtHoldingAa: " <> m)
386391
logI "Starting"
387-
let aaAc = (ad'authorityAc . cd'auth) coopDeployment
392+
let aaAc = (ad'authorityAsset . cd'auth) coopDeployment
388393
found <- findOutsAtHolding' wallet aaAc
389394
logI "Finished"
390395
return found
@@ -567,8 +572,8 @@ mkMintFsTrx ::
567572
(Value, PaymentPubKeyHash) ->
568573
Trx i o a
569574
mkMintFsTrx coopDeployment now minutes publishingSpec (feeVal, feeCollectorPpkh) = do
570-
let fsMp = cd'fsMp coopDeployment
571-
fsV = cd'fsV coopDeployment
575+
let fsMp = cd'fsPolicy coopDeployment
576+
fsV = cd'fsValidator coopDeployment
572577
fsVHash = deplFsVHash coopDeployment
573578
fsCs = deplFsCs coopDeployment
574579
authCs = deplAuthCs coopDeployment
@@ -702,8 +707,8 @@ runGcFsTx coopDeployment submit req = do
702707

703708
mkGcFsTrx :: CoopDeployment -> PaymentPubKeyHash -> [((TxOutRef, ChainIndexTxOut), FsDatum)] -> POSIXTime -> Trx i o a
704709
mkGcFsTrx coopDeployment submitterPkh fsOutsWithDatum now = do
705-
let fsMp = cd'fsMp coopDeployment
706-
fsV = cd'fsV coopDeployment
710+
let fsMp = cd'fsPolicy coopDeployment
711+
fsV = cd'fsValidator coopDeployment
707712
fsCs = deplFsCs coopDeployment
708713

709714
totalFsValToBurn =

‎coop-pab/src/Coop/Pab/Aux.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ import Control.Applicative ((<|>))
4343
import Control.Concurrent.STM (newTVarIO)
4444
import Control.Lens ((^.), (^?))
4545
import Control.Monad (filterM)
46-
import Coop.Types (AuthDeployment (ad'authMp, ad'certMp, ad'certV), CoopDeployment (cd'auth, cd'fsMp, cd'fsV), CoopPlutus)
46+
import Coop.Types (AuthDeployment (ad'authPolicy, ad'authSymbol, ad'certPolicy, ad'certValidator), CoopDeployment (cd'auth, cd'fsSymbol, cd'fsValidator), CoopPlutus)
4747
import Crypto.Hash (Blake2b_256 (Blake2b_256), hashWith)
4848
import Data.Aeson (ToJSON, decodeFileStrict)
4949
import Data.ByteArray (convert)
@@ -169,27 +169,27 @@ datumFromTxOutOrFail out msg = do
169169
maybe (throwError msg) return mayDat
170170

171171
deplCertVAddress :: CoopDeployment -> Address
172-
deplCertVAddress = mkValidatorAddress . ad'certV . cd'auth
172+
deplCertVAddress = mkValidatorAddress . ad'certValidator . cd'auth
173173

174174
deplFsVAddress :: CoopDeployment -> Address
175175
deplFsVAddress depl =
176-
let fsV = cd'fsV depl in mkValidatorAddress fsV
176+
let fsV = cd'fsValidator depl in mkValidatorAddress fsV
177177

178178
deplFsVHash :: CoopDeployment -> ValidatorHash
179179
deplFsVHash depl =
180-
let fsV = cd'fsV depl in validatorHash fsV
180+
let fsV = cd'fsValidator depl in validatorHash fsV
181181

182182
deplCertCs :: CoopDeployment -> CurrencySymbol
183-
deplCertCs = scriptCurrencySymbol . ad'certMp . cd'auth
183+
deplCertCs = scriptCurrencySymbol . ad'certPolicy . cd'auth
184184

185185
deplAuthCs :: CoopDeployment -> CurrencySymbol
186-
deplAuthCs = scriptCurrencySymbol . ad'authMp . cd'auth
186+
deplAuthCs = ad'authSymbol . cd'auth
187187

188188
deplAuthMp :: CoopDeployment -> MintingPolicy
189-
deplAuthMp = ad'authMp . cd'auth
189+
deplAuthMp = ad'authPolicy . cd'auth
190190

191191
deplFsCs :: CoopDeployment -> CurrencySymbol
192-
deplFsCs = scriptCurrencySymbol . cd'fsMp
192+
deplFsCs = cd'fsSymbol
193193

194194
findOutsAt :: forall a w s. Typeable a => FromData a => Address -> (Value -> Maybe a -> Bool) -> Contract w s Text (Map TxOutRef ChainIndexTxOut)
195195
findOutsAt addr p = do

‎coop-pab/test/Main.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ import Control.Monad (void)
1010
import Control.Monad.Reader (ReaderT)
1111
import Coop.Pab (burnAuths, burnCerts, deployCoop, findOutsAtCertVWithCERT, findOutsAtHoldingAa, mintAuthAndCert, mintCertRedeemers, mkMintAuthTrx, mkMintCertTrx, runGcFsTx, runMintFsTx, runRedistributeAuthsTrx)
1212
import Coop.Pab.Aux (DeployMode (DEPLOY_DEBUG), ciValueOf, datumFromTxOut, deplFsCs, deplFsVAddress, findOutsAt', findOutsAtHolding, findOutsAtHolding', findOutsAtHoldingCurrency, interval', loadCoopPlutus, mkMintOneShotTrx, submitTrx)
13-
import Coop.Types (AuthDeployment (ad'authorityAc, ad'certV), CoopDeployment (cd'auth, cd'coopAc), CoopPlutus (cp'mkOneShotMp), FsDatum)
13+
import Coop.Types (AuthDeployment (ad'authorityAsset, ad'certValidator), CoopDeployment (cd'auth, cd'coopAsset), CoopPlutus (cp'mkOneShotMp), FsDatum)
1414
import Data.ByteString (ByteString)
1515
import Data.Default (def)
1616
import Data.Foldable (Foldable (toList))
@@ -81,8 +81,8 @@ tests coopPlutus =
8181
logInfo @String "Running as godWallet"
8282
self <- ownFirstPaymentPubKeyHash
8383
coopDeployment <- deployCoop coopPlutus aaWallet 3 6
84-
let aaAc = ad'authorityAc . cd'auth $ coopDeployment
85-
coopAc = cd'coopAc coopDeployment
84+
let aaAc = ad'authorityAsset . cd'auth $ coopDeployment
85+
coopAc = cd'coopAsset coopDeployment
8686
aaOuts <- findOutsAtHolding' aaWallet aaAc
8787
coopOuts <- findOutsAtHolding' self coopAc
8888
return $
@@ -110,7 +110,7 @@ tests coopPlutus =
110110
let validityInterval = interval now (now + 100_000)
111111
(mintCertTrx, certAc) = mkMintCertTrx coopDeployment self certRdmrAc validityInterval aaOuts
112112
void $ submitTrx @Void mintCertTrx
113-
certOuts <- findOutsAtHolding (mkValidatorAddress . ad'certV . cd'auth $ coopDeployment) certAc
113+
certOuts <- findOutsAtHolding (mkValidatorAddress . ad'certValidator . cd'auth $ coopDeployment) certAc
114114
return [ciValueOf certAc out | out <- toList certOuts]
115115
)
116116
)

0 commit comments

Comments
 (0)