release

cabal.project

@@ -26,7 +26,7 @@ packages:
 source-repository-package
     type: git
     location: https://github.com/Plutonomicon/plutarch-plutus
-    tag: 8cc0a4ca3ed494a79fe019c72173b369cd26cb84
+    tag: fd7d1c1fc173542f952f19272554027183659dd6
     subdir:
       .
       plutarch-ledger-api

flake.nix

@@ -31,7 +31,7 @@
     };
 
     plutarch = {
-      url = "github:Plutonomicon/plutarch-plutus/8cc0a4ca3ed494a79fe019c72173b369cd26cb84";
+      url = "github:Plutonomicon/plutarch-plutus/fd7d1c1fc173542f952f19272554027183659dd6";
     };
   };
 

nix/project.nix

@@ -2,7 +2,7 @@
 
 let
   sha256map = {
-    "https://github.com/Plutonomicon/plutarch-plutus"."8cc0a4ca3ed494a79fe019c72173b369cd26cb84" = "sha256-zQ0qv9e3Gy6Myn8wx+geJtCL5L2qJlpruSbWmrgyLOE=";
+    "https://github.com/Plutonomicon/plutarch-plutus"."fd7d1c1fc173542f952f19272554027183659dd6" = "sha256-lU2JF9KYvzEPfVLHdLkrM1hTTuc9NYi2hQPFnLDm2d8=";
   };
 
   modules = [{ }];

src/plutarch-onchain-lib/lib/Plutarch/Core/Integrity.hs

@@ -0,0 +1,39 @@
+module Cardano.Core.Integrity (
+  pisScriptCredential,
+  pisPubKeyCredential,
+  pdeserializeCredential,
+) where
+
+import Plutarch.Core.List
+import Plutarch.Prelude
+
+-- | Check that a data-encoded Credential is a ScriptCredential.
+-- This does not guarantee that the data-encoded term is structurally a valid Credential.
+-- So this should only be used if the data-encoded term is known to be a Credential.
+-- If the term is obtained from relevant fields of the ScriptContext or TxInfo, then this check is safe
+-- because the ledger guarantees the structural validity of the Credential.
+pisScriptCredential :: Term s (PAsData PCredential) -> Term s PBool
+pisScriptCredential cred = (pfstBuiltin # (pasConstr # pforgetData cred)) #== 1
+
+-- | Check if the provided data-encoded Credential is a PubKeyCredential.
+-- This does not guarantee that the data-encoded term is structurally a valid Credential.
+-- So this should only be used if the data-encoded term is known to be a Credential.
+-- If the term is obtained from relevant fields of the ScriptContext or TxInfo, then this check is safe
+-- because the ledger guarantees the structural validity of the Credential.
+pisPubKeyCredential :: Term s (PAsData PCredential) -> Term s PBool
+pisPubKeyCredential cred = (pfstBuiltin # (pasConstr # pforgetData cred)) #== 0
+
+-- | Check if the provided data-encoded term has the expected builtin data representation of a credential.
+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)
+              ]
+              (ptraceInfoError "Invalid credential")
+          )
+          perror

src/plutarch-onchain-lib/lib/Plutarch/Core/PByteString.hs

@@ -18,7 +18,7 @@ import Plutarch.Prelude
 -- | Checks if a tokenName is prefixed by a certain ByteString
 pisPrefixedWith :: ClosedTerm (PTokenName :--> PByteString :--> PBool)
 pisPrefixedWith = plam $ \tn prefix ->
-  pmatch (pto tn) $ \(PDataNewtype tnBS) -> pisPrefixOf # prefix # pfromData tnBS
+  pisPrefixOf # prefix # pto tn
 
 -- | Checks if the first ByteString is a prefix of the second
 pisPrefixOf :: ClosedTerm (PByteString :--> PByteString :--> PBool)

src/plutarch-onchain-lib/lib/Plutarch/Core/Time.hs

@@ -8,16 +8,16 @@ module Plutarch.Core.Time (
   pvalidityRangeStart,
   pvalidityRangeEnd,
   ptoCustomFiniteRangeH,
-  pisFinite
+  pisFinite,
 ) where
 
 import GHC.Generics (Generic)
-import Plutarch.Core.Data (pnonew)
 import Plutarch.LedgerApi.V3 (PExtended (PFinite), PInterval (..),
                               PLowerBound (PLowerBound), PPosixTime (..),
-                              PUpperBound (PUpperBound))
+                              PUpperBound (PUpperBound), unPPosixTime)
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
+import Plutarch.Unsafe (punsafeCoerce)
 
 type PPosixTimeRange = PInterval PPosixTime
 
