diff --git a/src/lib/SmartTokens/Types/PTokenDirectory.hs b/src/lib/SmartTokens/Types/PTokenDirectory.hs index 4f38f80..a77a62b 100644 --- a/src/lib/SmartTokens/Types/PTokenDirectory.hs +++ b/src/lib/SmartTokens/Types/PTokenDirectory.hs @@ -26,6 +26,7 @@ module SmartTokens.Types.PTokenDirectory ( pmkDirectorySetNode, pisInsertedOnNode, pisInsertedNode, + BlackListNode(..), ) where import SmartTokens.Core.PlutusDataList @@ -35,23 +36,33 @@ import SmartTokens.Core.PlutusDataList import Generics.SOP qualified as SOP import Plutarch.LedgerApi.V3 ( PCredential, PCurrencySymbol ) import Plutarch.Builtin ( pforgetData, plistData ) -import Plutarch.Internal.PlutusType (pcon', pmatch') import Plutarch.Unsafe (punsafeCoerce) import Plutarch.DataRepr ( PDataFields ) import PlutusTx qualified -import PlutusLedgerApi.V3 (Credential, CurrencySymbol) +import PlutusLedgerApi.V3 (Credential, CurrencySymbol, BuiltinByteString) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Evaluate (unsafeEvalTerm) import Plutarch (Config(NoTracing)) import SmartTokens.Core.Utils (pmkBuiltinList) -import Plutarch.List import Plutarch.Prelude +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 + +data BlackListNode = + BlackListNode { + key :: BuiltinByteString, + next :: BuiltinByteString + } + deriving stock (Show, Eq, Generic) + deriving anyclass (SOP.Generic) + deriving + (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) via (ProductIsData BlackListNode) --- data BlackListNode = --- BlackListNode { --- key :: BuiltinByteString, --- next :: BuiltinByteString --- } +deriving via (DerivePConstantViaData BlackListNode PBlacklistNode) + instance (PConstantDecl BlackListNode) newtype PBlacklistNode (s :: S) = PBlacklistNode @@ -64,20 +75,44 @@ newtype PBlacklistNode (s :: S) ) ) 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 { key = "a hi", next = "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 +-- 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 -- instance DerivePlutusType PBlacklistNode where