Merge pull request #50 from pbrisbin/pb-fingerprint

Emit content-based fingerprints

codeclimate-shellcheck.cabal

@@ -23,6 +23,7 @@ library
     CC
     CC.ShellCheck.Analyze
     CC.ShellCheck.Env
+    CC.ShellCheck.Fingerprint
     CC.ShellCheck.ShellScript
     CC.ShellCheck.Types
     CC.Types
@@ -37,6 +38,7 @@ library
     , extra
     , filepath
     , Glob
+    , pureMD5
     , ShellCheck
     , text
     , yaml
@@ -70,10 +72,12 @@ test-suite codeclimate-shellcheck-test
     , bytestring
     , directory
     , filepath
+    , ShellCheck
     , string-qq
     , tasty
     , tasty-hspec
     , tasty-hunit
+    , text
     , temporary
     , hspec
   hs-source-dirs: test

src/CC/ShellCheck/Analyze.hs

@@ -3,6 +3,7 @@
 
 module CC.ShellCheck.Analyze where
 
+import           CC.ShellCheck.Fingerprint
 import           CC.ShellCheck.Types as CC
 import           CC.Types as CC
 import           Control.Exception.Base
@@ -19,7 +20,7 @@ analyze :: Env -> FilePath -> IO [Issue]
 analyze env path = do
   shellScript <- readFile path
   result <- checkScript interface $! checkSpec shellScript
-  return $! fromCheckResult env result
+  return $! fromCheckResult env result shellScript
   where
     checkSpec :: String -> CheckSpec
     checkSpec x = emptyCheckSpec { csFilename = path, csScript = x }
@@ -58,21 +59,22 @@ fromSeverity WarningC = BugRisk
 --------------------------------------------------------------------------------
 
 -- | Maps CheckResult into issues.
-fromCheckResult :: Env -> CheckResult -> [Issue]
-fromCheckResult env CheckResult{..} = fmap (fromPositionedComment env) crComments
+fromCheckResult :: Env -> CheckResult -> String -> [Issue]
+fromCheckResult env CheckResult{..} shellScript = fmap (fromPositionedComment env shellScript) crComments
 
 --------------------------------------------------------------------------------
 
 -- | Maps from a PositionedComment to an Issue.
-fromPositionedComment :: Env -> PositionedComment -> Issue
-fromPositionedComment env (PositionedComment Position{..} (Comment severity code desc)) =
+fromPositionedComment :: Env -> String -> PositionedComment -> Issue
+fromPositionedComment env shellScript p@(PositionedComment Position{..} (Comment severity code desc)) =
   Issue { _check_name         = checkName
         , _description        = description
         , _categories         = categories
         , _location           = location
         , _remediation_points = remediationPoints
         , _content            = content
         , _other_locations    = Nothing
+        , _fingerprint        = issueFingerprint p $ T.pack shellScript
         }
   where
     checkName :: T.Text

src/CC/ShellCheck/Fingerprint.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module CC.ShellCheck.Fingerprint
+    ( issueFingerprint
+    ) where
+
+import Data.Char (isSpace)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Text.Lazy (fromStrict)
+import Data.Text.Lazy.Encoding (encodeUtf8)
+import ShellCheck.Interface
+    ( Comment(..)
+    , Position(..)
+    , PositionedComment(..)
+    )
+
+import qualified Data.Digest.Pure.MD5 as MD5
+import qualified Data.Text as T
+
+-- | Given a positioned comment and the file's contents, generate a fingerprint
+--   unique to that issue
+issueFingerprint :: PositionedComment -> Text -> Text
+issueFingerprint (PositionedComment Position{..} (Comment _ code _)) script =
+    md5 $ T.intercalate "|"
+        [ T.pack $ posFile
+        , T.pack $ show code
+        , T.filter (not . isSpace) $ fetchLine (fromIntegral posLine) script
+        ]
+
+md5 :: Text -> Text
+md5 = T.pack . show . MD5.md5 . encodeUtf8 . fromStrict
+
+fetchLine :: Int -> Text -> Text
+fetchLine idx = fromMaybe "" . safeIndex (idx - 1) . T.lines
+
+safeIndex :: Int -> [a] -> Maybe a
+safeIndex idx xs
+    | idx >= 0 && idx < length xs = Just $ xs !! idx
+    | otherwise = Nothing

