{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
module Tokstyle.Linter.SecurityRank (descr) where

import           Data.Foldable                              (foldl')
import           Data.List                                  (nub)
import           Data.Map.Strict                            (Map)
import qualified Data.Map.Strict                            as Map
import           Data.Maybe                                 (fromMaybe)
import           Data.Set                                   (Set)
import qualified Data.Set                                   as Set
import           Data.Text                                  (Text)
import qualified Data.Text                                  as Text
import           Debug.Trace                                (trace)
import qualified Language.Cimple                            as C
import           Tokstyle.Analysis.CallGraph                (buildCallGraph)
import           Tokstyle.Analysis.PointsTo                 (PointsToContext (..),
                                                             PointsToSummary,
                                                             buildPointsToContext)
import           Tokstyle.Analysis.SecurityRank             (SecurityRankContext (..),
                                                             SecurityRankState (..),
                                                             SecurityRankSummary,
                                                             analyzeFunction,
                                                             buildPointsToSummaryFromAnnotation,
                                                             buildSecurityRankSummaryFromAnnotation,
                                                             findFunctionDecls,
                                                             findFunctionDefs,
                                                             findStructDefs,
                                                             getFuncNameFromDef,
                                                             runInterproceduralAnalysis)
import           Tokstyle.Analysis.SecurityRank.Annotations (parseAllAnnotations)
import           Tokstyle.Analysis.SecurityRank.Types       (SecurityRankSummaryData (..),
                                                             emptySecurityRankSummaryData)
import           Tokstyle.Analysis.Types                    (FunctionName,
                                                             lookupOrError)

-- | The main analysis function for the linter.
analyse :: [(FilePath, [C.Node (C.Lexeme Text)])] -> [Text]
analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse [(FilePath, [Node (Lexeme Text)])]
tus =
    FilePath -> [Text] -> [Text]
forall a. FilePath -> a -> a
trace (FilePath
"Analyzing files: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show (((FilePath, [Node (Lexeme Text)]) -> FilePath)
-> [(FilePath, [Node (Lexeme Text)])] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, [Node (Lexeme Text)]) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, [Node (Lexeme Text)])]
tus)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
    let
        -- 1. Parse annotations first. This is the ground truth for sources/sinks.
        annotations :: AnnotationMap
annotations = [(FilePath, [Node (Lexeme Text)])] -> AnnotationMap
parseAllAnnotations [(FilePath, [Node (Lexeme Text)])]
tus
        funcDecls :: Map Text (FilePath, Node (Lexeme Text))
funcDecls = [(FilePath, [Node (Lexeme Text)])]
-> Map Text (FilePath, Node (Lexeme Text))
findFunctionDecls [(FilePath, [Node (Lexeme Text)])]
tus
        funcDefs :: Map Text (FilePath, Node (Lexeme Text))
funcDefs = [(FilePath, [Node (Lexeme Text)])]
-> Map Text (FilePath, Node (Lexeme Text))
findFunctionDefs [(FilePath, [Node (Lexeme Text)])]
tus
        structDefs :: Map Text (Node (Lexeme Text))
