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 = Text

type WarningRule = Text

type InfoRule = Text

type StyleRule = Text

type IgnoreRule = Hadolint.Rule.RuleCode

type TrustedRegistry = Text

data LintOptions = LintOptions
  { LintOptions -> [ErrorRule]
errorRules :: [ErrorRule],
    LintOptions -> [ErrorRule]
warningRules :: [WarningRule],
    LintOptions -> [ErrorRule]
infoRules :: [InfoRule],
    LintOptions -> [ErrorRule]
styleRules :: [StyleRule],
    LintOptions -> [IgnoreRule]
ignoreRules :: [IgnoreRule],
    LintOptions -> RulesConfig
rulesConfig :: Hadolint.Process.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)

instance Semigroup LintOptions where
  LintOptions [ErrorRule]
a1 [ErrorRule]
a2 [ErrorRule]
a3 [ErrorRule]
a4 [IgnoreRule]
a5 RulesConfig
a6 <> :: LintOptions -> LintOptions -> LintOptions
<> LintOptions [ErrorRule]
b1 [ErrorRule]
b2 [ErrorRule]
b3 [ErrorRule]
b4 [IgnoreRule]
b5 RulesConfig
b6 =
    [ErrorRule]
-> [ErrorRule]
-> [ErrorRule]
-> [ErrorRule]
-> [IgnoreRule]
-> RulesConfig
-> LintOptions
LintOptions
      ([ErrorRule]
a1 [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> [ErrorRule]
b1)
      ([ErrorRule]
a2 [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> [ErrorRule]
b2)
      ([ErrorRule]
a3 [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> [ErrorRule]
b3)
      ([ErrorRule]
a4 [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> [ErrorRule]
b4)
      ([IgnoreRule]
a5 [IgnoreRule] -> [IgnoreRule] -> [IgnoreRule]
forall a. Semigroup a => a -> a -> a
<> [IgnoreRule]
b5)
      (RulesConfig
a6 RulesConfig -> RulesConfig -> RulesConfig
forall a. Semigroup a => a -> a -> a
<> RulesConfig
b6)

instance Monoid LintOptions where
  mempty :: LintOptions
mempty = [ErrorRule]
-> [ErrorRule]
-> [ErrorRule]
-> [ErrorRule]
-> [IgnoreRule]
-> RulesConfig
-> LintOptions
LintOptions [ErrorRule]
forall a. Monoid a => a
mempty [ErrorRule]
forall a. Monoid a => a
mempty [ErrorRule]
forall a. Monoid a => a
mempty [ErrorRule]
forall a. Monoid a => a
mempty [IgnoreRule]
forall a. Monoid a => a
mempty RulesConfig
forall a. Monoid a => a
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 :: LintOptions
-> NonEmpty String
-> IO (NonEmpty (Result ErrorRule DockerfileError))
lintIO LintOptions
options NonEmpty String
dFiles = do
  [(ErrorRule, Either Error Dockerfile)]
parsedFiles <- (String -> IO (ErrorRule, Either Error Dockerfile))
-> [String] -> IO [(ErrorRule, Either Error Dockerfile)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (ErrorRule, Either Error Dockerfile)
parseFile (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
dFiles)
  NonEmpty (Result ErrorRule DockerfileError)
-> IO (NonEmpty (Result ErrorRule DockerfileError))
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Result ErrorRule DockerfileError)
 -> IO (NonEmpty (Result ErrorRule DockerfileError)))
-> NonEmpty (Result ErrorRule DockerfileError)
-> IO (NonEmpty (Result ErrorRule DockerfileError))
forall a b. (a -> b) -> a -> b
$ [Result ErrorRule DockerfileError]
-> NonEmpty (Result ErrorRule DockerfileError)
forall a. [a] -> NonEmpty a
NonEmpty.fromList (LintOptions
-> [(ErrorRule, Either Error Dockerfile)]
-> [Result ErrorRule DockerfileError]
lint LintOptions
options [(ErrorRule, Either Error Dockerfile)]
parsedFiles)
  where
    parseFile :: String -> IO (Text, Either Error Dockerfile)
    parseFile :: String -> IO (ErrorRule, Either Error Dockerfile)
parseFile String
"-" = do
      Either Error Dockerfile
res <- IO (Either Error Dockerfile)
Docker.parseStdin
      (ErrorRule, Either Error Dockerfile)
-> IO (ErrorRule, Either Error Dockerfile)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ErrorRule
Text.pack String
"-", Either Error Dockerfile
res)
    parseFile String
s = do
      Either Error Dockerfile
res <- String -> IO (Either Error Dockerfile)
Docker.parseFile String
s
      (ErrorRule, Either Error Dockerfile)
-> IO (ErrorRule, Either Error Dockerfile)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ErrorRule
Text.pack String
s, Either Error Dockerfile
res)

lint ::
  LintOptions ->
  [(Text, Either Error Dockerfile)] ->
  [Format.Result Text DockerfileError]
lint :: LintOptions
-> [(ErrorRule, Either Error Dockerfile)]
-> [Result ErrorRule DockerfileError]
lint LintOptions
options [(ErrorRule, Either Error Dockerfile)]
parsedFiles = [(ErrorRule, Either Error Failures)]
-> [Result ErrorRule DockerfileError]
forall s e.
[(ErrorRule, Either (ParseErrorBundle s e) Failures)]
-> [Result s e]
gather [(ErrorRule, Either Error Failures)]
results [Result ErrorRule DockerfileError]
-> Strategy [Result ErrorRule DockerfileError]
-> [Result ErrorRule DockerfileError]
forall a. a -> Strategy a -> a
`Parallel.using` Strategy [Result ErrorRule DockerfileError]
forall a. Strategy [a]
parallelRun
  where
    gather :: [(ErrorRule, Either (ParseErrorBundle s e) Failures)]
-> [Result s e]
gather = ((ErrorRule, Either (ParseErrorBundle s e) Failures) -> Result s e)
-> [(ErrorRule, Either (ParseErrorBundle s e) Failures)]
-> [Result s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ErrorRule -> Either (ParseErrorBundle s e) Failures -> Result s e)
-> (ErrorRule, Either (ParseErrorBundle s e) Failures)
-> Result s e
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ErrorRule -> Either (ParseErrorBundle s e) Failures -> Result s e
forall s e.
ErrorRule -> Either (ParseErrorBundle s e) Failures -> Result s e
Format.toResult)
    results :: [(ErrorRule, Either Error Failures)]
