{-# 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)
import System.Exit (exitFailure, exitSuccess)
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
| 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)
printResultsAndExit :: OutputFormat -> Format.Result Text DockerfileError -> IO ()
printResultsAndExit :: OutputFormat -> Result IgnoreRule DockerfileError -> IO ()
printResultsAndExit format :: OutputFormat
format allResults :: Result IgnoreRule DockerfileError
allResults = do
Result IgnoreRule DockerfileError -> IO ()
forall s e. (Stream s, ShowErrorComponent e) => Result s e -> IO ()
printResult Result IgnoreRule DockerfileError
allResults
if Bool -> Bool
not (Bool -> Bool)
-> (Result IgnoreRule DockerfileError -> Bool)
-> Result IgnoreRule DockerfileError
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result IgnoreRule DockerfileError -> Bool
forall s e. Result s e -> Bool
Format.isEmpty (Result IgnoreRule DockerfileError -> Bool)
-> Result IgnoreRule DockerfileError -> Bool
forall a b. (a -> b) -> a -> b
$ Result IgnoreRule DockerfileError
allResults
then IO ()
forall a. IO a
exitFailure
else IO ()
forall a. IO a
exitSuccess
where
printResult :: Result s e -> IO ()
printResult res :: Result s e
res =
case OutputFormat
format of
TTY -> Result s e -> IO ()
forall s e. (Stream s, ShowErrorComponent e) => Result s e -> IO ()
TTY.printResult Result s e
res
Json -> Result s e -> IO ()
forall s e. (Stream s, ShowErrorComponent e) => Result s e -> IO ()
Json.printResult Result s e
res
Checkstyle -> Result s e -> IO ()
forall s e. (Stream s, ShowErrorComponent e) => Result s e -> IO ()
Checkstyle.printResult Result s e
res
CodeclimateJson -> Result s e -> IO ()
forall s e. (Stream s, ShowErrorComponent e) => Result s e -> IO ()
Codeclimate.printResult Result s e
res IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
Codacy -> Result s e -> IO ()
forall s e. (Stream s, ShowErrorComponent e) => Result s e -> IO ()
Codacy.printResult Result s e
res IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
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} dFiles :: 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 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 "-" = IO (Either Error Dockerfile)
Docker.parseStdin
parseFile s :: 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 ignoreRules :: [IgnoreRule]
ignoreRules ast :: 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 fileLines :: 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 rules :: [IgnoreRule]
rules (Rules.RuleCheck (Rules.Metadata code :: IgnoreRule
code _ _) _ _ _) = IgnoreRule
code IgnoreRule -> [IgnoreRule] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [IgnoreRule]
rules
analyzeAll :: Rules.RulesConfig -> Dockerfile -> [Rules.RuleCheck]
analyzeAll :: RulesConfig -> Dockerfile -> [RuleCheck]
analyzeAll config :: RulesConfig
config = [Rule] -> Dockerfile -> [RuleCheck]
Rules.analyze ([Rule]
Rules.rules [Rule] -> [Rule] -> [Rule]
forall a. [a] -> [a] -> [a]
++ RulesConfig -> [Rule]
Rules.optionalRules RulesConfig
config)
analyzeEither :: Rules.RulesConfig -> Either t Dockerfile -> [Rules.RuleCheck]
analyzeEither :: RulesConfig -> Either t Dockerfile -> [RuleCheck]
analyzeEither _ (Left _) = []
analyzeEither config :: RulesConfig
config (Right dockerFile :: Dockerfile
dockerFile) = RulesConfig -> Dockerfile -> [RuleCheck]
analyzeAll RulesConfig
config Dockerfile
dockerFile