structDefs = [Node (Lexeme Text)] -> Map Text (Node (Lexeme Text))
findStructDefs (((FilePath, [Node (Lexeme Text)]) -> [Node (Lexeme Text)])
-> [(FilePath, [Node (Lexeme Text)])] -> [Node (Lexeme Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath, [Node (Lexeme Text)]) -> [Node (Lexeme Text)]
forall a b. (a, b) -> b
snd [(FilePath, [Node (Lexeme Text)])]
tus)

        -- 2. Build initial summaries from annotations for all declared functions.
        initialPointsToSummaries :: Map Text PointsToSummary
initialPointsToSummaries = (Text -> Node (Lexeme Text) -> PointsToSummary)
-> Map Text (Node (Lexeme Text)) -> Map Text PointsToSummary
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (AnnotationMap -> Text -> Node (Lexeme Text) -> PointsToSummary
buildPointsToSummaryFromAnnotation AnnotationMap
annotations) (((FilePath, Node (Lexeme Text)) -> Node (Lexeme Text))
-> Map Text (FilePath, Node (Lexeme Text))
-> Map Text (Node (Lexeme Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, Node (Lexeme Text)) -> Node (Lexeme Text)
forall a b. (a, b) -> b
snd Map Text (FilePath, Node (Lexeme Text))
funcDecls)
        initialSecurityRankSummaries :: Map Text SecurityRankSummary
initialSecurityRankSummaries = (Text -> Node (Lexeme Text) -> SecurityRankSummary)
-> Map Text (Node (Lexeme Text)) -> Map Text SecurityRankSummary
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (AnnotationMap -> Text -> Node (Lexeme Text) -> SecurityRankSummary
buildSecurityRankSummaryFromAnnotation AnnotationMap
annotations) (((FilePath, Node (Lexeme Text)) -> Node (Lexeme Text))
-> Map Text (FilePath, Node (Lexeme Text))
-> Map Text (Node (Lexeme Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, Node (Lexeme Text)) -> Node (Lexeme Text)
forall a b. (a, b) -> b
snd Map Text (FilePath, Node (Lexeme Text))
funcDecls)

        -- 3. Run the unified interprocedural analysis.
        finalSecurityRankContext :: SecurityRankContext Text
finalSecurityRankContext = AnnotationMap
-> Map Text PointsToSummary
-> Map Text (FilePath, Node (Lexeme Text))
-> Map Text (FilePath, Node (Lexeme Text))
-> Map Text (Node (Lexeme Text))
-> Map Text SecurityRankSummary
-> SecurityRankContext Text
runInterproceduralAnalysis AnnotationMap
annotations Map Text PointsToSummary
initialPointsToSummaries Map Text (FilePath, Node (Lexeme Text))
funcDecls Map Text (FilePath, Node (Lexeme Text))
funcDefs Map Text (Node (Lexeme Text))
structDefs Map Text SecurityRankSummary
initialSecurityRankSummaries

        -- 4. Collect all diagnostics from the final context-sensitive analysis.
        allDiagnostics :: [Text]
allDiagnostics = SecurityRankContext Text -> [Text]
collectAllDiagnostics SecurityRankContext Text
finalSecurityRankContext
    in
        [Text]
allDiagnostics

-- | Runs the analysis on all functions and contexts to collect diagnostics.
collectAllDiagnostics :: SecurityRankContext Text -> [Text]
collectAllDiagnostics :: SecurityRankContext Text -> [Text]
collectAllDiagnostics SecurityRankContext Text
finalCtx =
    let
        allSummaries :: Map Text SecurityRankSummary
allSummaries = SecurityRankContext Text -> Map Text SecurityRankSummary
forall l. SecurityRankContext l -> Map Text SecurityRankSummary
srcSummaries SecurityRankContext Text
finalCtx
        -- Only take diagnostics from the summary for the empty context, as this
        -- represents the final, user-facing analysis of a function. Diagnostics
        -- from other contexts are intermediate and would create noise.
        allDiagnostics :: [FilePath]
allDiagnostics = (SecurityRankSummary -> [FilePath])
-> [SecurityRankSummary] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SecurityRankSummaryData -> [FilePath]
srsdDiagnostics (SecurityRankSummaryData -> [FilePath])
-> (SecurityRankSummary -> SecurityRankSummaryData)
-> SecurityRankSummary
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData (Maybe SecurityRankSummaryData -> SecurityRankSummaryData)
-> (SecurityRankSummary -> Maybe SecurityRankSummaryData)
-> SecurityRankSummary
-> SecurityRankSummaryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeId] -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup []) (Map Text SecurityRankSummary -> [SecurityRankSummary]
forall k a. Map k a -> [a]
Map.elems Map Text SecurityRankSummary
allSummaries)
    in
        (FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
Text.pack ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
allDiagnostics)


-- | The linter description record.
descr :: ([(FilePath, [C.Node (C.Lexeme Text)])] -> [Text], (Text, Text))
descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr = ([(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse, (Text
"security-rank", [Text] -> Text
Text.unlines
    [ Text
"Performs a global taint analysis based on @security_rank annotations."
    , Text
""
    , Text
"**Reason:** to prevent data with a lower security rank from flowing into"
    , Text
"a sink that requires a higher security rank."
    ]))