results =
      [ ( ErrorRule
name,
          (Dockerfile -> Failures)
-> Either Error Dockerfile -> Either Error Failures
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LintOptions -> Dockerfile -> Failures
analyze LintOptions
options) Either Error Dockerfile
parseResult
        )
        | (ErrorRule
name, Either Error Dockerfile
parseResult) <- [(ErrorRule, Either Error Dockerfile)]
parsedFiles
      ]
    parallelRun :: Strategy [a]
parallelRun = Strategy a -> Strategy [a]
forall a. Strategy a -> Strategy [a]
Parallel.parList Strategy a
forall a. Strategy a
Parallel.rseq

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

fixSeverity :: LintOptions -> Seq.Seq Hadolint.Rule.CheckFailure -> Seq.Seq Hadolint.Rule.CheckFailure
fixSeverity :: LintOptions -> Failures -> Failures
fixSeverity LintOptions {[ErrorRule]
[IgnoreRule]
RulesConfig
rulesConfig :: RulesConfig
ignoreRules :: [IgnoreRule]
styleRules :: [ErrorRule]
infoRules :: [ErrorRule]
warningRules :: [ErrorRule]
errorRules :: [ErrorRule]
rulesConfig :: LintOptions -> RulesConfig
ignoreRules :: LintOptions -> [IgnoreRule]
styleRules :: LintOptions -> [ErrorRule]
infoRules :: LintOptions -> [ErrorRule]
warningRules :: LintOptions -> [ErrorRule]
errorRules :: LintOptions -> [ErrorRule]
..} = (CheckFailure -> Bool) -> Failures -> Failures
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter CheckFailure -> Bool
ignoredRules (Failures -> Failures)
-> (Failures -> Failures) -> Failures -> Failures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> CheckFailure -> CheckFailure) -> Failures -> Failures
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex ((CheckFailure -> CheckFailure)
-> Int -> CheckFailure -> CheckFailure
forall a b. a -> b -> a
const CheckFailure -> CheckFailure
correctSeverity)
  where
    correctSeverity :: CheckFailure -> CheckFailure
