{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Hadolint.Formatter.Codeclimate ( printResult, printGitlabResult, formatResult, ) where import Crypto.Hash (Digest, SHA1 (..), hash) import Data.Aeson hiding (Result) import qualified Data.ByteString.Lazy as B import Data.Sequence (Seq) import qualified Data.Text as Text import GHC.Generics import Hadolint.Formatter.Format (Result (..), errorPosition) import Hadolint.Rules (Metadata (..), RuleCheck (..), DLSeverity (..)) import Text.Megaparsec (TraversableStream) import Text.Megaparsec.Error import Text.Megaparsec.Pos (sourceColumn, sourceLine, sourceName, unPos) import Text.Megaparsec.Stream (VisualStream) data Issue = Issue { Issue -> String checkName :: String, Issue -> String description :: String, Issue -> Location location :: Location, Issue -> String impact :: String } data FingerprintIssue = FingerprintIssue { FingerprintIssue -> Issue issue :: Issue, FingerprintIssue -> Digest SHA1 fingerprint :: Digest SHA1 } data Location = LocLine String Int | LocPos String Pos instance ToJSON Location where toJSON :: Location -> Value toJSON (LocLine String path Int l) = [Pair] -> Value object [Text "path" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String path, Text "lines" Text -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= [Pair] -> Value object [Text "begin" Text -> Int -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Int l, Text "end" Text -> Int -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Int l]] toJSON (LocPos String path Pos pos) = [Pair] -> Value object [Text "path" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String path, Text "positions" Text -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= [Pair] -> Value object [Text "begin" Text -> Pos -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Pos pos, Text "end" Text -> Pos -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Pos pos]] data Pos = Pos { Pos -> Int line :: Int, Pos -> Int column :: Int } deriving ((forall x. Pos -> Rep Pos x) -> (forall x. Rep Pos x -> Pos) -> Generic Pos forall x. Rep Pos x -> Pos forall x. Pos -> Rep Pos x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Pos x -> Pos $cfrom :: forall x. Pos -> Rep Pos x Generic) instance ToJSON Pos instance ToJSON Issue where toJSON :: Issue -> Value toJSON Issue {String Location impact :: String location :: Location description :: String checkName :: String impact :: Issue -> String location :: Issue -> Location description :: Issue -> String checkName :: Issue -> String ..} = [Pair] -> Value object [ Text "type" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= (String "issue" :: String), Text "check_name" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String checkName, Text "description" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String description, Text "categories" Text -> [String] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= ([String "Bug Risk"] :: [String]), Text "location" Text -> Location -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Location location, Text "severity" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String impact ] instance ToJSON FingerprintIssue where toJSON :: FingerprintIssue -> Value toJSON FingerprintIssue {Digest SHA1 Issue fingerprint :: Digest SHA1 issue :: Issue fingerprint :: FingerprintIssue -> Digest SHA1 issue :: FingerprintIssue -> Issue ..} = [Pair] -> Value object [ Text "type" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= (String "issue" :: String), Text "fingerprint" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Digest SHA1 -> String forall a. Show a => a -> String show Digest SHA1 fingerprint, Text "check_name" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Issue -> String checkName Issue issue, Text "description" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Issue -> String description Issue issue, Text "categories" Text -> [String] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= ([String "Bug Risk"] :: [String]), Text "location" Text -> Location -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Issue -> Location location Issue issue, Text "severity" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Issue -> String impact Issue issue ] errorToIssue :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue :: ParseErrorBundle s e -> Issue errorToIssue ParseErrorBundle s e err = Issue :: String -> String -> Location -> String -> Issue Issue { checkName :: String checkName = String "DL1000", description :: String description = ParseErrorBundle s e -> String forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorBundlePretty ParseErrorBundle s e err, location :: Location location = String -> Pos -> Location LocPos (SourcePos -> String sourceName SourcePos pos) Pos :: Int -> Int -> Pos Pos {Int column :: Int line :: Int column :: Int line :: Int ..}, impact :: String impact = DLSeverity -> String severityText DLSeverity DLErrorC } where pos :: SourcePos pos = ParseErrorBundle s e -> SourcePos forall s e. TraversableStream s => ParseErrorBundle s e -> SourcePos errorPosition ParseErrorBundle s e err line :: Int line = Pos -> Int unPos (SourcePos -> Pos sourceLine SourcePos pos) column :: Int column = Pos -> Int unPos (SourcePos -> Pos sourceColumn SourcePos pos) checkToIssue :: RuleCheck -> Issue checkToIssue :: RuleCheck -> Issue checkToIssue RuleCheck {Bool Int Text Metadata success :: RuleCheck -> Bool linenumber :: RuleCheck -> Int filename :: RuleCheck -> Text metadata :: RuleCheck -> Metadata success :: Bool linenumber :: Int filename :: Text metadata :: Metadata ..} = Issue :: String -> String -> Location -> String -> Issue Issue { checkName :: String checkName = Text -> String Text.unpack (Metadata -> Text code Metadata metadata), description :: String description = Text -> String Text.unpack (Metadata -> Text message Metadata metadata), location :: Location location = String -> Int -> Location LocLine (Text -> String Text.unpack Text filename) Int linenumber, impact :: String impact = DLSeverity -> String severityText (Metadata -> DLSeverity severity Metadata metadata) } severityText :: DLSeverity -> String severityText :: DLSeverity -> String severityText DLSeverity severity = case DLSeverity severity of DLSeverity DLErrorC -> String "blocker" DLSeverity DLWarningC -> String "major" DLSeverity DLInfoC -> String "info" DLSeverity DLStyleC -> String "minor" DLSeverity _ -> String "" generateFingerprint :: Issue -> Digest SHA1 generateFingerprint :: Issue -> Digest SHA1 generateFingerprint = ByteString -> Digest SHA1 forall ba a. (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a hash (ByteString -> Digest SHA1) -> (Issue -> ByteString) -> Issue -> Digest SHA1 forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString B.toStrict (ByteString -> ByteString) -> (Issue -> ByteString) -> Issue -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . Issue -> ByteString forall a. ToJSON a => a -> ByteString encode issueToFingerprintIssue :: Issue -> FingerprintIssue issueToFingerprintIssue :: Issue -> FingerprintIssue issueToFingerprintIssue Issue i = FingerprintIssue :: Issue -> Digest SHA1 -> FingerprintIssue FingerprintIssue { issue :: Issue issue = Issue i, fingerprint :: Digest SHA1 fingerprint = Issue -> Digest SHA1 generateFingerprint Issue i } formatResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult :: Result s e -> Seq Issue formatResult (Result Seq (ParseErrorBundle s e) errors Seq RuleCheck checks) = (ParseErrorBundle s e -> Issue forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue (ParseErrorBundle s e -> Issue) -> Seq (ParseErrorBundle s e) -> Seq Issue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Seq (ParseErrorBundle s e) errors) Seq Issue -> Seq Issue -> Seq Issue forall a. Semigroup a => a -> a -> a <> (RuleCheck -> Issue checkToIssue (RuleCheck -> Issue) -> Seq RuleCheck -> Seq Issue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Seq RuleCheck checks) formatGitlabResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq FingerprintIssue formatGitlabResult :: Result s e -> Seq FingerprintIssue formatGitlabResult Result s e result = Issue -> FingerprintIssue issueToFingerprintIssue (Issue -> FingerprintIssue) -> Seq Issue -> Seq FingerprintIssue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Result s e -> Seq Issue forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult Result s e result printResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> IO () printResult :: Result s e -> IO () printResult Result s e result = (Issue -> IO ()) -> Seq Issue -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ Issue -> IO () forall a. ToJSON a => a -> IO () output (Result s e -> Seq Issue forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult Result s e result) where output :: a -> IO () output a value = do ByteString -> IO () B.putStr (a -> ByteString forall a. ToJSON a => a -> ByteString encode a value) ByteString -> IO () B.putStr (Word8 -> ByteString B.singleton Word8 0x00) printGitlabResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> IO () printGitlabResult :: Result s e -> IO () printGitlabResult = ByteString -> IO () B.putStr (ByteString -> IO ()) -> (Result s e -> ByteString) -> Result s e -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . Seq FingerprintIssue -> ByteString forall a. ToJSON a => a -> ByteString encode (Seq FingerprintIssue -> ByteString) -> (Result s e -> Seq FingerprintIssue) -> Result s e -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . Result s e -> Seq FingerprintIssue forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq FingerprintIssue formatGitlabResult