{-# LANGUAGE NamedFieldPuns #-}

module Hadolint.Lint where

import qualified Control.Concurrent.Async as Async
import Control.Parallel.Strategies (parListChunk, rseq, using)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import GHC.Conc (numCapabilities)
import qualified Hadolint.Formatter.Checkstyle as Checkstyle
import qualified Hadolint.Formatter.Codacy as Codacy
import qualified Hadolint.Formatter.Codeclimate as Codeclimate
import qualified Hadolint.Formatter.Format as Format
import qualified Hadolint.Formatter.Json as Json
import qualified Hadolint.Formatter.TTY as TTY
import qualified Hadolint.Rules as Rules
import qualified Language.Docker as Docker
import Language.Docker.Parser (DockerfileError, Error)
import Language.Docker.Syntax (Dockerfile)

type IgnoreRule = Text

type TrustedRegistry = Text

data LintOptions = LintOptions
  { LintOptions -> [IgnoreRule]
ignoreRules :: [IgnoreRule],
    LintOptions -> RulesConfig
rulesConfig :: Rules.RulesConfig
  }
  deriving (Int -> LintOptions -> ShowS
[LintOptions] -> ShowS
LintOptions -> String
(Int -> LintOptions -> ShowS)
-> (LintOptions -> String)
-> ([LintOptions] -> ShowS)
-> Show LintOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LintOptions] -> ShowS
$cshowList :: [LintOptions] -> ShowS
show :: LintOptions -> String
$cshow :: LintOptions -> String
showsPrec :: Int -> LintOptions -> ShowS
$cshowsPrec :: Int -> LintOptions -> ShowS
Show)

data OutputFormat
  = Json
  | TTY
  | CodeclimateJson
  | GitlabCodeclimateJson
  | Checkstyle
  | Codacy
  deriving (Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> String
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputFormat] -> ShowS
$cshowList :: [OutputFormat] -> ShowS
show :: OutputFormat -> String
$cshow :: OutputFormat -> String
showsPrec :: Int -> OutputFormat -> ShowS
$cshowsPrec :: Int -> OutputFormat -> ShowS
Show, OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c== :: OutputFormat -> OutputFormat -> Bool
Eq)

printResults :: OutputFormat -> Format.Result Text DockerfileError -> IO ()
printResults :: OutputFormat -> Result IgnoreRule DockerfileError -> IO ()
printResults OutputFormat
format Result IgnoreRule DockerfileError
allResults = do
  case OutputFormat
format of
    OutputFormat
TTY -> Result IgnoreRule DockerfileError -> IO ()
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> IO ()
TTY.printResult Result IgnoreRule DockerfileError
allResults
    OutputFormat
Json -> Result IgnoreRule DockerfileError -> IO ()
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> IO ()
Json.printResult Result IgnoreRule DockerfileError
allResults
    OutputFormat
Checkstyle -> Result IgnoreRule DockerfileError -> IO ()
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> IO ()
Checkstyle.printResult Result IgnoreRule DockerfileError
allResults
    OutputFormat
CodeclimateJson -> Result IgnoreRule DockerfileError -> IO ()
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> IO ()
Codeclimate.printResult Result IgnoreRule DockerfileError
allResults
    OutputFormat
GitlabCodeclimateJson -> Result IgnoreRule DockerfileError -> IO ()
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> IO ()
Codeclimate.printGitlabResult Result IgnoreRule DockerfileError
allResults
    OutputFormat
Codacy -> Result IgnoreRule DockerfileError -> IO ()
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> IO ()
Codacy.printResult Result IgnoreRule DockerfileError
allResults