correctSeverity =
      DLSeverity -> [IgnoreRule] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t IgnoreRule -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
Hadolint.Rule.DLErrorC ((ErrorRule -> IgnoreRule) -> [ErrorRule] -> [IgnoreRule]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorRule -> IgnoreRule
Hadolint.Rule.RuleCode [ErrorRule]
errorRules)
        (CheckFailure -> CheckFailure)
-> (CheckFailure -> CheckFailure) -> CheckFailure -> CheckFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLSeverity -> [IgnoreRule] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t IgnoreRule -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
Hadolint.Rule.DLWarningC ((ErrorRule -> IgnoreRule) -> [ErrorRule] -> [IgnoreRule]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorRule -> IgnoreRule
Hadolint.Rule.RuleCode [ErrorRule]
warningRules)
        (CheckFailure -> CheckFailure)
-> (CheckFailure -> CheckFailure) -> CheckFailure -> CheckFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLSeverity -> [IgnoreRule] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t IgnoreRule -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
Hadolint.Rule.DLInfoC ((ErrorRule -> IgnoreRule) -> [ErrorRule] -> [IgnoreRule]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorRule -> IgnoreRule
Hadolint.Rule.RuleCode [ErrorRule]
infoRules)
        (CheckFailure -> CheckFailure)
-> (CheckFailure -> CheckFailure) -> CheckFailure -> CheckFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLSeverity -> [IgnoreRule] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t IgnoreRule -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
Hadolint.Rule.DLStyleC ((ErrorRule -> IgnoreRule) -> [ErrorRule] -> [IgnoreRule]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorRule -> IgnoreRule
Hadolint.Rule.RuleCode [ErrorRule]
styleRules)

    ignoredRules :: CheckFailure -> Bool
ignoredRules = [IgnoreRule] -> CheckFailure -> Bool
ignoreFilter [IgnoreRule]
ignoreRules

    makeSeverity :: DLSeverity -> t IgnoreRule -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
s t IgnoreRule
rules rule :: CheckFailure
rule@Hadolint.Rule.CheckFailure {IgnoreRule
code :: CheckFailure -> IgnoreRule
code :: IgnoreRule
code} =
      if IgnoreRule
code IgnoreRule -> t IgnoreRule -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t IgnoreRule
rules
        then CheckFailure
rule {severity :: DLSeverity
Hadolint.Rule.severity = DLSeverity
s}
        else CheckFailure
rule

    ignoreFilter :: [IgnoreRule] -> Hadolint.Rule.CheckFailure -> Bool
    ignoreFilter :: [IgnoreRule] -> CheckFailure -> Bool
ignoreFilter [IgnoreRule]
ignored Hadolint.Rule.CheckFailure {IgnoreRule
code :: IgnoreRule
code :: CheckFailure -> IgnoreRule
code, DLSeverity
severity :: DLSeverity
severity :: CheckFailure -> DLSeverity
severity} =
      IgnoreRule
code IgnoreRule -> [IgnoreRule] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [IgnoreRule]
ignored Bool -> Bool -> Bool
&& DLSeverity
severity DLSeverity -> DLSeverity -> Bool
forall a. Eq a => a -> a -> Bool
/= DLSeverity
Hadolint.Rule.DLIgnoreC