Skip to content

Commit ad6f57e

Browse files
j-muellerj-mueller
committed
Generate blueprint from aiken, load blueprint in haskell
1 parent a4baf6a commit ad6f57e

File tree

12 files changed

+256
-1
lines changed

12 files changed

+256
-1
lines changed

‎.github/workflows/ci-compiled-scripts.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,4 +48,5 @@ jobs:
4848
cabal run export-smart-tokens ./generated/scripts/preview 08a8d0bb8717839931b0a594f7c28b0a3b7c78f6e9172e977e250eab7637d879.0 '"addr_test1qq986m3uel86pl674mkzneqtycyg7csrdgdxj6uf7v7kd857kquweuh5kmrj28zs8czrwkl692jm67vna2rf7xtafhpqk3hecm"'
4949
cabal run export-smart-tokens ./generated/scripts/mainnet b1977c1eb33590ca1311384ab68cd36209832213ad4483feb8a1b7cb64828946.0 '"addr_test1qq986m3uel86pl674mkzneqtycyg7csrdgdxj6uf7v7kd857kquweuh5kmrj28zs8czrwkl692jm67vna2rf7xtafhpqk3hecm"'
5050
cabal run write-openapi-schema -- generated/openapi/schema.json
51+
nix develop --command bash -c "aiken build src/aiken-example/aiken --out ./generated/aiken/aiken-scripts.json"
5152
git diff --quiet

‎cabal.project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ with-compiler: ghc-9.6.6
3737
packages:
3838
src/programmable-tokens
3939
src/regulated-stablecoin
40-
40+
src/aiken-example/haskell
4141

4242
source-repository-package
4343
type: git

‎src/aiken-policy/plutus.json renamed to ‎generated/aiken/aiken-scripts.json

File renamed without changes.

‎src/aiken-policy/.github/workflows/continuous-integration.yml renamed to ‎src/aiken-example/aiken/.github/workflows/continuous-integration.yml

File renamed without changes.

‎src/aiken-policy/.gitignore renamed to ‎src/aiken-example/aiken/.gitignore

File renamed without changes.

‎src/aiken-policy/README.md renamed to ‎src/aiken-example/aiken/README.md

File renamed without changes.

‎src/aiken-policy/aiken.lock renamed to ‎src/aiken-example/aiken/aiken.lock

File renamed without changes.

‎src/aiken-policy/aiken.toml renamed to ‎src/aiken-example/aiken/aiken.toml

File renamed without changes.

