diff --git a/src/Stan.hs b/src/Stan.hs index b4911590..51f3ca2a 100644 --- a/src/Stan.hs +++ b/src/Stan.hs @@ -38,6 +38,7 @@ import Stan.Inspection (Inspection (..), inspectionsMd, prettyShowInspection, import Stan.Inspection.All (getInspectionById, inspections, lookupInspectionById) import Stan.Observation (Observation (..), prettyShowIgnoredObservations) import Stan.Report (generateReport) +import Stan.SARIF (toSARIF) import Stan.Severity (Severity (Error)) import Stan.Toml (configCodec, getTomlConfig, usedTomlFiles) @@ -55,6 +56,7 @@ run = runStanCli >>= \case runStan :: StanArgs -> IO () runStan StanArgs{..} = do let notJson = not stanArgsJsonOut + && not stanArgsSARIF -- ENV vars env@EnvVars{..} <- getEnvVars let defConfTrial = envVarsUseDefaultConfigFile <> stanArgsUseDefaultConfigFile @@ -89,7 +91,10 @@ runStan StanArgs{..} = do then successMessage "All clean! Stan did not find any observations at the moment." else warningMessage "Stan found the following observations for the project:\n" putTextLn $ prettyShowAnalysis analysis stanArgsOutputSettings - else putLBSLn $ encode analysis + else + if stanArgsSARIF + then putLBSLn $ toSARIF analysis + else putLBSLn $ encode analysis -- report generation whenJust stanArgsReport $ \ReportArgs{..} -> do diff --git a/src/Stan/Cli.hs b/src/Stan/Cli.hs index 4474170f..330494f7 100644 --- a/src/Stan/Cli.hs +++ b/src/Stan/Cli.hs @@ -61,6 +61,7 @@ data StanArgs = StanArgs , stanArgsConfigFile :: !(Maybe FilePath) -- ^ Path to a custom configurations file. , stanArgsConfig :: !PartialConfig , stanArgsJsonOut :: !Bool -- ^ Output the machine-readable output in JSON format instead. + , stanArgsSARIF :: !Bool -- ^ Output the results as a SARIF file. } newtype ReportArgs = ReportArgs @@ -122,6 +123,7 @@ stanP = do stanArgsUseDefaultConfigFile <- useDefaultConfigFileP stanArgsOutputSettings <- outputSettingsP stanArgsJsonOut <- jsonOutputP + stanArgsSARIF <- sarifOutputP pure $ Stan StanArgs{..} -- | @stan inspection@ command parser. @@ -210,6 +212,12 @@ jsonOutputP = switch $ mconcat , help "Output the machine-readable output in JSON format instead" ] +sarifOutputP :: Parser Bool +sarifOutputP = switch $ mconcat + [ long "sarif" + , help "Output the results as a SARIF file" + ] + reportP :: Parser (Maybe ReportArgs) reportP = optional $ hsubparser diff --git a/src/Stan/SARIF.hs b/src/Stan/SARIF.hs new file mode 100644 index 00000000..fc24c9c6 --- /dev/null +++ b/src/Stan/SARIF.hs @@ -0,0 +1,128 @@ +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Provides functions to convert @Stan@'s data types to equivalent SARIF ones. +-} + +module Stan.SARIF + ( toSARIF + ) where + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Map.Lazy as Map +import Data.SARIF as SARIF +import qualified Data.Text as T +import Data.Version (showVersion) + +import Paths_stan (version) +import Stan.Analysis (Analysis (..)) +import Stan.Core.Id +import Stan.FileInfo +import Stan.Ghc.Compat +import Stan.Inspection +import Stan.Inspection.All (inspections) +import Stan.Observation +import Stan.Severity as Stan + +-- | Represents @Stan@ as a `SARIF.Tool` value. +stanTool :: SARIF.Tool +stanTool = MkTool{ + toolDriver = defaultToolComponent{ + toolComponentName = Just "Stan", + -- Haskell versions aren't valid semver versions + toolComponentVersion = Just $ T.pack $ showVersion version, + toolComponentInformationUri = Just "https://github.com/kowainik/stan/", + toolComponentRules = Map.elems reportingDescriptors + }, + toolExtensions = [] +} + +-- | `fileMapToArtifacts` @fileMap@ converts @fileMap@ to a list of +-- `SARIF.Artifact` values. +fileMapToArtifacts :: FileMap -> [SARIF.Artifact] +fileMapToArtifacts fm = map toArtifact $ Map.keys fm + where toArtifact fp = MkArtifact{ + artifactLocation = MkArtifactLocation{ + artifactLocationUri = T.pack fp + }, + artifactMimeType = Nothing + } + +-- | `toLevel` @severity@ converts a @Stan@ `Severity` to a SARIF `Level`. +toLevel :: Severity -> Level +toLevel Style = Note +toLevel Performance = SARIF.Warning +toLevel PotentialBug = SARIF.Warning +toLevel Stan.Warning = SARIF.Warning +toLevel Stan.Error = SARIF.Error + +-- | `toReportingDescriptor` @inspection@ converts @inspection@ to +-- a `SARIF.ReportingDescriptor`. +toReportingDescriptor :: Inspection -> SARIF.ReportingDescriptor +toReportingDescriptor Inspection{..} = + (defaultReportingDescriptor $ unId inspectionId){ + rdName = Nothing, + rdShortDescription = Just $ + defaultMultiformatMessageString inspectionName, + rdFullDescription = Just $ + defaultMultiformatMessageString inspectionDescription, + -- TODO: make this useful + rdHelpUri = Just "https://github.com/kowainik/stan/", + rdHelp = Just $ + defaultMultiformatMessageString (T.unlines inspectionSolution), + rdDefaultConfiguration = Just $ defaultReportingConfiguration{ + rcLevel = Just $ toLevel inspectionSeverity + } -- , + -- tricky, because Stan isn't currently using aeson + -- rdProperties = Map.singleton "tags" $ _ $ map (toJSON . _) inspectionCategory + } + +-- | `reportingDescriptors` is a `Map.Map` of `SARIF.ReportingDescriptor` which +-- correspond to @Stan@ `Inspection`s, indexed by their Id. +reportingDescriptors :: Map.Map Text SARIF.ReportingDescriptor +reportingDescriptors = Map.fromList + [ (rdId rd, rd) | rd <- map toReportingDescriptor inspections ] + +-- | `observationToResult` @observation@ converts an @observation@ to +-- a `SARIF.Result`. +observationToResult :: Observation -> SARIF.Result +observationToResult Observation{..} = + let mrd = Map.lookup (unId observationInspectionId) reportingDescriptors + in MkResult{ + resultRuleId = unId observationInspectionId, + resultLevel = Nothing, + resultMessage = MkMessage{ + messageText = fromMaybe "A problem was detected here." $ + mrd >>= fmap mmsText . rdFullDescription + }, + resultLocations = [ + MkLocation{ + locationPhysicalLocation = Just MkPhysicalLocation{ + physicalLocationArtifactLocation = MkArtifactLocation{ + artifactLocationUri = T.pack observationFile + }, + physicalLocationRegion = MkRegion{ + regionStartLine = srcSpanStartLine observationSrcSpan, + regionStartColumn = srcSpanStartCol observationSrcSpan, + regionEndLine = srcSpanEndLine observationSrcSpan, + regionEndColumn = srcSpanEndCol observationSrcSpan + } + } + } + ] + } + +-- | `toSARIF` @analysis@ converts an @analysis@ to a SARIF log and encodes it +-- as JSON which is returned as a `LBS.ByteString`. +toSARIF :: Analysis -> LBS.ByteString +toSARIF Analysis{..} = encodeSarifAsLBS $ defaultLog{ + logRuns = [ + MkRun{ + runTool = stanTool, + runArtifacts = fileMapToArtifacts analysisFileMap, + runResults = map observationToResult $ toList analysisObservations + } + ] +} diff --git a/stack.yaml b/stack.yaml index f77cfed1..878cfe48 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,8 @@ resolver: lts-18.18 extra-deps: +- git: https://github.com/mbg/sarif.git + commit: 08d1a9878de944b8de0a67dc4cf0f0634b23fd08 - colourista-0.1.0.1 - dir-traverse-0.2.2.3 - dlist-0.8.0.8 diff --git a/stan.cabal b/stan.cabal index f049259a..fbb972d1 100644 --- a/stan.cabal +++ b/stan.cabal @@ -110,6 +110,7 @@ library Stan.Report.Css Stan.Report.Html Stan.Report.Settings + Stan.SARIF Stan.Severity Stan.Toml @@ -134,6 +135,7 @@ library , optparse-applicative >= 0.15 && < 0.17 , pretty-simple ^>= 4.0 , process ^>= 1.6.8.0 + , sarif ^>= 0.1 , slist ^>= 0.1 , tomland ^>= 1.3.0.0 , trial ^>= 0.0.0.0