module Hadolint.Lint
  ( lintIO,
    lint,
    analyze,
    TrustedRegistry,
  )
where

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


type TrustedRegistry = Text


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

lint ::
  Configuration ->
  [(Text, Either Error Dockerfile)] ->
  [Format.Result Text DockerfileError]
lint :: Configuration
-> [(Text, Either Error Dockerfile)]
-> [Result Text DockerfileError]
lint Configuration
config [(Text, Either Error Dockerfile)]
parsedFiles = [(Text, Either Error Failures)] -> [Result Text DockerfileError]
forall s e.
[(Text, Either (ParseErrorBundle s e) Failures)] -> [Result s e]
gather [(Text, Either Error Failures)]
results [Result Text DockerfileError]
-> Strategy [Result Text DockerfileError]
-> [Result Text DockerfileError]
forall a. a -> Strategy a -> a
`Parallel.using` Strategy [Result Text DockerfileError]
forall a. Strategy [a]
parallelRun
  where
    gather :: [(Text, Either (ParseErrorBundle s e) Failures)] -> [Result s e]
gather = ((Text, Either (ParseErrorBundle s e) Failures) -> Result s e)
-> [(Text, Either (ParseErrorBundle s e) Failures)] -> [Result s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Either (ParseErrorBundle s e) Failures -> Result s e)
-> (Text, Either (ParseErrorBundle s e) Failures) -> Result s e
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Either (ParseErrorBundle s e) Failures -> Result s e
forall s e.
Text -> Either (ParseErrorBundle s e) Failures -> Result s e
Format.toResult)
    results :: [(Text, Either Error Failures)]
results =
      [ ( Text
name,
          (Dockerfile -> Failures)
-> Either Error Dockerfile -> Either Error Failures
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Configuration -> Dockerfile -> Failures
analyze Configuration
config) Either Error Dockerfile
parseResult
        )
        | (Text
name, Either Error Dockerfile
parseResult) <- [(Text, 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 :: Configuration -> Dockerfile -> Seq Hadolint.Rule.CheckFailure
analyze :: Configuration -> Dockerfile -> Failures
analyze Configuration
config Dockerfile
dockerfile = Failures -> Failures
fixer Failures
process
  where
    fixer :: Failures -> Failures
fixer = Configuration -> Failures -> Failures
fixSeverity Configuration
config
    process :: Failures
process = Configuration -> Dockerfile -> Failures
Hadolint.Process.run Configuration
config Dockerfile
dockerfile

fixSeverity ::
  Configuration ->
  Seq CheckFailure ->
  Seq CheckFailure
fixSeverity :: Configuration -> Failures -> Failures
fixSeverity Configuration {Bool
[RuleCode]
Set Registry
LabelSchema
DLSeverity
OutputFormat
failureThreshold :: Configuration -> DLSeverity
disableIgnorePragma :: Configuration -> Bool
strictLabels :: Configuration -> Bool
labelSchema :: Configuration -> LabelSchema
allowedRegistries :: Configuration -> Set Registry
ignoreRules :: Configuration -> [RuleCode]
styleRules :: Configuration -> [RuleCode]
infoRules :: Configuration -> [RuleCode]
warningRules :: Configuration -> [RuleCode]
errorRules :: Configuration -> [RuleCode]
format :: Configuration -> OutputFormat
verbose :: Configuration -> Bool
noColor :: Configuration -> Bool
noFail :: Configuration -> Bool
failureThreshold :: DLSeverity
disableIgnorePragma :: Bool
strictLabels :: Bool
labelSchema :: LabelSchema
allowedRegistries :: Set Registry
ignoreRules :: [RuleCode]
styleRules :: [RuleCode]
infoRules :: [RuleCode]
warningRules :: [RuleCode]
errorRules :: [RuleCode]
format :: OutputFormat
verbose :: Bool
noColor :: Bool
noFail :: Bool
..} =
  (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 -> [RuleCode] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t RuleCode -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
DLErrorC [RuleCode]
errorRules
        (CheckFailure -> CheckFailure)
-> (CheckFailure -> CheckFailure) -> CheckFailure -> CheckFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLSeverity -> [RuleCode] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t RuleCode -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
DLWarningC [RuleCode]
warningRules
        (CheckFailure -> CheckFailure)
-> (CheckFailure -> CheckFailure) -> CheckFailure -> CheckFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLSeverity -> [RuleCode] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t RuleCode -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
DLInfoC [RuleCode]
infoRules
        (CheckFailure -> CheckFailure)
-> (CheckFailure -> CheckFailure) -> CheckFailure -> CheckFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLSeverity -> [RuleCode] -> CheckFailure -> CheckFailure
forall (t :: * -> *).
Foldable t =>
DLSeverity -> t RuleCode -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
DLStyleC [RuleCode]
styleRules

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

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

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