refactor

input-output-hk · Jan 20, 2025 · 5bf5ca8 · 5bf5ca8
1 parent 2dd5a15
commit 5bf5ca8
Show file tree

Hide file tree

Showing 10 changed files with 181 additions and 259 deletions.
diff --git a/src/plutarch-onchain-lib/lib/Plutarch/Core/FieldBinds.hs b/src/plutarch-onchain-lib/lib/Plutarch/Core/FieldBinds.hs
@@ -1,20 +1,28 @@
 {-# LANGUAGE CPP                  #-}
-{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE QualifiedDo          #-}
-{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE GADTs                #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE QualifiedDo          #-}
 {-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
 
-module Plutarch.Core.FieldBinds where
+module Plutarch.Core.FieldBinds (
+  PSpendingScriptHRec,
+  PRewardingScriptHRec,
+  PMintingScriptHRec,
+  pletFieldsSpending,
+  pletFieldsMinting,
+  pletFieldsRewarding,
+) where
 
+import Plutarch.DataRepr.Internal.Field (HRec (..), Labeled (Labeled))
+import Plutarch.Internal.Term (PType, punsafeCoerce)
+import Plutarch.LedgerApi.V3 (PCredential, PCurrencySymbol, PDatum, PMaybeData,
+                              PScriptInfo, PTxOutRef)
 import Plutarch.Prelude
-import Plutarch.LedgerApi.V3
-import Plutarch.DataRepr.Internal.Field
-import Plutarch.Internal.Term
 
 
 type PMintingScriptHRec (s :: S) =
@@ -62,4 +70,4 @@ pletFieldsRewarding term = runTermCont $ do
   fields <- tcont $ plet $ psndBuiltin # constrPair
   checkedFields <- tcont $ plet $ pif ((pfstBuiltin # constrPair) #== 2) fields perror
   let withdrawingCred = punsafeCoerce @(PAsData PCredential) $ phead # checkedFields
-  tcont $ \f -> f $ HCons (Labeled @"_0" withdrawingCred) HNil
+  tcont $ \f -> f $ HCons (Labeled @"_0" withdrawingCred) HNil
diff --git a/src/plutarch-onchain-lib/lib/Plutarch/Core/Scripts.hs b/src/plutarch-onchain-lib/lib/Plutarch/Core/Scripts.hs
@@ -4,7 +4,8 @@ module Plutarch.Core.Scripts(
   tryCompileNoTracing
   ) where
 
-import           Plutarch.Internal.Term
+import Plutarch.Internal.Term (ClosedTerm, Config (..), LogLevel (LogInfo),
+                               Script, TracingMode (DoTracingAndBinds), compile)
 
 tryCompile :: Config -> ClosedTerm a -> Script
 tryCompile cfg x = case compile cfg x of
@@ -15,4 +16,4 @@ tryCompileTracingAndBinds :: ClosedTerm a -> Script
 tryCompileTracingAndBinds = tryCompile (Tracing LogInfo DoTracingAndBinds)
 
 tryCompileNoTracing :: ClosedTerm a -> Script
-tryCompileNoTracing = tryCompile NoTracing
+tryCompileNoTracing = tryCompile NoTracing
diff --git a/src/plutarch-onchain-lib/lib/Plutarch/Core/Time.hs b/src/plutarch-onchain-lib/lib/Plutarch/Core/Time.hs
@@ -1,13 +1,22 @@
-{-# LANGUAGE QualifiedDo #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE OverloadedRecordDot #-}
-module Plutarch.Core.Time where 
+{-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE QualifiedDo         #-}
+module Plutarch.Core.Time (
+  PPosixTimeRange,
+  PPosixFiniteRange(..),
+  ptoFiniteRange,
+  pvalidityRangeStart,
+  pvalidityRangeEnd,
+  ptoCustomFiniteRange,
+  ptoCustomFiniteRangeH,
+  pisFinite
+) where
 
-import           Plutarch.Prelude
-import           Plutarch.LedgerApi.V3 
-import           Plutarch.Core.Data       
-import qualified Plutarch.Monadic            as P
-import           GHC.Generics (Generic)
+import GHC.Generics (Generic)
+import Plutarch.Core.Data
+import Plutarch.LedgerApi.V3
+import Plutarch.Monadic qualified as P
+import Plutarch.Prelude
 
 type PPosixTimeRange = PInterval PPosixTime
 
@@ -72,4 +81,4 @@ pisFinite = plam $ \i ->
       isFiniteTo = pmatch (pfield @"_0" # (pfield @"to" # i)) $ \case
         PFinite _ -> pconstant True
         _ -> pconstant False
-   in pand' # isFiniteFrom # isFiniteTo
+   in pand' # isFiniteFrom # isFiniteTo
diff --git a/src/plutarch-onchain-lib/lib/Plutarch/Core/ValidationLogic.hs b/src/plutarch-onchain-lib/lib/Plutarch/Core/ValidationLogic.hs
@@ -1,14 +1,25 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 
-module Plutarch.Core.ValidationLogic where
+module Plutarch.Core.ValidationLogic (
+  penforceNSpendRedeemers
+  , pcountSpendRedeemers
+  , pcountScriptInputs
+  , pcountInputsFromCred
+  , pvalidateConditions
+  , pvalueFromCred
+  , pvalueToCred
+  , pemptyLedgerValue
+) where
 
-import Plutarch.Prelude
-import Plutarch.LedgerApi.V3 (PScriptPurpose, PRedeemer, PCredential (..), PTxInInfo, PValue, KeyGuarantees(..), AmountGuarantees (..), PTxOut)
-import qualified Plutarch.LedgerApi.AssocMap as AssocMap
 import Plutarch.Core.List (pdropFast)
 import Plutarch.Core.Utils (pand'List)
-import PlutusLedgerApi.V3 (Value)
+import Plutarch.LedgerApi.AssocMap qualified as AssocMap
+import Plutarch.LedgerApi.V3 (AmountGuarantees (..), KeyGuarantees (..),
+                              PCredential (..), PRedeemer, PScriptPurpose,
+                              PTxInInfo, PTxOut, PValue)
+import Plutarch.Prelude
 import Plutarch.Unsafe (punsafeCoerce)
+import PlutusLedgerApi.V3 (Value)
 
 {- | Check that there is exactly n spend plutus scripts executed in the transaction via the txInfoRedeemers list.
     Assumes that the txInfoRedeemers list is sorted according to the ledger Ord instance for PlutusPurpose:
@@ -37,7 +48,7 @@ penforceNSpendRedeemers n rdmrs =
     Assumes that the txInfoRedeemers list is sorted according to the ledger Ord instance for PlutusPurpose:
     `deriving instance Ord (ConwayPlutusPurpose AsIx era)`
     See: https://github.com/IntersectMBO/cardano-ledger/blob/d79d41e09da6ab93067acddf624d1a540a3e4e8d/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs#L188
-    
+
     This assumption holds true for any valid transaction, because it is enforced by the ledger rules.
 -}
 pcountSpendRedeemers :: forall {s :: S}. Term s (AssocMap.PMap 'AssocMap.Unsorted PScriptPurpose PRedeemer) -> Term s PInteger
@@ -67,7 +78,7 @@ pcountScriptInputs =
                         _ -> self # n # xs
                 )
                 n
-     in go # 0     
+     in go # 0
 
 pcountInputsFromCred :: Term (s :: S) (PAsData PCredential :--> PBuiltinList (PAsData PTxInInfo) :--> PInteger)
 pcountInputsFromCred =
@@ -95,7 +106,7 @@ pvalueFromCred = phoistAcyclic $ plam $ \cred inputs ->
         self
           # pletFields @'["address", "value"] (pfield @"resolved" # txIn) (\txInF ->
                 pif ((pfield @"credential" # txInF.address) #== cred)
-                    (acc <> pfromData txInF.value)  
+                    (acc <> pfromData txInF.value)
                     acc
                     )
           # xs
@@ -124,7 +135,7 @@ pvalueToCred = phoistAcyclic $ plam $ \cred inputs ->
               # pemptyLedgerValue
               # inputs
   in value
-  
+
 -- | Strictly evaluates a list of boolean expressions.
 -- If all the expressions evaluate to true, returns unit, otherwise throws an error.
 pvalidateConditions :: [Term s PBool] -> Term s PUnit

diff --git a/src/plutarch-onchain-lib/lib/Plutarch/Core/Value.hs b/src/plutarch-onchain-lib/lib/Plutarch/Core/Value.hs
@@ -1,28 +1,55 @@
-{-# LANGUAGE CPP                  #-}
-{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE QualifiedDo          #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE FlexibleContexts     #-}
-{-# LANGUAGE GADTs                #-}
-{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE QualifiedDo           #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+module Plutarch.Core.Value (
+  pfindCurrencySymbolsByTokenPrefix,
+  pfindCurrencySymbolsByTokenName,
+  phasDataCS,
+  phasCS,
+  pcontainsCurrencySymbols,
+  pcountOfUniqueTokens,
+  psubtractValue,
+  pvalueSingleton,
+  ponlyLovelaceValueOf,
+  plovelaceValueOfFast,
+  ponlyAsset,
+  pvalueOfOneScott,
+  pfirstTokenNameWithCS,
+  pvalueOfOne,
+  psingletonOfCS,
+  ptryLookupValue,
+  pfilterCSFromValue,
+  pvalueContains,
+  pfirstTokenName,
+  pcountCS,
+  pcountNonAdaCS,
+  pstripAdaSafe,
+  pstripAda,
+) where
 
-module Plutarch.Core.Value where
-
-import Plutarch.Prelude
-import Plutarch.LedgerApi.V3
-import Plutarch.Core.PByteString(pisPrefixOf)
-import Plutarch.LedgerApi.Value
-import qualified Plutarch.LedgerApi.Value as Value
-import qualified Plutarch.LedgerApi.AssocMap as AssocMap
-import Plutarch.Internal.Term (punsafeCoerce, PType)
-import Plutarch.Core.Internal.Builtins ( pmapData, ppairDataBuiltinRaw )
-import Plutarch.Core.List (pheadSingleton)
 import GHC.Generics (Generic)
+import Plutarch.Core.Internal.Builtins (pmapData, ppairDataBuiltinRaw)
+import Plutarch.Core.List (pheadSingleton)
+import Plutarch.Core.PByteString (pisPrefixOf)
+import Plutarch.Internal.Term (PType, punsafeCoerce)
+import Plutarch.LedgerApi.AssocMap qualified as AssocMap
+import Plutarch.LedgerApi.V3 (AmountGuarantees (NonZero, Positive),
+                              KeyGuarantees (Sorted), PCurrencySymbol,
+                              PMap (..), PTokenName, PValue (..))
+import Plutarch.LedgerApi.Value (padaSymbol, padaSymbolData, pnormalize,
+                                 pvalueOf)
+import Plutarch.LedgerApi.Value qualified as Value
+import Plutarch.Prelude
 
 {- | Finds the associated Currency symbols that contain token names prefixed with the ByteString.
 -}
@@ -153,8 +180,8 @@ ponlyLovelaceValueOf val =
 --
 -- The Cardano Ledger enforces that this invariant is maintained for all Values in the Script Context
 -- So we are guaranteed that this is safe to use for any Value inside the Script Context
-plovelaceValueOf :: Term s (PValue 'Sorted 'Positive) -> Term s PInteger
-plovelaceValueOf val =
+plovelaceValueOfFast :: Term s (PValue 'Sorted 'Positive) -> Term s PInteger
+plovelaceValueOfFast val =
   let csPairs = pto $ pto val
       adaEntry = phead # csPairs
   in pfromData (psndBuiltin #$ phead #$ pto $ pfromData $ psndBuiltin # adaEntry)
@@ -375,33 +402,33 @@ pvalueContains = phoistAcyclic $
            in pall # forEachTN cs # tnMap
      in pall # forEachCS #$ pto $ pto subset
 
--- TODO: Complete this function. 
+-- TODO: Complete this function.
 -- pvalueContainsFast ::
 --   ClosedTerm
 --     ( PValue 'Sorted 'Positive
 --         :--> PValue 'Sorted 'Positive
 --         :--> PBool
 --     )
--- pvalueContainsFast = phoistAcyclic $ plam $ \superValue subValue -> 
+-- pvalueContainsFast = phoistAcyclic $ plam $ \superValue subValue ->
 --   let go :: Term (s2 :: S) (PBuiltinList (PBuiltinPair (PAsData PCurrencySymbol) (PAsData (PMap keys PTokenName PInteger))) :--> PBuiltinList (PBuiltinPair (PAsData PCurrencySymbol) (PAsData (PMap keys PTokenName PInteger))) :--> PBool)
 --       go = pfix #$ plam $ \self superSet subSet ->
---             pelimList (\superCSPair superCSPairs -> 
---               pelimList (\subCSPair subCSPairs -> 
+--             pelimList (\superCSPair superCSPairs ->
+--               pelimList (\subCSPair subCSPairs ->
 --                 let superCS = pfromData $ pfstBuiltin # superCSPair
 --                     subCS = pfromData $ pfstBuiltin # subCSPair
---                 in 
+--                 in
 --                   pif (superCS #< subCSPair)
 --                       (self # superCSPairs # subSet)
---                       ( 
+--                       (
 --                         pif (superCS #== subCS)
 --                             ( pconstant True)
 --                             (pconstant False)
 --                       )
-              
---               ) 
+
+--               )
 --               (pconstant True)
 --               subSet
---              ) (pconstant False) superSet 
+--              ) (pconstant False) superSet
 --     innerVal :: Term _ (PMap Sorted PCurrencySymbol (PMap Sorted PTokenName PInteger))
 --     innerVal = pto superValue
 --     tokensMap :: Term
@@ -410,7 +437,7 @@ pvalueContains = phoistAcyclic $
 --                     (PBuiltinPair
 --                         (PAsData PCurrencySymbol)
 --                         (PAsData (PMap Sorted PTokenName PInteger))))
---     tokensMap = pto innerVal 
+--     tokensMap = pto innerVal
 --  in go # tokensMap # pto (pto subValue)
 
 pfirstTokenName ::
@@ -456,8 +483,8 @@ pcountNonAdaCS =
               go # 0 # csPairs
 
 -- | Strip Ada from a ledger value
--- This assumes that Ada is the first entry in the Value. If Ada is not the first entry, this function assumes the value does not 
--- contain Ada and thus will just return the value as provided. 
+-- This assumes that Ada is the first entry in the Value. If Ada is not the first entry, this function assumes the value does not
+-- contain Ada and thus will just return the value as provided.
 pstripAdaSafe ::
   forall
     (v :: AmountGuarantees)
@@ -468,7 +495,7 @@ pstripAdaSafe = phoistAcyclic $
     let valMap = pto (pto value)
         firstEntryCS = pfstBuiltin # (phead # valMap)
         nonAdaValueMapInner = ptail # valMap
-     in pif (firstEntryCS #== padaSymbolData) (pcon (PValue $ pcon $ PMap nonAdaValueMapInner)) value 
+     in pif (firstEntryCS #== padaSymbolData) (pcon (PValue $ pcon $ PMap nonAdaValueMapInner)) value
 
 -- | Strip Ada from a ledger value
 -- Importantly this function assumes that the Value is provided by the ledger (i.e. via the ScriptContext)
@@ -479,4 +506,4 @@ pstripAda ::
 pstripAda = phoistAcyclic $
   plam $ \value ->
     let nonAdaValueMapInner = ptail # pto (pto value)
-    in pcon (PValue $ pcon $ PMap nonAdaValueMapInner)
+    in pcon (PValue $ pcon $ PMap nonAdaValueMapInner)