src/CC/Types.hs

@@ -112,6 +112,7 @@ data Issue = Issue {
   , _remediation_points :: !(Maybe Int)
   , _content            :: !(Maybe Content)
   , _other_locations    :: !(Maybe [Location])
+  , _fingerprint        :: !T.Text
 } deriving Show
 
 instance ToJSON Issue where
@@ -124,6 +125,7 @@ instance ToJSON Issue where
       , "remediation_points" .= _remediation_points
       , "content"            .= _content
       , "other_locations"    .= _other_locations
+      , "fingerprint"        .= _fingerprint
     ]
     where
       withoutNulls :: [(a, Value)] -> [(a, Value)]

test/CC/ShellCheck/FingerprintSpec.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module CC.ShellCheck.FingerprintSpec
+    ( main
+    , fingerprintSpecs
+    ) where
+
+import CC.ShellCheck.Fingerprint
+
+import Data.Text (Text)
+import ShellCheck.Interface
+    ( Code
+    , Comment(..)
+    , Position(..)
+    , PositionedComment(..)
+    , Severity(..)
+    )
+import Test.Hspec
+
+import qualified Data.Text as T
+
+main :: IO ()
+main = hspec fingerprintSpecs
+
+fingerprintSpecs :: Spec
+fingerprintSpecs = describe "issueFingerprint" $ do
+    it "uniquely identifies an issue" $ do
+        let content = T.unlines
+                [ "#!/bin/sh"
+                , ""
+                , "foo = $*"
+                , ""
+                , "bar = $*"
+                , ""
+                ]
+            fp1 = fingerprint 3 123 content
+            fp2 = fingerprint 5 123 content
+            fp3 = fingerprint 5 456 content
+
+        fp1 `shouldNotBe` fp2
+        fp2 `shouldNotBe` fp3
+
+    it "is robust against the issue moving" $ do
+        let fp1 = fingerprint 3 123 $ T.unlines
+                [ "#!/bin/sh"
+                , ""
+                , "foo = $*"
+                ]
+            fp2 = fingerprint 5 123 $ T.unlines
+                [ "#!/bin/sh"
+                , ""
+                , ""
+                , ""
+                , "foo = $*"
+                ]
+
+        fp1 `shouldBe` fp2
+
+    it "is robust against whitespace" $ do
+        let fp1 = fingerprint 3 123 $ T.unlines
+                [ "#!/bin/sh"
+                , ""
+                , "foo = $*"
+                ]
+            fp2 = fingerprint 3 123 $ T.unlines
+                [ "#!/bin/sh"
+                , ""
+                , "foo =  $*"
+                ]
+
+        fp1 `shouldBe` fp2
+
+fingerprint :: Integer -> Code -> Text -> Text
+fingerprint ln code = issueFingerprint $ PositionedComment (position ln) (comment code)
+
+position :: Integer -> Position
+position ln = Position
+    { posFile = "foo.sh"
+    , posLine = ln
+    , posColumn = 0
+    }
+
+comment :: Code -> Comment
+comment code = Comment ErrorC code ""

test/Spec.hs

@@ -13,13 +13,16 @@ import           Test.Tasty.Hspec
 import           CC.ShellCheck.ShellScript
 import           Data.Shebang
 
+import           CC.ShellCheck.FingerprintSpec (fingerprintSpecs)
+
 --------------------------------------------------------------------------------
 
 main :: IO ()
 main = do
   sbSpecs <- testSpec "Shebang Specs"  shebangSpecs
   ssSpecs <- testSpec "ShellScript Specs"  shellscriptSpecs
-  defaultMain (tests $ testGroup "All specs" [ sbSpecs, ssSpecs ])
+  fpSpecs <- testSpec "Fingerprint Specs" fingerprintSpecs
+  defaultMain (tests $ testGroup "All specs" [ sbSpecs, ssSpecs, fpSpecs ])
 
 tests :: TestTree -> TestTree
 tests specs = testGroup "Engine Tests" [ specs ]