‎src/aiken-example/aiken/plutus.json

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
{
2+
"preamble": {
3+
"title": "wsc-poc/aiken-policy",
4+
"description": "Aiken contracts for project 'wsc-poc/aiken-policy'",
5+
"version": "0.0.0",
6+
"plutusVersion": "v3",
7+
"compiler": {
8+
"name": "Aiken",
9+
"version": "v1.1.9+unknown"
10+
},
11+
"license": "Apache-2.0"
12+
},
13+
"validators": [
14+
{
15+
"title": "placeholder.placeholder.mint",
16+
"redeemer": {
17+
"title": "_redeemer",
18+
"schema": {
19+
"$ref": "#/definitions/Data"
20+
}
21+
},
22+
"compiledCode": "58c701010032323232322533300232323232323253330083370e900000089931bae300b300a37540042a66601066e1d200200113233226300c001300c300d001300a37540042a66601066e1d20040011326300b300a37540042a66601066e1d200600113233226375a60180026018601a00260146ea800854ccc020cdc3a4010002264c601660146ea80084c8cc898dd698060009806180680098051baa00230083754002601260140066010004600e004600e00260086ea8004526136565734aae7555cf2ba157441",
23+
"hash": "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f"
24+
},
25+
{
26+
"title": "placeholder.placeholder.spend",
27+
"datum": {
28+
"title": "_datum",
29+
"schema": {
30+
"$ref": "#/definitions/Data"
31+
}
32+
},
33+
"redeemer": {
34+
"title": "_redeemer",
35+
"schema": {
36+
"$ref": "#/definitions/Data"
37+
}
38+
},
39+
"compiledCode": "58c701010032323232322533300232323232323253330083370e900000089931bae300b300a37540042a66601066e1d200200113233226300c001300c300d001300a37540042a66601066e1d20040011326300b300a37540042a66601066e1d200600113233226375a60180026018601a00260146ea800854ccc020cdc3a4010002264c601660146ea80084c8cc898dd698060009806180680098051baa00230083754002601260140066010004600e004600e00260086ea8004526136565734aae7555cf2ba157441",
40+
"hash": "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f"
41+
},
42+
{
43+
"title": "placeholder.placeholder.withdraw",
44+
"redeemer": {
45+
"title": "_redeemer",
46+
"schema": {
47+
"$ref": "#/definitions/Data"
48+
}
49+
},
50+
"compiledCode": "58c701010032323232322533300232323232323253330083370e900000089931bae300b300a37540042a66601066e1d200200113233226300c001300c300d001300a37540042a66601066e1d20040011326300b300a37540042a66601066e1d200600113233226375a60180026018601a00260146ea800854ccc020cdc3a4010002264c601660146ea80084c8cc898dd698060009806180680098051baa00230083754002601260140066010004600e004600e00260086ea8004526136565734aae7555cf2ba157441",
51+
"hash": "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f"
52+
},
53+
{
54+
"title": "placeholder.placeholder.publish",
55+
"redeemer": {
56+
"title": "_redeemer",
57+
"schema": {
58+
"$ref": "#/definitions/Data"
59+
}
60+
},
61+
"compiledCode": "58c701010032323232322533300232323232323253330083370e900000089931bae300b300a37540042a66601066e1d200200113233226300c001300c300d001300a37540042a66601066e1d20040011326300b300a37540042a66601066e1d200600113233226375a60180026018601a00260146ea800854ccc020cdc3a4010002264c601660146ea80084c8cc898dd698060009806180680098051baa00230083754002601260140066010004600e004600e00260086ea8004526136565734aae7555cf2ba157441",
62+
"hash": "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f"
63+
},
64+
{
65+
"title": "placeholder.placeholder.vote",
66+
"redeemer": {
67+
"title": "_redeemer",
68+
"schema": {
69+
"$ref": "#/definitions/Data"
70+
}
71+
},
72+
"compiledCode": "58c701010032323232322533300232323232323253330083370e900000089931bae300b300a37540042a66601066e1d200200113233226300c001300c300d001300a37540042a66601066e1d20040011326300b300a37540042a66601066e1d200600113233226375a60180026018601a00260146ea800854ccc020cdc3a4010002264c601660146ea80084c8cc898dd698060009806180680098051baa00230083754002601260140066010004600e004600e00260086ea8004526136565734aae7555cf2ba157441",
73+
"hash": "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f"
74+
},
75+
{
76+
"title": "placeholder.placeholder.propose",
77+
"redeemer": {
78+
"title": "_redeemer",
79+
"schema": {
80+
"$ref": "#/definitions/Data"
81+
}
82+
},
83+
"compiledCode": "58c701010032323232322533300232323232323253330083370e900000089931bae300b300a37540042a66601066e1d200200113233226300c001300c300d001300a37540042a66601066e1d20040011326300b300a37540042a66601066e1d200600113233226375a60180026018601a00260146ea800854ccc020cdc3a4010002264c601660146ea80084c8cc898dd698060009806180680098051baa00230083754002601260140066010004600e004600e00260086ea8004526136565734aae7555cf2ba157441",
84+
"hash": "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f"
85+
},
86+
{
87+
"title": "placeholder.placeholder.else",
88+
"redeemer": {
89+
"schema": {}
90+
},
91+
"compiledCode": "58c701010032323232322533300232323232323253330083370e900000089931bae300b300a37540042a66601066e1d200200113233226300c001300c300d001300a37540042a66601066e1d20040011326300b300a37540042a66601066e1d200600113233226375a60180026018601a00260146ea800854ccc020cdc3a4010002264c601660146ea80084c8cc898dd698060009806180680098051baa00230083754002601260140066010004600e004600e00260086ea8004526136565734aae7555cf2ba157441",
92+
"hash": "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f"
93+
}
94+
],
95+
"definitions": {
96+
"Data": {
97+
"title": "Data",
98+
"description": "Any Plutus data."
99+
}
100+
}
101+
}