@@ -37,50 +37,56 @@ instance DerivePlutusType PPosixFiniteRange where
 -- Errors if the provided time range is not finite.
 ptoFiniteRange :: Term s (PPosixTimeRange :-->  PPosixFiniteRange)
 ptoFiniteRange = phoistAcyclic $ plam $ \timeRange -> P.do
-  timeRangeF <- pletFields @'["from", "to"] timeRange
-  PLowerBound lb <- pmatch timeRangeF.from
-  PFinite ((pfield @"_0" #) -> start) <- pmatch (pfield @"_0" # lb)
-  PUpperBound ub <- pmatch timeRangeF.to
-  PFinite ((pfield @"_0" #) -> end) <- pmatch (pfield @"_0" # ub)
-  pcon $ PPosixFiniteRange { from = start, to = end }
+  PInterval lowerBound upperBound <- pmatch timeRange
+  PLowerBound lb _ <- pmatch lowerBound
+  PFinite start <- pmatch lb
+  PUpperBound ub _ <- pmatch upperBound
+  PFinite end <- pmatch ub
+  pcon $ PPosixFiniteRange { from = pfromData start, to = pfromData end }
 
 -- | Get the start time of a 'PPosixTimeRange'.
 -- Errors if the start time is not finite.
 pvalidityRangeStart :: Term s (PPosixTimeRange :--> PAsData PInteger)
 pvalidityRangeStart = phoistAcyclic $ plam $ \timeRange -> P.do
-  PInterval ((pfield @"from" #) -> startTime) <- pmatch timeRange
-  PLowerBound lb <- pmatch startTime
-  PFinite ((pfield @"_0" #) -> posixTime) <- pmatch (pfield @"_0" # lb)
-  pmatch posixTime $ \(PPosixTime pt) -> pmatch pt $ \(PDataNewtype t) -> t
+  interval <- pmatch timeRange
+  let startTime = pinteral'from interval
+  --PInterval ((pfield @"from" #) -> startTime) <- pmatch timeRange
+  PLowerBound lb _ <- pmatch startTime
+  PFinite posixTime <- pmatch lb
+  punsafeCoerce $ pto posixTime
 
 -- | Get the end time of a 'PPosixTimeRange'.
 -- Errors if the end time is not finite.
 pvalidityRangeEnd :: Term s (PPosixTimeRange :--> PAsData PInteger)
 pvalidityRangeEnd = phoistAcyclic $ plam $ \timeRange -> P.do
-  PInterval ((pfield @"to" #) -> to_) <- pmatch timeRange
-  PUpperBound ub <- pmatch to_
-  PFinite ((pfield @"_0" #) -> posixTime) <- pmatch (pfield @"_0" # ub)
-  pmatch posixTime $ \(PPosixTime pt) -> pmatch pt $ \(PDataNewtype t) -> t
+  interval <- pmatch timeRange
+  let to_ = pinteral'to interval
+  PUpperBound ub _ <- pmatch to_
+  PFinite posixTime <- pmatch ub
+  punsafeCoerce $ pto posixTime
 
 -- | Extract the start and end times from a 'PPosixTimeRange' as Integers
 -- and return them as a pair via CPS.
 -- Errors if the start or end time is not finite.
 ptoCustomFiniteRangeH :: Term s PPosixTimeRange -> TermCont @r s (Term s PInteger, Term s PInteger)
 ptoCustomFiniteRangeH timeRange = do
-  timeRangeF <- pletFieldsC @'["from", "to"] timeRange
-  PLowerBound lb <- pmatchC timeRangeF.from
-  PFinite ((pfield @"_0" #) -> start) <- pmatchC (pfield @"_0" # lb)
-  PUpperBound ub <- pmatchC timeRangeF.to
-  PFinite ((pfield @"_0" #) -> end) <- pmatchC (pfield @"_0" # ub)
-  pure (pnonew $ pfromData start, pnonew $ pfromData end)
+  (PInterval from_ to_) <- pmatchC timeRange
+  PLowerBound lb _ <- pmatchC from_
+  PFinite (pfromData -> start) <- pmatchC lb
+  PUpperBound ub _ <- pmatchC to_
+  PFinite (pfromData -> end) <- pmatchC ub
+  pure (unPPosixTime start, unPPosixTime end)
 
 -- | Check if a 'PPosixTimeRange' is finite.
 pisFinite :: Term s (PInterval PPosixTime :--> PBool)
 pisFinite = plam $ \i ->
-  let isFiniteFrom = pmatch (pfield @"_0" # (pfield @"from" # i)) $ \case
-        PFinite _ -> pconstant True
-        _ -> pconstant False
-      isFiniteTo = pmatch (pfield @"_0" # (pfield @"to" # i)) $ \case
-        PFinite _ -> pconstant True
-        _ -> pconstant False
-   in pand' # isFiniteFrom # isFiniteTo
+  pmatch i $ \(PInterval start' end') ->
+    pmatch start' $ \(PLowerBound start _) ->
+      pmatch end' $ \(PUpperBound end _) ->
+        let isFiniteFrom = pmatch start $ \case
+              PFinite _ -> pconstant True
+              _ -> pconstant False
+            isFiniteTo = pmatch end $ \case
+              PFinite _ -> pconstant True
+              _ -> pconstant False
+        in pand' # isFiniteFrom # isFiniteTo

src/plutarch-onchain-lib/lib/Plutarch/Core/Utils.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP                  #-}
+{-# LANGUAGE NamedFieldPuns       #-}
 {-# LANGUAGE OverloadedRecordDot  #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE PolyKinds            #-}
@@ -21,8 +22,6 @@ module Plutarch.Core.Utils(
   pisRewarding,
   ptryFromInlineDatum,
   pfromPDatum,
-  pnonew,
-  punnew,
   ppair,
   passert,
   pcheck,
@@ -51,8 +50,6 @@ module Plutarch.Core.Utils(
   (#/=),
   pmapAndConvertList,
   pintToByteString,
-  punwrapPosixTime,
-  pwrapPosixTime,
   pdivCeil,
   pisScriptCredential,
   pisPubKeyCredential,
@@ -62,12 +59,7 @@ module Plutarch.Core.Utils(
 import Data.Text qualified as T
 import Plutarch.Prelude
 
-import Plutarch.LedgerApi.V3 (AmountGuarantees (Positive),
-                              KeyGuarantees (Sorted), PAddress,
-                              PCredential (..), PDatum, PMaybeData,
-                              POutputDatum (POutputDatum), PPosixTime (..),
-                              PPubKeyHash, PScriptHash, PScriptInfo, PTxInInfo,
-                              PTxOut, PTxOutRef, PValue (..))
+import Plutarch.LedgerApi.V3
 import Plutarch.Monadic qualified as P
 
 import Plutarch.Core.List (pheadSingleton)
@@ -130,22 +122,6 @@ pfromPDatum ::
   Term s (PDatum :--> a)
 pfromPDatum = phoistAcyclic $ plam $ flip ptryFrom fst . pto
 
--- Extract the inner type from a type which contains a `DataNewtype`
--- ex. PPosixTime -> PInteger
---     PPubKeyHash -> PByteString
-pnonew :: forall {a :: PType} {b :: PType} {s :: S}.
-                ((PInner a :: PType) ~ (PDataNewtype b :: PType), PIsData b) =>
-                Term s a -> Term s b
-pnonew nt = pmatch (pto nt) $ \(PDataNewtype bs) -> pfromData bs
-
--- Extract the inner type from a `PDataNewType`
--- ex. PDataNewtype PInteger -> PInteger
---     PDataNewtype PByteString -> PByteString
-punnew :: forall {b :: PType} {s :: S}.
-                PIsData b =>
-                Term s (PDataNewtype b) -> Term s b
-punnew nt = pmatch nt $ \(PDataNewtype bs) -> pfromData bs
-
 ppair :: Term s a -> Term s b -> Term s (PPair a b)
 ppair a b = pcon (PPair a b)
 
@@ -292,16 +268,19 @@ ptryOutputToAddress = phoistAcyclic $
     )
       # outs
 
-ptryOwnOutput :: Term s (PBuiltinList (PAsData PTxOut) :--> PScriptHash :--> PTxOut)
+ptryOwnOutput :: Term s (PBuiltinList (PAsData PTxOut) :--> PAsData PScriptHash :--> PTxOut)
 ptryOwnOutput = phoistAcyclic $
   plam $ \outs target ->
     ( pfix #$ plam $ \self xs ->
         pelimList
           ( \txo txos ->
-              pmatch (pfield @"credential" # (pfield @"address" # txo)) $ \case
-                PPubKeyCredential _ -> (self # txos)
-                PScriptCredential ((pfield @"_0" #) -> vh) ->
-                  pif (target #== vh) (pfromData txo) (self # txos)
+              pmatch (pfromData txo) $ \case
+                PTxOut {ptxOut'address} ->
+                  pmatch ptxOut'address $ \addr ->
+                    pmatch (paddress'credential addr) $ \case
+                      PScriptCredential vh ->
+                        pif (target #== vh) txo (self # txos)
+                      PPubKeyCredential _ -> (self # txos)
           )
           perror
           xs
@@ -311,7 +290,10 @@ ptryOwnOutput = phoistAcyclic $
 ptryOwnInput :: Term s (PBuiltinList (PAsData PTxInInfo) :--> PTxOutRef :--> PTxOut)
 ptryOwnInput = phoistAcyclic $
   plam $ \inputs ownRef ->
-    precList (\self x xs -> pletFields @'["outRef", "resolved"] x $ \txInFields -> pif (ownRef #== txInFields.outRef) txInFields.resolved (self # xs)) (const perror) # inputs
+    precList (\self x xs ->
+      pmatch (pfromData x) $ \(PTxInInfo {ptxInInfo'outRef, ptxInInfo'resolved}) ->
+          pif (ownRef #== ptxInInfo'outRef) ptxInInfo'resolved (self # xs)
+      ) (const perror) # inputs
 
 ptxSignedByPkh ::
   Term s (PAsData PPubKeyHash :--> PBuiltinList (PAsData PPubKeyHash) :--> PBool)
@@ -322,13 +304,16 @@ ptxSignedByPkh = pelem
 -}
 phasUTxO ::
   ClosedTerm
-    ( PAsData PTxOutRef
+    ( PTxOutRef
         :--> PBuiltinList (PAsData PTxInInfo)
         :--> PBool
     )
 phasUTxO = phoistAcyclic $
   plam $ \oref inInputs ->
-    pany @PBuiltinList # plam (\input -> oref #== (pfield @"outRef" # input)) # inInputs
+    pany @PBuiltinList # plam (\input ->
+      pmatch (pfromData input) $ \ininfo ->
+        oref #== ptxInInfo'outRef ininfo
+      ) # inInputs
 
 pand'List :: [Term s PBool] -> Term s PBool
 pand'List ts' =
@@ -381,12 +366,6 @@ pshowDigit = phoistAcyclic $
       ]
       perror
 
-punwrapPosixTime :: Term s (PAsData PPosixTime) -> Term s PInteger
-punwrapPosixTime pt = pmatch (pfromData pt) $ \(PPosixTime pt') -> pmatch pt' $ \(PDataNewtype t) -> pfromData t
-
-pwrapPosixTime :: Term s PInteger -> Term s (PAsData PPosixTime)
-pwrapPosixTime t = pdata $ pcon $ PPosixTime $ pcon $ PDataNewtype $ pdata t
-
 pdivCeil :: Term s (PInteger :--> PInteger :--> PInteger)
 pdivCeil = phoistAcyclic $
   plam $

src/plutarch-onchain-lib/lib/Plutarch/Core/Value.hs

@@ -66,10 +66,9 @@ pfindCurrencySymbolsByTokenPrefix = phoistAcyclic $
     plet (pisPrefixOf # prefix) $ \prefixCheck ->
       let mapVal = pto (pto value)
           isPrefixed = pfilter # plam (\csPair ->
-            pany # plam (\tkPair ->
-              pmatch (pto (pfromData $ pfstBuiltin # tkPair)) $ \(PDataNewtype tkn) ->
-                  prefixCheck # pfromData tkn
-              ) # pto (pfromData (psndBuiltin # csPair))
+              pany # plam (\tkPair ->
+                prefixCheck # pto (pfromData $ pfstBuiltin # tkPair)
+                ) # pto (pfromData (psndBuiltin # csPair))
             ) # mapVal
        in pmap # pfstBuiltin # isPrefixed
 

src/plutarch-onchain-lib/plutarch-onchain-lib.cabal

@@ -99,7 +99,7 @@ test-suite plutarch-onchain-lib-tests
     , base
     , bytestring
     , cardano-crypto-class
-    , plutarch              ==1.9.0
+    , plutarch
     , plutarch-ledger-api
     , plutarch-onchain-lib
     , plutarch-testlib
@@ -116,7 +116,7 @@ test-suite plutarch-onchain-lib-bench
   hs-source-dirs: test
   build-depends:
     , base
-    , plutarch              ==1.9.0
+    , plutarch
     , plutarch-ledger-api
     , plutarch-onchain-lib
     , plutarch-testlib