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 String -> IO (NonEmpty (Result Text DockerfileError))
lintIO Configuration
config NonEmpty String
dFiles = do
  [(Text, Either Error Dockerfile)]
parsedFiles <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Text, Either Error Dockerfile)
parseFile (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty String
dFiles)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: String -> IO (Text, Either Error Dockerfile)
parseFile String
"-" = do
      Either Error Dockerfile
res <- IO (Either Error Dockerfile)
Docker.parseStdin
      forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
Text.pack String
"-", Either Error Dockerfile
res)
    parseFile String
s = do
      Either Error Dockerfile
res <- String -> IO (Either Error Dockerfile)
Docker.parseFile String
s
      forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
Text.pack String
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 = forall {s} {e}.
[(Text, Either (ParseErrorBundle s e) Failures)] -> [Result s e]
gather [(Text, Either Error Failures)]
results forall a. a -> Strategy a -> a
`Parallel.using` forall {a}. Strategy [a]
parallelRun
  where
    gather :: [(Text, Either (ParseErrorBundle s e) Failures)] -> [Result s e]
gather = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s e.
Text -> Either (ParseErrorBundle s e) Failures -> Result s e
Format.toResult)
    results :: [(Text, Either Error Failures)]
results =
      [ ( Text
name,
          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 = forall a. Strategy a -> Strategy [a]
Parallel.parList 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
..} =
  forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter CheckFailure -> Bool
ignoredRules forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex (forall a b. a -> b -> a
const CheckFailure -> CheckFailure
correctSeverity)
  where
    correctSeverity :: CheckFailure -> CheckFailure
correctSeverity =
      forall {t :: * -> *}.
Foldable t =>
DLSeverity -> t RuleCode -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
DLErrorC [RuleCode]
errorRules
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}.
Foldable t =>
DLSeverity -> t RuleCode -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
DLWarningC [RuleCode]
warningRules
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}.
Foldable t =>
DLSeverity -> t RuleCode -> CheckFailure -> CheckFailure
makeSeverity DLSeverity
DLInfoC [RuleCode]
infoRules
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RuleCode]
ignored Bool -> Bool -> Bool
&& DLSeverity
severity forall a. Eq a => a -> a -> Bool
/= DLSeverity
DLIgnoreC