‎src/aiken-policy/validators/placeholder.ak renamed to ‎src/aiken-example/aiken/validators/placeholder.ak

File renamed without changes.

‎src/aiken-example/haskell/aiken-example.cabal

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
cabal-version: 3.4
2+
name: aiken-example
3+
version: 0.3.0.0
4+
synopsis:
5+
Using an aiken script as the transfer policy of a CIP-0143 programmable token
6+
7+
license: Apache-2.0
8+
license-files: LICENSE
9+
maintainer: [email protected]
10+
author: Djed team @ IOG
11+
homepage: https://github.com/input-output-hk/wsc-poc
12+
bug-reports: https://github.com/input-output-hk/wsc-poc
13+
description:
14+
Please see the README on GitHub at <https://github.com/input-output-hk/wst-poc>
15+
16+
common lang
17+
default-language: Haskell2010
18+
default-extensions:
19+
DataKinds
20+
DeriveAnyClass
21+
DeriveFoldable
22+
DeriveFunctor
23+
DeriveGeneric
24+
DeriveLift
25+
DeriveTraversable
26+
DerivingStrategies
27+
DerivingVia
28+
ExplicitForAll
29+
FlexibleContexts
30+
GADTs
31+
GeneralizedNewtypeDeriving
32+
ImportQualifiedPost
33+
KindSignatures
34+
LambdaCase
35+
MultiParamTypeClasses
36+
NumericUnderscores
37+
RankNTypes
38+
ScopedTypeVariables
39+
StandaloneDeriving
40+
TypeApplications
41+
TypeFamilies
42+
TypeOperators
43+
ViewPatterns
44+
45+
ghc-options:
46+
-Wall -Wnoncanonical-monad-instances -Wunused-packages
47+
-Wincomplete-uni-patterns -Wincomplete-record-updates
48+
-Wredundant-constraints -Widentities
49+
50+
library
51+
import: lang
52+
exposed-modules: Wst.Aiken.Blueprint
53+
hs-source-dirs: lib
54+
build-depends:
55+
, aeson
56+
, base
57+
, bytestring
58+
, cardano-api
59+
, containers
60+
, text

