{-# 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