Lint.hs

module Hadolint.Lint
  ( lintIO,
    lint,
    analyze,
    LintOptions (..),
    ErrorRule,
    WarningRule,
    InfoRule,
    StyleRule,
    IgnoreRule,
    TrustedRegistry,
  )
where

import qualified Control.Parallel.Strategies as Parallel
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Hadolint.Formatter.Format as Format
import qualified Hadolint.Process
import qualified Hadolint.Rule
import qualified Language.Docker as Docker
import Language.Docker.Parser (DockerfileError, Error)
import Language.Docker.Syntax (Dockerfile)

type ErrorRule = Hadolint.Rule.RuleCode

type WarningRule = Hadolint.Rule.RuleCode

type InfoRule = Hadolint.Rule.RuleCode

type StyleRule = Hadolint.Rule.RuleCode

type IgnoreRule = Hadolint.Rule.RuleCode

type TrustedRegistry = Text

data LintOptions = LintOptions
  { errorRules :: [ErrorRule],
    warningRules :: [WarningRule],
    infoRules :: [InfoRule],
    styleRules :: [StyleRule],
    ignoreRules :: [IgnoreRule],
    rulesConfig :: Hadolint.Process.RulesConfig,
    failThreshold :: Hadolint.Rule.DLSeverity
  }
  deriving (Show)

instance Semigroup LintOptions where
  LintOptions a1 a2 a3 a4 a5 a6 a7 <> LintOptions b1 b2 b3 b4 b5 b6 b7 =
    LintOptions
      (a1 <> b1)
      (a2 <> b2)
      (a3 <> b3)
      (a4 <> b4)
      (a5 <> b5)
      (a6 <> b6)
      (a7 <> b7)

instance Monoid LintOptions where
  mempty = LintOptions mempty mempty mempty mempty mempty mempty mempty

-- | Performs the process of parsing the dockerfile and analyzing it with all the applicable
-- rules, depending on the list of ignored rules.
lintIO :: LintOptions -> NonEmpty.NonEmpty FilePath -> IO (NonEmpty.NonEmpty (Format.Result Text DockerfileError))
lintIO options dFiles = do
  parsedFiles <- mapM parseFile (NonEmpty.toList dFiles)
  return $ NonEmpty.fromList (lint options parsedFiles)
  where
    parseFile :: String -> IO (Text, Either Error Dockerfile)
    parseFile "-" = do
      res <- Docker.parseStdin
      return (Text.pack "-", res)
    parseFile s = do
      res <- Docker.parseFile s
      return (Text.pack s, res)

lint ::
  LintOptions ->
  [(Text, Either Error Dockerfile)] ->
  [Format.Result Text DockerfileError]
lint options parsedFiles = gather results `Parallel.using` parallelRun
  where
    gather = fmap (uncurry Format.toResult)
    results =
      [ ( name,
          fmap (analyze options) parseResult
        )
        | (name, parseResult) <- parsedFiles
      ]
    parallelRun = Parallel.parList Parallel.rseq

analyze :: LintOptions -> Dockerfile -> Seq.Seq Hadolint.Rule.CheckFailure
analyze options dockerfile = fixer process
  where
    fixer = fixSeverity options
    process = Hadolint.Process.run (rulesConfig options) dockerfile

fixSeverity :: LintOptions -> Seq.Seq Hadolint.Rule.CheckFailure -> Seq.Seq Hadolint.Rule.CheckFailure
fixSeverity LintOptions {..} = Seq.filter ignoredRules . Seq.mapWithIndex (const correctSeverity)
  where
    correctSeverity =
      makeSeverity Hadolint.Rule.DLErrorC errorRules
        . makeSeverity Hadolint.Rule.DLWarningC warningRules
        . makeSeverity Hadolint.Rule.DLInfoC infoRules
        . makeSeverity Hadolint.Rule.DLStyleC styleRules

    ignoredRules = ignoreFilter ignoreRules

    makeSeverity s rules rule@Hadolint.Rule.CheckFailure {code} =
      if code `elem` rules
        then rule {Hadolint.Rule.severity = s}
        else rule

    ignoreFilter :: [IgnoreRule] -> Hadolint.Rule.CheckFailure -> Bool
    ignoreFilter ignored Hadolint.Rule.CheckFailure {code, severity} =
      code `notElem` ignored && severity /= Hadolint.Rule.DLIgnoreC