‎src/aiken-example/haskell/lib/Wst/Aiken/Blueprint.hs

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE TupleSections #-}
4+
-- TODO: This can probably move to sc-tools
5+
6+
-- | Reading plutus scripts from blueprint JSON files
7+
module Wst.Aiken.Blueprint (
8+
BlueprintScriptVersion (..),
9+
Blueprint (..),
10+
BlueprintValidator (..),
11+
Preamble (..),
12+
BlueprintKey (..),
13+
loadFromFile,
14+
deserialise,
15+
)
16+
where
17+
18+
import Cardano.Api (AnyPlutusScriptVersion, ScriptInAnyLang)
19+
import Cardano.Api qualified as C
20+
import Data.Aeson (FromJSON (..), ToJSON (..), withObject, (.:))
21+
import Data.Aeson qualified as Aeson
22+
import Data.Bifunctor (Bifunctor (..))
23+
import Data.ByteString qualified as BS
24+
import Data.ByteString.Lazy qualified as BSL
25+
import Data.Map (Map)
26+
import Data.Map qualified as Map
27+
import Data.Proxy (Proxy (..))
28+
import Data.Text (Text)
29+
import Data.Text qualified as T
30+
import Data.Text.Encoding qualified as TE
31+
import GHC.Generics (Generic)
32+
33+
-- | Plutus script version with a blueprint-specific JSON encoding
34+
newtype BlueprintScriptVersion = BlueprintScriptVersion AnyPlutusScriptVersion
35+
deriving stock (Eq, Show)
36+
37+
instance ToJSON BlueprintScriptVersion where
38+
toJSON (BlueprintScriptVersion (C.AnyPlutusScriptVersion k)) = case k of
39+
C.PlutusScriptV1 -> toJSON @String "v1"
40+
C.PlutusScriptV2 -> toJSON @String "v2"
41+
C.PlutusScriptV3 -> toJSON @String "v3"
42+
43+
instance FromJSON BlueprintScriptVersion where
44+
parseJSON = fmap (fmap BlueprintScriptVersion) $ Aeson.withText "BlueprintScriptVersion" $ \x -> case T.unpack x of
45+
"v1" -> pure (C.AnyPlutusScriptVersion C.PlutusScriptV1)
46+
"v2" -> pure (C.AnyPlutusScriptVersion C.PlutusScriptV2)
47+
"v3" -> pure (C.AnyPlutusScriptVersion C.PlutusScriptV3)
48+
v -> fail $ "Unexpected plutus script version: " <> v
49+
50+
data Blueprint = Blueprint
51+
{ preamble :: Preamble
52+
, validators :: [BlueprintValidator]
53+
}
54+
deriving stock (Eq, Show, Generic)
55+
deriving anyclass (FromJSON)
56+
57+
data BlueprintValidator = BlueprintValidator
58+
{ title :: BlueprintKey
59+
, compiledCode :: Text
60+
, hash :: Text
61+
}
62+
deriving stock (Eq, Show, Generic)
63+
deriving anyclass (ToJSON, FromJSON)
64+
65+
data Preamble = Preamble
66+
{ description :: Text
67+
, plutusVersion :: BlueprintScriptVersion
68+
}
69+
deriving stock (Eq, Show, Generic)
70+
71+
instance FromJSON Preamble where
72+
parseJSON = withObject "Preamble" $ \obj ->
73+
Preamble
74+
<$> obj .: "description"
75+
<*> obj .: "plutusVersion"
76+
77+
newtype BlueprintKey = BlueprintKey {unBlueprintKey :: Text}
78+
deriving newtype (Eq, Ord, Show, ToJSON, FromJSON)
79+
80+
loadFromFile :: FilePath -> IO (Either String Blueprint)
81+
loadFromFile fp = Aeson.eitherDecode . BSL.fromStrict <$> BS.readFile fp
82+
83+
deserialise :: Blueprint -> Either String (Map BlueprintKey ScriptInAnyLang)
84+
deserialise Blueprint{preamble = Preamble{plutusVersion = BlueprintScriptVersion v}, validators} =
85+
Map.fromList <$> traverse (deserialiseScript v) validators
86+
87+
deserialiseScript :: AnyPlutusScriptVersion -> BlueprintValidator -> Either String (BlueprintKey, ScriptInAnyLang)
88+
deserialiseScript (C.AnyPlutusScriptVersion v) BlueprintValidator{title, compiledCode} =
89+
let lng = C.PlutusScriptLanguage v
90+
in fmap ((title,) . C.ScriptInAnyLang lng . C.PlutusScript v) (deserialisePlutus v compiledCode)
91+
92+
deserialisePlutus :: forall lang. (C.HasTypeProxy lang) => C.PlutusScriptVersion lang -> Text -> Either String (C.PlutusScript lang)
93+
deserialisePlutus _ text = first show $ C.deserialiseFromCBOR (C.proxyToAsType $ Proxy @(C.PlutusScript lang)) (TE.encodeUtf8 text)

0 commit comments

Comments
 (0)