feat: filter out the offchain plutus observations

Author: bogdan-manole

.gitignore

@@ -53,5 +53,8 @@ tags
 .dir-locals.el
 TAGS
 
+# debugging
+output.txt
+
 # other
 .DS_Store

.stan.toml

@@ -1,5 +1,29 @@
+#[[remove]]
+#directory = "target/"
+
+[[remove]]
+directory = "src/"
+
+[[remove]]
+directory = "app/"
+
+[[remove]]
+directory = "test/"
+
+[[remove]]
+directory = "target/Target/AntiPattern/"
+
+[[remove]]
+file = "target/Target/AntiPattern.hs"
+
+[[remove]]
+file = "target/Target/Partial.hs"
+
+[[remove]]
+file = "target/Target/Infinite.hs"
+
 [[remove]]
-directory = "target/"
+file = "target/Target/Style.hs"
 
 [[check]]
 type = "Exclude"

src/Stan.hs

@@ -45,6 +45,11 @@ import Stan.Severity (Severity (Error))
 import Stan.Toml (configCodec, getTomlConfig, usedTomlFiles)
 
 import qualified Toml
+import qualified Slist as Slist
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import Language.Haskell.Exts
+import Stan.FileInfo (FileInfo(..))
 
 
 run :: IO ()
@@ -83,13 +88,56 @@ getAnalysis StanArgs{..} notJson config hieFiles = do
     -- show what observations are ignored
     pure analysis
 
+isPlutusObservations :: Observation -> Bool
+isPlutusObservations Observation{..} =
+  -- observationInspectionId includes PLU-STAN
+  "PLU-STAN" `T.isInfixOf` unId observationInspectionId
+
+isOnchainObservations :: Set FilePath -> Observation -> Bool
+isOnchainObservations files obs = Set.member (observationFile obs) files
+
+isFileOnchainContract :: FilePath -> IO Bool
+isFileOnchainContract file = do
+  result <- parseFile file
+  pure $ case result of
+    ParseOk (Module _ _ _ _ decls) -> any isOnchainModuleAnn decls
+    _otherwise -> False
+
+isOnchainModuleAnn :: Decl SrcSpanInfo -> Bool
+isOnchainModuleAnn (AnnPragma _ (ModuleAnn _ (Lit _ (String _ "onchain-contract" _)))) = True
+isOnchainModuleAnn (AnnPragma _ (ModuleAnn _ (Paren _ (ExpTypeSig _ (Lit _ (String _ "onchain-contract" _)) _)))) = True
+isOnchainModuleAnn _ = False
+
+onchainFiles :: [HieFile] -> IO (Set FilePath)
+onchainFiles hieFiles = do
+  let files = map hie_hs_file hieFiles
+  fromList <$> filterM isFileOnchainContract files
+
+onchainCondition :: Set FilePath -> Observation -> Bool
+onchainCondition contracts obs = not (isPlutusObservations obs) || isOnchainObservations contracts obs
+
+filterForOnchain :: Set FilePath -> FileInfo -> FileInfo
+filterForOnchain contracts info@FileInfo{..}= info {
+  fileInfoObservations = Slist.filter (onchainCondition contracts) fileInfoObservations }
+
+removeOffchain :: [HieFile] ->Analysis -> IO Analysis
+removeOffchain hieFiles analysis = do
+  contracts <- onchainFiles hieFiles
+  pure analysis {
+          analysisObservations = Slist.filter (onchainCondition contracts) (analysisObservations analysis)
+        , analysisFileMap = fmap (filterForOnchain contracts) (analysisFileMap analysis)
+        -- TODO: we might want to add those filtered observations to the ignored list
+        -- but i'm not sure if it's a good idea
+      }
+
 runStan :: StanArgs -> IO ()
 runStan stanArgs@StanArgs{..} = do
     let notJson = not stanArgsJsonOut
     (configTrial, useDefConfig, env) <- getStanConfig stanArgs notJson
     whenResult_ configTrial $ \warnings config -> do
         hieFiles <- readHieFiles stanArgsHiedir
-        analysis <- getAnalysis stanArgs notJson config hieFiles
+        --NOTE: this filter is applied only for CLI, hls will still show all observations
+        analysis <- getAnalysis stanArgs notJson config hieFiles >>= removeOffchain hieFiles
         -- show what observations are ignored
         when notJson $ putText $ indent $ prettyShowIgnoredObservations
             (configIgnored config)

stan.cabal

@@ -161,6 +161,10 @@ library
                      , trial ^>= 0.0.0.0
                      , trial-optparse-applicative ^>= 0.0.0.0
                      , trial-tomland ^>= 0.0.0.0
+                     , haskell-src-exts
+                     -- This should be removed after the research is done
+                     , pretty-show
+                     , pretty-simple
 
 executable stan
   import:              common-options
@@ -221,7 +225,7 @@ test-suite stan-test
                      , tomland
                      , trial
                      , unordered-containers
-                     -- This should be removed after the reserach is done
+                     -- This should be removed after the research is done
                      , pretty-show
                      , pretty-simple
 

target/Target/PlutusTx.hs

@@ -17,7 +17,7 @@ import PlutusTx (UnsafeFromData(unsafeFromBuiltinData))
 
 -- Place for future imports
 import PlutusLedgerApi.V1 (PubKeyHash(..),Credential(..),ScriptHash(..))
---
+{-# ANN module ("onchain-contract" :: String) #-}
 --
 --
 --