shallSkipErrorStatus:: OutputFormat -> Bool
shallSkipErrorStatus :: OutputFormat -> Bool
shallSkipErrorStatus OutputFormat
format  = OutputFormat -> [OutputFormat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem OutputFormat
format [OutputFormat
CodeclimateJson, OutputFormat
Codacy]


-- | Performs the process of parsing the dockerfile and analyzing it with all the applicable
-- rules, depending on the list of ignored rules.
-- Depending on the preferred printing format, it will output the results to stdout
lint :: LintOptions -> NonEmpty.NonEmpty String -> IO (Format.Result Text DockerfileError)
lint :: LintOptions
-> NonEmpty String -> IO (Result IgnoreRule DockerfileError)
lint LintOptions {ignoreRules :: LintOptions -> [IgnoreRule]
ignoreRules = [IgnoreRule]
ignoreList, RulesConfig
rulesConfig :: RulesConfig
rulesConfig :: LintOptions -> RulesConfig
rulesConfig} NonEmpty String
dFiles = do
  [Either Error Dockerfile]
parsedFiles <- (String -> IO (Either Error Dockerfile))
-> [String] -> IO [Either Error Dockerfile]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
Async.mapConcurrently String -> IO (Either Error Dockerfile)
parseFile (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
dFiles)
  let results :: [Result IgnoreRule DockerfileError]
results = [Either Error Dockerfile] -> [Result IgnoreRule DockerfileError]
forall s e.
[Either (ParseErrorBundle s e) Dockerfile] -> [Result s e]
lintAll [Either Error Dockerfile]
parsedFiles [Result IgnoreRule DockerfileError]
-> Strategy [Result IgnoreRule DockerfileError]
-> [Result IgnoreRule DockerfileError]
forall a. a -> Strategy a -> a
`using` Int
-> Strategy (Result IgnoreRule DockerfileError)
-> Strategy [Result IgnoreRule DockerfileError]
forall a. Int -> Strategy a -> Strategy [a]
parListChunk (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
numCapabilities Int
2) Strategy (Result IgnoreRule DockerfileError)
forall a. Strategy a
rseq
  Result IgnoreRule DockerfileError
-> IO (Result IgnoreRule DockerfileError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result IgnoreRule DockerfileError
 -> IO (Result IgnoreRule DockerfileError))
-> Result IgnoreRule DockerfileError
-> IO (Result IgnoreRule DockerfileError)
forall a b. (a -> b) -> a -> b
$ [Result IgnoreRule DockerfileError]
-> Result IgnoreRule DockerfileError
forall a. Monoid a => [a] -> a
mconcat [Result IgnoreRule DockerfileError]
results
  where
    parseFile :: String -> IO (Either Error Dockerfile)
    parseFile :: String -> IO (Either Error Dockerfile)
parseFile String
"-" = IO (Either Error Dockerfile)
Docker.parseStdin
    parseFile String
s = String -> IO (Either Error Dockerfile)
Docker.parseFile String
s

    lintAll :: [Either (ParseErrorBundle s e) Dockerfile] -> [Result s e]
lintAll = (Either (ParseErrorBundle s e) Dockerfile -> Result s e)
-> [Either (ParseErrorBundle s e) Dockerfile] -> [Result s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([IgnoreRule]
-> Either (ParseErrorBundle s e) Dockerfile -> Result s e
forall s e.
[IgnoreRule]
-> Either (ParseErrorBundle s e) Dockerfile -> Result s e
lintDockerfile [IgnoreRule]
ignoreList)

    lintDockerfile :: [IgnoreRule]
-> Either (ParseErrorBundle s e) Dockerfile -> Result s e
lintDockerfile [IgnoreRule]
ignoreRules Either (ParseErrorBundle s e) Dockerfile
ast = Either (ParseErrorBundle s e) Dockerfile -> Result s e
forall s e. Either (ParseErrorBundle s e) Dockerfile -> Result s e
processedFile Either (ParseErrorBundle s e) Dockerfile
ast
      where
        processedFile :: Either (ParseErrorBundle s e) Dockerfile -> Result s e
processedFile = Either (ParseErrorBundle s e) [RuleCheck] -> Result s e
forall s e. Either (ParseErrorBundle s e) [RuleCheck] -> Result s e
Format.toResult (Either (ParseErrorBundle s e) [RuleCheck] -> Result s e)
-> (Either (ParseErrorBundle s e) Dockerfile
    -> Either (ParseErrorBundle s e) [RuleCheck])
-> Either (ParseErrorBundle s e) Dockerfile
-> Result s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dockerfile -> [RuleCheck])
-> Either (ParseErrorBundle s e) Dockerfile
-> Either (ParseErrorBundle s e) [RuleCheck]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dockerfile -> [RuleCheck]
processRules
        processRules :: Dockerfile -> [RuleCheck]
processRules Dockerfile
fileLines = (RuleCheck -> Bool) -> [RuleCheck] -> [RuleCheck]
forall a. (a -> Bool) -> [a] -> [a]
filter RuleCheck -> Bool
ignoredRules (RulesConfig -> Dockerfile -> [RuleCheck]
analyzeAll RulesConfig
rulesConfig Dockerfile
fileLines)
        ignoredRules :: RuleCheck -> Bool
ignoredRules = [IgnoreRule] -> RuleCheck -> Bool
ignoreFilter [IgnoreRule]
ignoreRules

        ignoreFilter :: [IgnoreRule] -> Rules.RuleCheck -> Bool
        ignoreFilter :: [IgnoreRule] -> RuleCheck -> Bool
ignoreFilter [IgnoreRule]
rules (Rules.RuleCheck (Rules.Metadata IgnoreRule
code Severity
_ IgnoreRule
_) IgnoreRule
_ Int
_ Bool
_) = IgnoreRule
code IgnoreRule -> [IgnoreRule] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [IgnoreRule]
rules

-- | Returns the result of applying all the rules to the given dockerfile
analyzeAll :: Rules.RulesConfig -> Dockerfile -> [Rules.RuleCheck]
analyzeAll :: RulesConfig -> Dockerfile -> [RuleCheck]
analyzeAll RulesConfig
config = [Rule] -> Dockerfile -> [RuleCheck]
Rules.analyze ([Rule]
Rules.rules [Rule] -> [Rule] -> [Rule]
forall a. [a] -> [a] -> [a]
++ RulesConfig -> [Rule]
Rules.optionalRules RulesConfig
config)

-- | Helper to analyze AST quickly in GHCI
analyzeEither :: Rules.RulesConfig -> Either t Dockerfile -> [Rules.RuleCheck]
analyzeEither :: RulesConfig -> Either t Dockerfile -> [RuleCheck]
analyzeEither RulesConfig
_ (Left t
_) = []
analyzeEither RulesConfig
config (Right Dockerfile
dockerFile) = RulesConfig -> Dockerfile -> [RuleCheck]
analyzeAll RulesConfig
config Dockerfile
dockerFile