{-# LANGUAGE NamedFieldPuns #-}

module Hadolint.Lint where

import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Language.Docker as Docker
import Language.Docker.Parser (DockerfileError, Error)
import Language.Docker.Syntax (Dockerfile)
import System.Exit (exitFailure, exitSuccess)

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

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

-- | 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} dFiles :: NonEmpty String
dFiles = do
    [Either Error [RuleCheck]]
processedFiles <- (String -> IO (Either Error [RuleCheck]))
-> [String] -> IO [Either Error [RuleCheck]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([IgnoreRule] -> String -> IO (Either Error [RuleCheck])
lintDockerfile [IgnoreRule]
ignoreList) (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
dFiles)
    Result IgnoreRule DockerfileError
-> IO (Result IgnoreRule DockerfileError)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either Error [RuleCheck]] -> Result IgnoreRule DockerfileError
forall s e.
[Either (ParseErrorBundle s e) [RuleCheck]] -> Result s e
results [Either Error [RuleCheck]]
processedFiles)
  where
    results :: [Either (ParseErrorBundle s e) [RuleCheck]] -> Result s e
results = (Either (ParseErrorBundle s e) [RuleCheck] -> Result s e)
-> [Either (ParseErrorBundle s e) [RuleCheck]] -> Result s e
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Either (ParseErrorBundle s e) [RuleCheck] -> Result s e
forall s e. Either (ParseErrorBundle s e) [RuleCheck] -> Result s e
Format.toResult -- Parse and check rules for each dockerfile,
                                      -- then convert them to a Result and combine with
                                      -- the result of the previous dockerfile results
    lintDockerfile :: [IgnoreRule] -> String -> IO (Either Error [RuleCheck])
lintDockerfile ignoreRules :: [IgnoreRule]
ignoreRules dockerFile :: String
dockerFile = do
        Either Error Dockerfile
ast <- String -> IO (Either Error Dockerfile)
parseFilename String
dockerFile
        Either Error [RuleCheck] -> IO (Either Error [RuleCheck])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Dockerfile -> Either Error [RuleCheck]
processedFile Either Error Dockerfile
ast)
      where
        processedFile :: Either Error Dockerfile -> Either Error [RuleCheck]
processedFile = (Dockerfile -> [RuleCheck])
-> Either Error Dockerfile -> Either Error [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
        -- | Returns true if the rule should be ignored
        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
        -- | Support UNIX convention of passing "-" instead of "/dev/stdin"
        parseFilename :: String -> IO (Either Error Dockerfile)
        parseFilename :: String -> IO (Either Error Dockerfile)
parseFilename "-" = IO (Either Error Dockerfile)
Docker.parseStdin
        parseFilename s :: String
s = String -> IO (Either Error Dockerfile)
Docker.parseFile String
s

-- | Returns the result of applying all the rules to the given dockerfile
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)

-- | Helper to analyze AST quickly in GHCI
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