From 436a3afd86fcf6e88814ae024895f98473123fc6 Mon Sep 17 00:00:00 2001 From: Christian Hoener zu Siederdissen Date: Wed, 18 Dec 2024 18:11:05 +0100 Subject: [PATCH 1/2] Provide BlackListNode and PBlackListNode Plutarch code (#5) * Derivation code for BlackListNode and PBlacklistNode * _printTerm code by Philip to show how a compiled term looks like as a string. * Code lens that shows how a small term is evaluated. The code lens is not necessary, and is just a "comment". It can, however, be evaluated by HLS and gives quick feedback. --- src/lib/SmartTokens/Types/PTokenDirectory.hs | 107 ++++++++++++------- 1 file changed, 70 insertions(+), 37 deletions(-) diff --git a/src/lib/SmartTokens/Types/PTokenDirectory.hs b/src/lib/SmartTokens/Types/PTokenDirectory.hs index ad86028..a0f6392 100644 --- a/src/lib/SmartTokens/Types/PTokenDirectory.hs +++ b/src/lib/SmartTokens/Types/PTokenDirectory.hs @@ -21,72 +21,91 @@ module SmartTokens.Types.PTokenDirectory ( pisInsertedNode, pletFieldsBlacklistNode, pisEmptyNode, + BlacklistNode(..), ) where import Generics.SOP qualified as SOP -import Plutarch (Config (NoTracing)) -import Plutarch.Builtin (pasByteStr, pasConstr, pasList, pforgetData, plistData) +import Plutarch ( Config(NoTracing), Config(NoTracing) ) +import Plutarch.Builtin + ( pasByteStr, + pasConstr, + pasList, + pforgetData, + plistData, + pforgetData, + plistData ) import Plutarch.Core.PlutusDataList (DerivePConstantViaDataList (..), PlutusTypeDataList, ProductIsData (..)) import Plutarch.Core.Utils (pcond, pheadSingleton, pmkBuiltinList) import Plutarch.DataRepr (PDataFields) import Plutarch.DataRepr.Internal.Field (HRec (..), Labeled (Labeled)) import Plutarch.Evaluate (unsafeEvalTerm) -import Plutarch.Internal.PlutusType (pcon', pmatch') import Plutarch.LedgerApi.V3 (PCredential, PCurrencySymbol) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.List import Plutarch.Prelude import Plutarch.Unsafe (punsafeCoerce) -import PlutusLedgerApi.V3 (Credential, CurrencySymbol) +import PlutusLedgerApi.V3 + ( Credential, CurrencySymbol, BuiltinByteString ) import PlutusTx (Data (B, Constr)) import PlutusTx qualified +import Plutarch.DataRepr.Internal +import GHC.Stack (HasCallStack) +import Plutarch.Internal.Other (printScript) +import qualified Data.Text as T +import qualified Plutarch.Internal as PI -pdeserializeCredential :: Term s (PAsData PCredential) -> Term s (PAsData PCredential) -pdeserializeCredential term = - plet (pasConstr # pforgetData term) $ \constrPair -> - plet (pfstBuiltin # constrPair) $ \constrIdx -> - pif (plengthBS # (pasByteStr # (pheadSingleton # (psndBuiltin # constrPair))) #== 28) - ( - pcond - [ ( constrIdx #== 0 , term) - , ( constrIdx #== 1 , term) - ] - perror - ) - perror --- data BlackListNode = --- BlackListNode { --- key :: BuiltinByteString, --- next :: BuiltinByteString --- } + +data BlacklistNode = + BlacklistNode { + blnKey :: BuiltinByteString, + blnNext :: BuiltinByteString + } + deriving stock (Show, Eq, Generic) + deriving anyclass (SOP.Generic) + deriving + (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) via (ProductIsData BlacklistNode) + +deriving via (DerivePConstantViaData BlacklistNode PBlacklistNode) + instance (PConstantDecl BlacklistNode) newtype PBlacklistNode (s :: S) = PBlacklistNode ( Term s ( PDataRecord - '[ "key" ':= PByteString - , "next" ':= PByteString + '[ "blnKey" ':= PByteString + , "blnNext" ':= PByteString ] ) ) deriving stock (Generic) + deriving anyclass (PlutusType, PDataFields, PIsData) + +instance DerivePlutusType PBlacklistNode where + type DPTStrat PBlacklistNode = PlutusTypeData + +instance PUnsafeLiftDecl PBlacklistNode where + type PLifted PBlacklistNode = BlacklistNode + + + +-- _printTerm (communicated by Philip) just print some term as string. The term we want to print is +-- @ +-- _term :: forall {s :: S}. Term s PBlacklistNode +-- _term = unsafeEvalTerm NoTracing (pconstant $ BlackListNode { key = "a", next = "b" }) +-- @ +-- Below, we inline the term and have it in a code lens. You can even run the code lens via Haskell +-- language server. The lens will then replace the string starting with "program ..." with exactly +-- the same string. +-- +-- >>> _printTerm NoTracing $ unsafeEvalTerm NoTracing (pconstant $ BlacklistNode { blnKey = "a hi", blnNext = "a" }) +-- "program 1.0.0 (List [B #61206869, B #61])" +_printTerm :: HasCallStack => Config -> ClosedTerm a -> String +_printTerm config term = printScript $ either (error . T.unpack) id $ PI.compile config term + --- TODO: --- The reason we have to manually implement this is because the PlutusTypeDataList DerivePlutusType strategy --- breaks when we use PByteString fields probably due to the fact that the PLifted/PConstant instances use ByteString --- instead of BuiltinByteString. We should fix the PlutusTypeDataList strategy to work with PByteString fields. -instance PlutusType PBlacklistNode where - type PInner PBlacklistNode = PDataRecord '[ "key" ':= PByteString, "next" ':= PByteString ] - pcon' (PBlacklistNode t1) = t1 - pmatch' xs f = - plet (pto xs) $ \innerFieldList -> - let key_ = phead # innerFieldList - in plet (ptail # innerFieldList) $ \remaining -> - let next_ = phead # remaining - in pif (pnull # (ptail # remaining)) (f (PBlacklistNode (pdcons # punsafeCoerce key_ #$ pdcons # punsafeCoerce next_ # pdnil))) perror type PBlacklistNodeHRec (s :: S) = HRec @@ -215,3 +234,17 @@ pisInsertedNode = phoistAcyclic $ expectedDirectoryNode = pmkDirectorySetNode # insertedKey # coveringNext # pdeserializeCredential transferLogicCred_ # pdeserializeCredential issuerLogicCred_ in outputNode #== expectedDirectoryNode + +pdeserializeCredential :: Term s (PAsData PCredential) -> Term s (PAsData PCredential) +pdeserializeCredential term = + plet (pasConstr # pforgetData term) $ \constrPair -> + plet (pfstBuiltin # constrPair) $ \constrIdx -> + pif (plengthBS # (pasByteStr # (pheadSingleton # (psndBuiltin # constrPair))) #== 28) + ( + pcond + [ ( constrIdx #== 0 , term) + , ( constrIdx #== 1 , term) + ] + perror + ) + perror From cc3e2e03a397df1f8e7134d0c436b7e4296ed013 Mon Sep 17 00:00:00 2001 From: Christian Hoener zu Siederdissen Date: Thu, 19 Dec 2024 08:45:12 +0100 Subject: [PATCH 2/2] ci-nix github action (#18) * Fixes #9, missing build with nix in CI * Once the project grows, we should select better, or a default, build targets --- .github/workflows/ci-nix.yaml | 53 +++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 .github/workflows/ci-nix.yaml diff --git a/.github/workflows/ci-nix.yaml b/.github/workflows/ci-nix.yaml new file mode 100644 index 0000000..a78f7b7 --- /dev/null +++ b/.github/workflows/ci-nix.yaml @@ -0,0 +1,53 @@ +# https://github.com/marketplace/actions/install-nix + +name: "ci-nix" +on: + pull_request: + push: + +concurrency: + group: ${{ github.ref }} + cancel-in-progress: true + +jobs: + tests: + runs-on: ubuntu-latest + steps: + + - uses: actions/checkout@v4 + + - name: Install nix + uses: cachix/install-nix-action@v27 + + # https://github.com/marketplace/actions/cache-nix-store + - name: Restore and cache Nix store + uses: nix-community/cache-nix-action@v5 + with: + # restore and save a cache using this key + # TODO: Also hash the cabal.config and *cabal files, since we depend on them + primary-key: nix-${{ runner.os }}-${{ hashFiles('**/*.nix') }} + # if there's no cache hit, restore a cache by this prefix + restore-prefixes-first-match: nix-${{ runner.os }}- + # collect garbage until Nix store size (in bytes) is at most this number + # before trying to save a new cache + gc-max-store-size-linux: 1073741824 + # do purge caches + purge: true + # purge all versions of the cache + purge-prefixes: cache-${{ runner.os }}- + # created more than this number of seconds ago relative to the start of the `Post Restore` phase + purge-created: 0 + # except the version with the `primary-key`, if it exists + purge-primary-key: never + + # # Possibly need to cache cabal. + # - name: Cache .cabal + # uses: actions/cache@v3 + # with: + # path: ${{ steps.cabal-setup.outputs.cabal-store }} + # key: cabal-${{ hashFiles('cabal.project') }} + + # We currently do not have a default target + - run: nix build --accept-flake-config .#wst-poc + - run: nix flake --accept-flake-config check +