Clean up cabal file, export lists, warnings

input-output-hk · Dec 17, 2024 · 360a537 · 360a537
1 parent bd65933
commit 360a537
Show file tree

Hide file tree

Showing 12 changed files with 89 additions and 316 deletions.
diff --git a/src/app/Main.hs → src/exe/export-smart-tokens/Main.hs b/src/app/Main.hs → src/exe/export-smart-tokens/Main.hs
@@ -1,8 +1,4 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-{-# HLINT ignore "Eta reduce" #-}
-
+{-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
 
 import Cardano.Binary qualified as CBOR
@@ -13,7 +9,6 @@ import Data.Bifunctor (
  )
 import Data.ByteString.Base16 qualified as Base16
 import Data.ByteString.Lazy qualified as LBS
-import Data.Default (def)
 import Data.Text (
   Text,
   pack,
@@ -24,7 +19,6 @@ import Plutarch (
   TracingMode (..),
   LogLevel (..),
   compile,
-  printScript,
  )
 import Plutarch.Evaluate (
   evalScript,
@@ -36,7 +30,6 @@ import PlutusLedgerApi.V2 (
   Data,
   ExBudget,
  )
-import System.IO
 import SmartTokens.Contracts.ProgrammableLogicBase (mkProgrammableLogicBase, mkProgrammableLogicGlobal)
 import SmartTokens.Contracts.Issuance (mkProgrammableLogicMinting)
 import SmartTokens.Contracts.ProtocolParams (mkProtocolParametersMinting, alwaysFailScript, mkPermissionedMinting)
@@ -70,14 +63,6 @@ writePlutusScriptTraceBind :: String -> FilePath -> ClosedTerm a -> IO ()
 writePlutusScriptTraceBind title filepath term =
   writePlutusScript (Tracing LogInfo DoTracingAndBinds) title filepath term
 
-writePlutusScriptTrace :: String -> FilePath -> ClosedTerm a -> IO ()
-writePlutusScriptTrace title filepath term =
-  writePlutusScript (Tracing LogInfo DoTracing) title filepath term
-
-writePlutusScriptNoTrace :: String -> FilePath -> ClosedTerm a -> IO ()
-writePlutusScriptNoTrace title filepath term =
-  writePlutusScript NoTracing title filepath term
-
 main :: IO ()
 main = do
   putStrLn "Writing Plutus Scripts to files"

diff --git a/src/exe/Main.hs → src/exe/wst-poc/Main.hs b/src/exe/Main.hs → src/exe/wst-poc/Main.hs
diff --git a/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs b/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedRecordDot  #-}
+{-# LANGUAGE QualifiedDo #-}
 module SmartTokens.Contracts.ExampleTransferLogic (
   mkPermissionedTransfer,
   mkFreezeAndSeizeTransfer,

diff --git a/src/lib/SmartTokens/Contracts/Issuance.hs b/src/lib/SmartTokens/Contracts/Issuance.hs
@@ -1,14 +1,17 @@
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE OverloadedRecordDot  #-}
+{-# LANGUAGE OverloadedStrings #-}
 module SmartTokens.Contracts.Issuance (
   mkProgrammableLogicMinting,
 ) where
 
-import Plutarch.LedgerApi.V3
+import Plutarch.LedgerApi.V3 (PCredential, PScriptContext, PScriptInfo(PMintingScript))
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
-import Plutarch.Builtin
-import Plutarch.LedgerApi.Value
-import Plutarch.Core.Utils
-import Plutarch.Unsafe
+import Plutarch.Builtin (pfromDataImpl, pdataImpl)
+import Plutarch.LedgerApi.Value (PCurrencySymbol, pvalueOf)
+import Plutarch.Core.Utils (ptryLookupValue, pheadSingleton, pand'List, (#>), pvalidateConditions)
+import Plutarch.Unsafe (punsafeCoerce)
 import Plutarch.Internal.PlutusType (PlutusType(pcon', pmatch'))
 --import SmartTokens.Types.PTokenDirectory (PDirectorySetNode)
 

diff --git a/src/lib/SmartTokens/Contracts/ProgrammableLogicBase.hs b/src/lib/SmartTokens/Contracts/ProgrammableLogicBase.hs
@@ -1,19 +1,26 @@
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE OverloadedRecordDot  #-}
 module SmartTokens.Contracts.ProgrammableLogicBase (
   mkProgrammableLogicBase,
   mkProgrammableLogicGlobal
 ) where
 
-import Plutarch.LedgerApi.V3
+import Plutarch.LedgerApi.V3 (PCredential(PPubKeyCredential, PScriptCredential), PPubKeyHash, PTxInInfo, PValue, KeyGuarantees(Sorted), AmountGuarantees(Positive), PMaybeData(PDJust, PDNothing), PStakingCredential(PStakingHash), PTxOut(..), PScriptContext, PLovelace, PCurrencySymbol, POutputDatum(..), pdnothing)
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
-import Plutarch.Builtin
-import Plutarch.Core.Utils
-import Plutarch.Unsafe
-import PlutusLedgerApi.V1.Value
+import Plutarch.Builtin (pasConstr, pforgetData, pasByteStr)
+import Plutarch.Core.Utils (ptxSignedByPkh, pcanFind, pvalidateConditions, pelemAtFast, pand'List, phasDataCS, pmustFind, pisRewarding, pfilterCSFromValue, pcountInputsFromCred)
+import Plutarch.Unsafe (punsafeCoerce)
+import PlutusLedgerApi.V1.Value (Value)
 import SmartTokens.Types.ProtocolParams (PProgrammableLogicGlobalParams)
-import Plutarch.Extra.Record
-import SmartTokens.Types.PTokenDirectory
--- import Plutarch.List
+import Plutarch.Extra.Record(mkRecordConstr, (.=), (.&))
+import SmartTokens.Types.PTokenDirectory (PDirectorySetNode)
 
 data PTokenProof (s :: S)
   = PTokenExists
@@ -54,8 +61,8 @@ pvalueFromCred = phoistAcyclic $ plam $ \cred sigs scripts inputs ->
                                   pif (ptxSignedByPkh # pkh # sigs)
                                       (acc <> pfromData txInF.value)
                                       perror
-                                PScriptCredential ((pfield @"_0" #) -> scriptHash) ->
-                                  pif (pelem # punsafeCoerce scriptHash # scripts)
+                                PScriptCredential ((pfield @"_0" #) -> scriptHash_) ->
+                                  pif (pelem # punsafeCoerce scriptHash_ # scripts)
                                       (acc <> pfromData txInF.value)
                                       perror
                             _ -> perror

diff --git a/src/lib/SmartTokens/Contracts/ProtocolParams.hs b/src/lib/SmartTokens/Contracts/ProtocolParams.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE OverloadedRecordDot  #-}
+{-# LANGUAGE OverloadedStrings #-}
 module SmartTokens.Contracts.ProtocolParams (
   mkProtocolParametersMinting,
   alwaysFailScript,

diff --git a/src/lib/SmartTokens/Types/Constants.hs b/src/lib/SmartTokens/Types/Constants.hs
@@ -1,12 +1,15 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-module SmartTokens.Types.Constants where
+{-# LANGUAGE OverloadedStrings #-}
+module SmartTokens.Types.Constants(
+    protocolParamsToken,
+    pprotocolParamsToken,
+    pprotocolParamsTokenData
+) where
 
 import Plutarch.LedgerApi.V1 (PTokenName (..))
 import Plutarch.Prelude
     ( PAsData, pconstantData, ClosedTerm, pconstant )
 import PlutusLedgerApi.V1 (TokenName(..))
 
-{-# INLINABLE protocolParamsToken #-}
 protocolParamsToken :: TokenName
 protocolParamsToken = "ProtocolParams"
 

diff --git a/src/lib/SmartTokens/Types/PTokenDirectory.hs b/src/lib/SmartTokens/Types/PTokenDirectory.hs
@@ -1,20 +1,6 @@
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE LambdaCase            #-}
-{-# LANGUAGE NamedFieldPuns        #-}
-{-# LANGUAGE OverloadedLabels      #-}
-{-# LANGUAGE OverloadedRecordDot   #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE PolyKinds             #-}
-{-# LANGUAGE QualifiedDo           #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE ViewPatterns          #-}
-
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE QualifiedDo #-}
 module SmartTokens.Types.PTokenDirectory (
   DirectorySetNode (..),
   PDirectorySetNode (..),
@@ -74,10 +60,10 @@ instance PlutusType PBlacklistNode where
   pcon' (PBlacklistNode t1) = t1
   pmatch' xs f =
     plet (pto xs) $ \innerFieldList ->
-      let key = phead # 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
+          let next_ = phead # remaining
+          in pif (pnull # (ptail # remaining)) (f (PBlacklistNode (pdcons # punsafeCoerce key_ #$ pdcons # punsafeCoerce next_ # pdnil))) perror
 
 
 -- instance DerivePlutusType PBlacklistNode where
@@ -164,8 +150,8 @@ pemptyCSData = unsafeEvalTerm NoTracing (punsafeCoerce (pconstant $ PlutusTx.B "
 
 pmkDirectorySetNode :: ClosedTerm (PAsData PByteString :--> PAsData PByteString :--> PAsData PCredential :--> PAsData PCredential :--> PAsData PDirectorySetNode)
 pmkDirectorySetNode = phoistAcyclic $
-  plam $ \key next transferLogicCred issuerLogicCred ->
-    punsafeCoerce $ plistData # pmkBuiltinList [pforgetData key, pforgetData next, pforgetData transferLogicCred, pforgetData issuerLogicCred]
+  plam $ \key_ next_ transferLogicCred issuerLogicCred ->
+    punsafeCoerce $ plistData # pmkBuiltinList [pforgetData key_, pforgetData next_, pforgetData transferLogicCred, pforgetData issuerLogicCred]
 
 pisInsertedOnNode :: ClosedTerm (PAsData PByteString :--> PAsData PByteString :--> PAsData PCredential :--> PAsData PCredential :--> PAsData PDirectorySetNode :--> PBool)
 pisInsertedOnNode = phoistAcyclic $

diff --git a/src/lib/SmartTokens/Types/ProtocolParams.hs b/src/lib/SmartTokens/Types/ProtocolParams.hs
@@ -1,19 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE LambdaCase            #-}
-{-# LANGUAGE NamedFieldPuns        #-}
-{-# LANGUAGE OverloadedLabels      #-}
-{-# LANGUAGE OverloadedRecordDot   #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE PolyKinds             #-}
-{-# LANGUAGE QualifiedDo           #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE ViewPatterns          #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-deferred-type-errors #-}
 
 module SmartTokens.Types.ProtocolParams (
@@ -26,9 +11,9 @@ import Plutarch.Core.PlutusDataList
       PlutusTypeDataList,
       ProductIsData(..) )
 import Generics.SOP qualified as SOP
-import Plutarch.LedgerApi.V3
+import Plutarch.LedgerApi.V3 (PCurrencySymbol, PCredential)
 import Plutarch.Prelude
-import Plutarch.DataRepr
+import Plutarch.DataRepr (PDataFields)
 import PlutusTx qualified
 import PlutusLedgerApi.V3 (Credential, CurrencySymbol)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))

diff --git a/src/lib/Types/Classes.hs b/src/lib/Types/Classes.hs
@@ -1,8 +1,9 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 
-module Types.Classes where
+module Types.Classes(
+  ScottConvertible(..)
+) where
 
 import Plutarch.Prelude
 

diff --git a/src/lib/Types/Constants.hs b/src/lib/Types/Constants.hs
@@ -1,22 +1,21 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
 
-module Types.Constants where
+module Types.Constants(
+  psetNodePrefix,
+  pnodeKeyTN,
+  poriginNodeTN,
+  ptryParseNodeKey
+) where
 
-import Plutarch
 import Plutarch.LedgerApi.V1 (PTokenName (..))
 import Plutarch.Prelude
-import Plutarch.Core.Utils
+import Plutarch.Core.Utils (pnonew, passert, pisPrefixOf)
 import PlutusLedgerApi.V1 (TokenName(..))
 import Plutarch.Builtin (PDataNewtype(..))
 import qualified Plutarch.Monadic as P
 
-{-# INLINABLE djedOrderToken #-}
-djedOrderToken :: TokenName
-djedOrderToken = "DjedOrderTicket"
-
-pdjedOrderToken :: ClosedTerm PTokenName 
-pdjedOrderToken = pconstant djedOrderToken
-
 psetNodePrefix :: ClosedTerm PByteString
 psetNodePrefix = pconstant "FSN"