Skip to content

Commit 6b3613d

Browse files
sourabhxyzsourabhxyz
committed
feat(#355): add e2e example for blueprints
1 parent ebc0644 commit 6b3613d

File tree

21 files changed

+143
-119
lines changed

21 files changed

+143
-119
lines changed

‎atlas-cardano.cabal

+4
Original file line numberDiff line numberDiff line change
@@ -361,6 +361,7 @@ test-suite atlas-privnet-tests
361361
hs-source-dirs: tests-privnet
362362
main-is: atlas-privnet-tests.hs
363363
other-modules:
364+
GeniusYield.Test.Privnet.Blueprint
364365
GeniusYield.Test.Privnet.SimpleScripts
365366
GeniusYield.Test.Privnet.Stake
366367
GeniusYield.Test.Privnet.Stake.Key
@@ -371,8 +372,11 @@ test-suite atlas-privnet-tests
371372
build-depends:
372373
atlas-cardano:{atlas-cardano, framework-onchain-plutustx},
373374
base,
375+
base16-bytestring,
376+
bytestring,
374377
containers,
375378
lens,
379+
plutus-tx,
376380
tasty,
377381
tasty-hunit
378382

‎src/GeniusYield/Examples/Gift.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -40,10 +40,10 @@ giftScript =
4040
giftScript' :: UPLC.Term UPLC.DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()
4141
giftScript' = toDeBruijn giftScript
4242

43-
giftValidatorV1 :: GYValidator 'PlutusV1
43+
giftValidatorV1 :: GYScript 'PlutusV1
4444
giftValidatorV1 = validatorFromSerialisedScript giftValidatorPlutusSerialised
4545

46-
giftValidatorV2 :: GYValidator 'PlutusV2
46+
giftValidatorV2 :: GYScript 'PlutusV2
4747
giftValidatorV2 = validatorFromSerialisedScript giftValidatorPlutusSerialised
4848

4949
giftValidatorPlutusSerialised :: Plutus.SerialisedScript

‎src/GeniusYield/Examples/Limbo.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -39,10 +39,10 @@ limboScript =
3939
limboScript' :: UPLC.Term UPLC.DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()
4040
limboScript' = toDeBruijn limboScript
4141

42-
limboValidatorV1 :: GYValidator 'PlutusV1
42+
limboValidatorV1 :: GYScript 'PlutusV1
4343
limboValidatorV1 = validatorFromSerialisedScript limboValidatorPlutusSerialised
4444

45-
limboValidatorV2 :: GYValidator 'PlutusV2
45+
limboValidatorV2 :: GYScript 'PlutusV2
4646
limboValidatorV2 = validatorFromSerialisedScript limboValidatorPlutusSerialised
4747

4848
limboValidatorPlutusSerialised :: Plutus.SerialisedScript

‎src/GeniusYield/Examples/Treat.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -52,8 +52,8 @@ treatValidatorPlutusSerialised =
5252
Plutus.serialiseUPLC $
5353
UPLC.Program () PLC.plcVersion100 treatScript'
5454

55-
treatValidatorV1 :: GYValidator 'PlutusV1
55+
treatValidatorV1 :: GYScript 'PlutusV1
5656
treatValidatorV1 = validatorFromSerialisedScript treatValidatorPlutusSerialised
5757

58-
treatValidatorV2 :: GYValidator 'PlutusV2
58+
treatValidatorV2 :: GYScript 'PlutusV2
5959
treatValidatorV2 = validatorFromSerialisedScript treatValidatorPlutusSerialised

‎src/GeniusYield/Providers/Maestro.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -214,7 +214,7 @@ valueFromMaestro Maestro.Asset {..} = do
214214

215215
-- | Convert Maestro's script to our GY type.
216216
scriptFromMaestro :: Maestro.Script -> Either SomeDeserializeError (Maybe GYAnyScript)
217-
scriptFromMaestro Maestro.Script {..} = case scriptType of
217+
scriptFromMaestro Maestro.Script {scriptJson, scriptType, scriptBytes} = case scriptType of
218218
Maestro.Native -> case scriptJson of
219219
Nothing -> Left $ DeserializeErrorImpossibleBranch "UTxO has native script but no script JSON is present"
220220
Just sj -> pure $ GYSimpleScript <$> simpleScriptFromJSON sj

‎src/GeniusYield/Test/Privnet/Examples/Gift.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -593,7 +593,7 @@ giftCleanup ctx = do
593593
grabGifts ::
594594
forall u v m.
595595
(GYTxQueryMonad m, VersionIsGreaterOrEqual v u) =>
596-
GYValidator v ->
596+
GYScript v ->
597597
m (Maybe (GYTxSkeleton u))
598598
grabGifts validator = do
599599
addr <- scriptAddress validator
@@ -622,7 +622,7 @@ grabGifts validator = do
622622
grabGiftsRef ::
623623
GYTxQueryMonad m =>
624624
GYTxOutRef ->
625-
GYValidator 'PlutusV2 ->
625+
GYScript 'PlutusV2 ->
626626
m (Maybe (GYTxSkeleton 'PlutusV2))
627627
grabGiftsRef ref validator = do
628628
addr <- scriptAddress validator

‎src/GeniusYield/Test/Privnet/Examples/Oracle.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ import GeniusYield.Test.Privnet.Setup
2424
import GeniusYield.TxBuilder
2525
import GeniusYield.Types
2626

27-
readOracleValidatorV2 :: GYValidator 'PlutusV2
27+
readOracleValidatorV2 :: GYScript 'PlutusV2
2828
readOracleValidatorV2 = validatorFromPlutus readOracleValidator
2929

3030
tests :: Setup -> TestTree

‎src/GeniusYield/Test/Privnet/Examples/Treat.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,7 @@ tests setup =
9090
grabTreats ::
9191
forall u v m.
9292
(GYTxUserQueryMonad m, VersionIsGreaterOrEqual v u) =>
93-
GYValidator v ->
93+
GYScript v ->
9494
m (Maybe (GYTxSkeleton u))
9595
grabTreats validator = do
9696
addr <- scriptAddress validator

‎src/GeniusYield/TxBuilder/Class.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -533,13 +533,13 @@ enclosingSlotFromTime' x = do
533533
-------------------------------------------------------------------------------
534534

535535
-- | Calculate script's address.
536-
scriptAddress :: GYTxQueryMonad m => GYValidator v -> m GYAddress
536+
scriptAddress :: GYTxQueryMonad m => GYScript v -> m GYAddress
537537
scriptAddress v = do
538538
nid <- networkId
539539
return $ addressFromValidator nid v
540540

541541
-- | Calculate script's address.
542-
scriptAddress' :: GYTxQueryMonad m => GYValidatorHash -> m GYAddress
542+
scriptAddress' :: GYTxQueryMonad m => GYScriptHash -> m GYAddress
543543
scriptAddress' h = do
544544
nid <- networkId
545545
return $ addressFromValidatorHash nid h
@@ -582,18 +582,18 @@ addressToPubKeyHashIO addr =
582582
pure
583583
(addressToPubKeyHash addr)
584584

585-
{- | Convert 'GYAddress' to 'GYValidatorHash' in 'GYTxMonad'.
585+
{- | Convert 'GYAddress' to 'GYScriptHash' in 'GYTxMonad'.
586586
587587
Throw 'GYConversionException' if address is not script-hash one.
588588
-}
589-
addressToValidatorHash' :: MonadError GYTxMonadException m => GYAddress -> m GYValidatorHash
589+
addressToValidatorHash' :: MonadError GYTxMonadException m => GYAddress -> m GYScriptHash
590590
addressToValidatorHash' addr =
591591
maybe
592592
(throwError . GYConversionException $ GYNotPubKeyAddress addr)
593593
pure
594594
(addressToValidatorHash addr)
595595

596-
addressToValidatorHashIO :: GYAddress -> IO GYValidatorHash
596+
addressToValidatorHashIO :: GYAddress -> IO GYScriptHash
597597
addressToValidatorHashIO addr =
598598
maybe
599599
(throwIO . GYConversionException $ GYNotScriptAddress addr)

‎src/GeniusYield/Types/Address.hs

+14-6
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ module GeniusYield.Types.Address (
1717
addressToStakeCredential,
1818
addressFromPubKeyHash,
1919
addressFromPaymentKeyHash,
20+
addressFromScript,
2021
addressFromValidator,
2122
addressFromCredential,
2223
addressFromValidatorHash,
@@ -325,11 +326,11 @@ addressFromPaymentKeyHash nid pkh =
325326
(Api.S.PaymentCredentialByKey (paymentKeyHashToApi pkh))
326327
Api.S.NoStakeAddress
327328

328-
{- | Create address from 'GYValidatorHash'.
329+
{- | Create address from 'GYScriptHash'.
329330
330331
/note:/ no stake credential.
331332
-}
332-
addressFromValidatorHash :: GYNetworkId -> GYValidatorHash -> GYAddress
333+
addressFromValidatorHash :: GYNetworkId -> GYScriptHash -> GYAddress
333334
addressFromValidatorHash nid vh = addressFromScriptHash' nid (validatorHashToApi vh)
334335

335336
-- | Create address from 'GYScriptHash'.
@@ -359,11 +360,18 @@ addressFromCredential nid pc sc =
359360
(paymentCredentialToApi pc)
360361
(maybe Api.S.NoStakeAddress (Api.S.StakeAddressByValue . stakeCredentialToApi) sc)
361362

362-
{- | Create address from 'GYValidator'.
363+
{- | Create address from 'GYScript'.
363364
364365
/note:/ no stake credential.
365366
-}
366-
addressFromValidator :: GYNetworkId -> GYValidator v -> GYAddress
367+
addressFromScript :: GYNetworkId -> GYScript v -> GYAddress
368+
addressFromScript nid v = addressFromScriptHash nid (scriptHash v)
369+
370+
{- | Create address from 'GYScript'.
371+
372+
/note:/ no stake credential.
373+
-}
374+
addressFromValidator :: GYNetworkId -> GYScript v -> GYAddress
367375
addressFromValidator nid v = addressFromValidatorHash nid (validatorHash v)
368376

369377
addressToPubKeyHash :: GYAddress -> Maybe GYPubKeyHash
@@ -375,11 +383,11 @@ addressToPubKeyHash (GYAddress (Api.AddressShelley (Api.S.ShelleyAddress _networ
375383
f (Api.S.PaymentCredentialByKey h) = Just (pubKeyHashFromApi h)
376384
f (Api.S.PaymentCredentialByScript _) = Nothing
377385

378-
addressToValidatorHash :: GYAddress -> Maybe GYValidatorHash
386+
addressToValidatorHash :: GYAddress -> Maybe GYScriptHash
379387
addressToValidatorHash (GYAddress (Api.AddressByron _)) = Nothing
380388
addressToValidatorHash (GYAddress (Api.AddressShelley (Api.S.ShelleyAddress _network credential _stake))) = f (Api.S.fromShelleyPaymentCredential credential)
381389
where
382-
f :: Api.S.PaymentCredential -> Maybe GYValidatorHash
390+
f :: Api.S.PaymentCredential -> Maybe GYScriptHash
383391
f (Api.S.PaymentCredentialByKey _) = Nothing
384392
f (Api.S.PaymentCredentialByScript h) = Just (validatorHashFromApi h)
385393

‎src/GeniusYield/Types/Blueprint.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -61,4 +61,4 @@ encodeBlueprint =
6161
. toJSON
6262

6363
readBlueprint :: FilePath -> IO ContractBlueprint
64-
readBlueprint = readJSON
64+
readBlueprint = readJSON

‎src/GeniusYield/Types/Script.hs

+11-56
Original file line numberDiff line numberDiff line change
@@ -111,6 +111,7 @@ module GeniusYield.Types.Script (
111111

112112
-- * Script
113113
GYScript,
114+
scriptHash,
114115
hashScript,
115116
scriptVersion,
116117
validatorToScript,
@@ -191,18 +192,12 @@ import Web.HttpApiData qualified as Web
191192
-- Validator
192193
-------------------------------------------------------------------------------
193194

194-
newtype GYValidator v = GYValidator (GYScript v)
195-
deriving (Eq, Ord, Show)
196-
197-
deriving newtype instance GEq GYValidator
198-
deriving newtype instance GCompare GYValidator
199-
200-
instance GShow GYValidator where
201-
gshowsPrec = showsPrec
195+
{-# DEPRECATED GYValidator "Use GYScript." #-}
196+
type GYValidator v = GYScript v
202197

203198
-- FIXME: Seeing inclusion of CIP-69, we should likely get rid of all these different types of scripts and just have one type of script.
204199
-- To make it use BuiltinUnit.
205-
validatorFromPlutus :: forall v. SingPlutusVersionI v => PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ()) -> GYValidator v
200+
validatorFromPlutus :: forall v a. SingPlutusVersionI v => PlutusTx.CompiledCode a -> GYValidator v
206201
validatorFromPlutus = coerce (scriptFromPlutus @v)
207202

208203
validatorFromSerialisedScript :: forall v. SingPlutusVersionI v => Plutus.SerialisedScript -> GYValidator v
@@ -221,7 +216,7 @@ validatorFromApi :: forall v. SingPlutusVersionI v => Api.PlutusScript (PlutusVe
221216
validatorFromApi = coerce (scriptFromApi @v)
222217

223218
validatorHash :: GYValidator v -> GYValidatorHash
224-
validatorHash = coerce scriptApiHash
219+
validatorHash = coerce scriptHash
225220

226221
validatorPlutusHash :: GYValidator v -> PlutusV1.ScriptHash
227222
validatorPlutusHash = coerce scriptPlutusHash
@@ -238,8 +233,8 @@ validatorToApiPlutusScriptWitness ::
238233
Api.ScriptRedeemer ->
239234
Api.ExecutionUnits ->
240235
Api.ScriptWitness Api.WitCtxTxIn ApiEra
241-
validatorToApiPlutusScriptWitness (GYValidator s) =
242-
scriptToApiPlutusScriptWitness s
236+
validatorToApiPlutusScriptWitness =
237+
scriptToApiPlutusScriptWitness
243238

244239
-- | Writes a validator to a file.
245240
writeValidator :: FilePath -> GYValidator v -> IO ()
@@ -249,50 +244,6 @@ writeValidator file = writeScriptCore "Validator" file . coerce
249244
readValidator :: SingPlutusVersionI v => FilePath -> IO (GYValidator v)
250245
readValidator = coerce readScript
251246

252-
newtype GYValidatorHash = GYValidatorHash Api.ScriptHash
253-
deriving stock (Show, Eq, Ord)
254-
255-
{- |
256-
257-
>>> "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0" :: GYValidatorHash
258-
GYValidatorHash "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0"
259-
-}
260-
instance IsString GYValidatorHash where
261-
fromString = GYValidatorHash . fromString
262-
263-
{- |
264-
265-
>>> printf "%s" ("cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0" :: GYValidatorHash)
266-
cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0
267-
-}
268-
instance Printf.PrintfArg GYValidatorHash where
269-
formatArg (GYValidatorHash h) = formatArg $ init $ tail $ show h
270-
271-
validatorHashToPlutus :: GYValidatorHash -> PlutusV1.ScriptHash
272-
validatorHashToPlutus = apiHashToPlutus . validatorHashToApi
273-
274-
validatorHashToApi :: GYValidatorHash -> Api.ScriptHash
275-
validatorHashToApi = coerce
276-
277-
validatorHashFromApi :: Api.ScriptHash -> GYValidatorHash
278-
validatorHashFromApi = coerce
279-
280-
{- |
281-
282-
>>> validatorHashFromPlutus "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0"
283-
Right (GYValidatorHash "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0")
284-
285-
>>> validatorHashFromPlutus "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7"
286-
Left (DeserialiseRawBytesError {ptceTag = "validatorHashFromPlutus: cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7, error: SerialiseAsRawBytesError {unSerialiseAsRawBytesError = \"Unable to deserialise ScriptHash\"}"})
287-
-}
288-
validatorHashFromPlutus :: PlutusV1.ScriptHash -> Either PlutusToCardanoError GYValidatorHash
289-
validatorHashFromPlutus vh@(PlutusV1.ScriptHash ibs) =
290-
bimap
291-
(\e -> DeserialiseRawBytesError $ Text.pack $ "validatorHashFromPlutus: " <> show vh <> ", error: " <> show e)
292-
validatorHashFromApi
293-
$ Api.deserialiseFromRawBytes Api.AsScriptHash
294-
$ PlutusTx.fromBuiltin ibs
295-
296247
-------------------------------------------------------------------------------
297248
-- Minting Policy
298249
-------------------------------------------------------------------------------
@@ -684,6 +635,10 @@ instance GShow GYScript where
684635

685636
-- In implementation we cache the api representation and hashes.
686637

638+
scriptHash :: GYScript v -> GYScriptHash
639+
scriptHash = hashScript
640+
641+
{-# DEPRECATED hashScript "Use scriptHash." #-}
687642
hashScript :: GYScript v -> GYScriptHash
688643
hashScript = scriptApiHash >>> scriptHashFromApi
689644

‎src/GeniusYield/Types/Script/ScriptHash.hs

+35
Original file line numberDiff line numberDiff line change
@@ -13,13 +13,20 @@ module GeniusYield.Types.Script.ScriptHash (
1313
scriptHashFromLedger,
1414
apiHashToPlutus,
1515
scriptHashToPlutus,
16+
GYValidatorHash,
17+
validatorHashToPlutus,
18+
validatorHashFromPlutus,
19+
validatorHashToApi,
20+
validatorHashFromApi,
1621
) where
1722

1823
import Cardano.Api qualified as Api
1924
import Cardano.Api.Ledger qualified as Ledger
2025
import Cardano.Api.Script qualified as Api
2126
import Cardano.Ledger.Hashes qualified as Ledger
27+
import Data.Text qualified as Text
2228
import GeniusYield.Imports
29+
import GeniusYield.Types.Ledger (PlutusToCardanoError (..))
2330
import PlutusLedgerApi.V1 qualified as PlutusV1
2431
import PlutusTx.Builtins qualified as PlutusTx
2532
import Text.Printf qualified as Printf
@@ -75,3 +82,31 @@ apiHashToPlutus h = PlutusV1.ScriptHash $ PlutusTx.toBuiltin $ Api.serialiseToRa
7582

7683
scriptHashToPlutus :: GYScriptHash -> PlutusV1.ScriptHash
7784
scriptHashToPlutus = scriptHashToApi >>> apiHashToPlutus
85+
86+
{-# DEPRECATED GYValidatorHash "Use GYScriptHash." #-}
87+
type GYValidatorHash = GYScriptHash
88+
89+
validatorHashToPlutus :: GYValidatorHash -> PlutusV1.ScriptHash
90+
validatorHashToPlutus = apiHashToPlutus . validatorHashToApi
91+
92+
{- |
93+
94+
>>> validatorHashFromPlutus "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0"
95+
Right (GYScriptHash "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7d0")
96+
97+
>>> validatorHashFromPlutus "cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7"
98+
Left (DeserialiseRawBytesError {ptceTag = "validatorHashFromPlutus: cabdd19b58d4299fde05b53c2c0baf978bf9ade734b490fc0cc8b7, error: SerialiseAsRawBytesError {unSerialiseAsRawBytesError = \"Unable to deserialise ScriptHash\"}"})
99+
-}
100+
validatorHashFromPlutus :: PlutusV1.ScriptHash -> Either PlutusToCardanoError GYValidatorHash
101+
validatorHashFromPlutus vh@(PlutusV1.ScriptHash ibs) =
102+
bimap
103+
(\e -> DeserialiseRawBytesError $ Text.pack $ "validatorHashFromPlutus: " <> show vh <> ", error: " <> show e)
104+
validatorHashFromApi
105+
$ Api.deserialiseFromRawBytes Api.AsScriptHash
106+
$ PlutusTx.fromBuiltin ibs
107+
108+
validatorHashToApi :: GYValidatorHash -> Api.ScriptHash
109+
validatorHashToApi = coerce
110+
111+
validatorHashFromApi :: Api.ScriptHash -> GYValidatorHash
112+
validatorHashFromApi = coerce

‎src/GeniusYield/Types/TxIn.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ data GYTxInWitness v
5151

5252
data GYInScript (u :: PlutusVersion) where
5353
-- | 'VersionIsGreaterOrEqual' restricts which version validators can be used in this transaction.
54-
GYInScript :: forall u v. v `VersionIsGreaterOrEqual` u => GYValidator v -> GYInScript u
54+
GYInScript :: forall u v. v `VersionIsGreaterOrEqual` u => GYScript v -> GYInScript u
5555
-- | Reference inputs can be only used in V2 transactions.
5656
GYInReference :: forall v. v `VersionIsGreaterOrEqual` 'PlutusV2 => !GYTxOutRef -> !(GYScript v) -> GYInScript v
5757

0 commit comments

Comments
 (0)