module Hadolint.Rule.DL3048 (rule) where

import qualified Data.Text as Text
import Hadolint.Rule
import Language.Docker.Syntax


rule :: Rule args
rule :: forall args. Rule args
rule = forall args.
RuleCode
-> DLSeverity -> Text -> (Instruction args -> Bool) -> Rule args
simpleRule RuleCode
code DLSeverity
severity Text
message forall {args}. Instruction args -> Bool
check
  where
    code :: RuleCode
code = RuleCode
"DL3048"
    severity :: DLSeverity
severity = DLSeverity
DLStyleC
    message :: Text
message = Text
"Invalid label key."
    check :: Instruction args -> Bool
check (Label Pairs
pairs) = forall {b}. [(Text, b)] -> Bool
hasNoInvalidKey Pairs
pairs
    check Instruction args
_ = Bool
True

    hasNoInvalidKey :: [(Text, b)] -> Bool
hasNoInvalidKey [(Text, b)]
prs = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [(Text
l, b
v) | (Text
l, b
v) <- [(Text, b)]
prs,
                                          Int -> Text -> Text
Text.take Int
1 Text
l forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`
                                              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton [Char
'a'..Char
'z'] Bool -> Bool -> Bool
||
                                          Int -> Text -> Text
Text.takeEnd Int
1 Text
l forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`
                                              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton ([Char
'a'..Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9']) Bool -> Bool -> Bool
||
                                          Text -> Bool
containsIllegalChar Text
l Bool -> Bool -> Bool
||
                                          Text -> Bool
hasReservedNamespace Text
l Bool -> Bool -> Bool
||
                                          Text -> Bool
hasConsecutiveSeparators Text
l]
{-# INLINEABLE rule #-}

containsIllegalChar :: Text.Text -> Bool
containsIllegalChar :: Text -> Bool
containsIllegalChar = (Char -> Bool) -> Text -> Bool
Text.any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
validChars)

hasReservedNamespace :: Text.Text -> Bool
hasReservedNamespace :: Text -> Bool
hasReservedNamespace Text
l = Text
"com.docker." Text -> Text -> Bool
`Text.isPrefixOf` Text
l
  Bool -> Bool -> Bool
|| Text
"io.docker." Text -> Text -> Bool
`Text.isPrefixOf` Text
l
  Bool -> Bool -> Bool
|| Text
"org.dockerproject." Text -> Text -> Bool
`Text.isPrefixOf` Text
l

hasConsecutiveSeparators :: Text.Text -> Bool
hasConsecutiveSeparators :: Text -> Bool
hasConsecutiveSeparators Text
l = Text
".." Text -> Text -> Bool
`Text.isInfixOf` Text
l Bool -> Bool -> Bool
|| Text
"--" Text -> Text -> Bool
`Text.isInfixOf` Text
l

validChars :: String
validChars :: [Char]
validChars = [Char
'0'..Char
'9'] forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'.', Char
'-']