module Hadolint.Rule where

import Control.DeepSeq (NFData)
import qualified Control.Foldl as Foldl
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import Data.String (IsString (..))
import qualified Data.Text as Text
import qualified Data.YAML as Yaml
import GHC.Generics (Generic)
import Language.Docker.Syntax

infixl 0 |>

(|>) :: a -> (a -> b) -> b
a
x |> :: a -> (a -> b) -> b
|> a -> b
f = a -> b
f a
x

data DLSeverity
  = DLErrorC
  | DLWarningC
  | DLInfoC
  | DLStyleC
  | DLIgnoreC
  deriving (Int -> DLSeverity -> ShowS
[DLSeverity] -> ShowS
DLSeverity -> String
(Int -> DLSeverity -> ShowS)
-> (DLSeverity -> String)
-> ([DLSeverity] -> ShowS)
-> Show DLSeverity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DLSeverity] -> ShowS
$cshowList :: [DLSeverity] -> ShowS
show :: DLSeverity -> String
$cshow :: DLSeverity -> String
showsPrec :: Int -> DLSeverity -> ShowS
$cshowsPrec :: Int -> DLSeverity -> ShowS
Show, ReadPrec [DLSeverity]
ReadPrec DLSeverity
Int -> ReadS DLSeverity
ReadS [DLSeverity]
(Int -> ReadS DLSeverity)
-> ReadS [DLSeverity]
-> ReadPrec DLSeverity
-> ReadPrec [DLSeverity]
-> Read DLSeverity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DLSeverity]
$creadListPrec :: ReadPrec [DLSeverity]
readPrec :: ReadPrec DLSeverity
$creadPrec :: ReadPrec DLSeverity
readList :: ReadS [DLSeverity]
$creadList :: ReadS [DLSeverity]
readsPrec :: Int -> ReadS DLSeverity
$creadsPrec :: Int -> ReadS DLSeverity
Read, DLSeverity -> DLSeverity -> Bool
(DLSeverity -> DLSeverity -> Bool)
-> (DLSeverity -> DLSeverity -> Bool) -> Eq DLSeverity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DLSeverity -> DLSeverity -> Bool
$c/= :: DLSeverity -> DLSeverity -> Bool
== :: DLSeverity -> DLSeverity -> Bool
$c== :: DLSeverity -> DLSeverity -> Bool
Eq, Eq DLSeverity
Eq DLSeverity
-> (DLSeverity -> DLSeverity -> Ordering)
-> (DLSeverity -> DLSeverity -> Bool)
-> (DLSeverity -> DLSeverity -> Bool)
-> (DLSeverity -> DLSeverity -> Bool)
-> (DLSeverity -> DLSeverity -> Bool)
-> (DLSeverity -> DLSeverity -> DLSeverity)
-> (DLSeverity -> DLSeverity -> DLSeverity)
-> Ord DLSeverity
DLSeverity -> DLSeverity -> Bool
DLSeverity -> DLSeverity -> Ordering
DLSeverity -> DLSeverity -> DLSeverity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DLSeverity -> DLSeverity -> DLSeverity
$cmin :: DLSeverity -> DLSeverity -> DLSeverity
max :: DLSeverity -> DLSeverity -> DLSeverity
$cmax :: DLSeverity -> DLSeverity -> DLSeverity
>= :: DLSeverity -> DLSeverity -> Bool
$c>= :: DLSeverity -> DLSeverity -> Bool
> :: DLSeverity -> DLSeverity -> Bool
$c> :: DLSeverity -> DLSeverity -> Bool
<= :: DLSeverity -> DLSeverity -> Bool
$c<= :: DLSeverity -> DLSeverity -> Bool
< :: DLSeverity -> DLSeverity -> Bool
$c< :: DLSeverity -> DLSeverity -> Bool
compare :: DLSeverity -> DLSeverity -> Ordering
$ccompare :: DLSeverity -> DLSeverity -> Ordering
$cp1Ord :: Eq DLSeverity
Ord, (forall x. DLSeverity -> Rep DLSeverity x)
-> (forall x. Rep DLSeverity x -> DLSeverity) -> Generic DLSeverity
forall x. Rep DLSeverity x -> DLSeverity
forall x. DLSeverity -> Rep DLSeverity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DLSeverity x -> DLSeverity
$cfrom :: forall x. DLSeverity -> Rep DLSeverity x
Generic, DLSeverity -> ()
(DLSeverity -> ()) -> NFData DLSeverity
forall a. (a -> ()) -> NFData a
rnf :: DLSeverity -> ()
$crnf :: DLSeverity -> ()
NFData)

instance Yaml.FromYAML DLSeverity where
  parseYAML :: Node Pos -> Parser DLSeverity
parseYAML = (DLSeverity -> Parser DLSeverity) -> Node Pos -> Parser DLSeverity
forall a. (DLSeverity -> Parser a) -> Node Pos -> Parser a
withSeverity DLSeverity -> Parser DLSeverity
forall (f :: * -> *) a. Applicative f => a -> f a
pure

withSeverity :: (DLSeverity -> Yaml.Parser a) -> Yaml.Node Yaml.Pos -> Yaml.Parser a
withSeverity :: (DLSeverity -> Parser a) -> Node Pos -> Parser a
withSeverity DLSeverity -> Parser a
f v :: Node Pos
v@(Yaml.Scalar Pos
_ (Yaml.SStr Text
b)) =
  case Text -> Either Text DLSeverity
Hadolint.Rule.readSeverity Text
b of
    Right DLSeverity
s -> DLSeverity -> Parser a
f DLSeverity
s
    Left Text
_ -> String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
Yaml.typeMismatch String
"severity" Node Pos
v
withSeverity DLSeverity -> Parser a
_ Node Pos
v = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
Yaml.typeMismatch String
"severity" Node Pos
v

readSeverity :: Text.Text -> Either Text.Text DLSeverity
readSeverity :: Text -> Either Text DLSeverity
readSeverity Text
"error" = DLSeverity -> Either Text DLSeverity
forall a b. b -> Either a b
Right DLSeverity
DLErrorC
readSeverity Text
"warning" = DLSeverity -> Either Text DLSeverity
forall a b. b -> Either a b
Right DLSeverity
DLWarningC
readSeverity Text
"info" = DLSeverity -> Either Text DLSeverity
forall a b. b -> Either a b
Right DLSeverity
DLInfoC
readSeverity Text
"style" = DLSeverity -> Either Text DLSeverity
forall a b. b -> Either a b
Right DLSeverity
DLStyleC
readSeverity Text
"ignore" = DLSeverity -> Either Text DLSeverity
forall a b. b -> Either a b
Right DLSeverity
DLIgnoreC
readSeverity Text
"none" = DLSeverity -> Either Text DLSeverity
forall a b. b -> Either a b
Right DLSeverity
DLIgnoreC
readSeverity Text
t = Text -> Either Text DLSeverity
forall a b. a -> Either a b
Left (Text
"Invalid severity: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)

instance Semigroup DLSeverity where DLSeverity
s1 <> :: DLSeverity -> DLSeverity -> DLSeverity
<> DLSeverity
s2 = DLSeverity -> DLSeverity -> DLSeverity
forall a. Ord a => a -> a -> a
min DLSeverity
s1 DLSeverity
s2

instance Monoid DLSeverity where mempty :: DLSeverity
mempty = DLSeverity
DLIgnoreC

newtype RuleCode = RuleCode {RuleCode -> Text
unRuleCode :: Text.Text}
  deriving (Int -> RuleCode -> ShowS
[RuleCode] -> ShowS
RuleCode -> String
(Int -> RuleCode -> ShowS)
-> (RuleCode -> String) -> ([RuleCode] -> ShowS) -> Show RuleCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleCode] -> ShowS
$cshowList :: [RuleCode] -> ShowS
show :: RuleCode -> String
$cshow :: RuleCode -> String
showsPrec :: Int -> RuleCode -> ShowS
$cshowsPrec :: Int -> RuleCode -> ShowS
Show, RuleCode -> RuleCode -> Bool
(RuleCode -> RuleCode -> Bool)
-> (RuleCode -> RuleCode -> Bool) -> Eq RuleCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleCode -> RuleCode -> Bool
$c/= :: RuleCode -> RuleCode -> Bool
== :: RuleCode -> RuleCode -> Bool
$c== :: RuleCode -> RuleCode -> Bool
Eq, Eq RuleCode
Eq RuleCode
-> (RuleCode -> RuleCode -> Ordering)
-> (RuleCode -> RuleCode -> Bool)
-> (RuleCode -> RuleCode -> Bool)
-> (RuleCode -> RuleCode -> Bool)
-> (RuleCode -> RuleCode -> Bool)
-> (RuleCode -> RuleCode -> RuleCode)
-> (RuleCode -> RuleCode -> RuleCode)
-> Ord RuleCode
RuleCode -> RuleCode -> Bool
RuleCode -> RuleCode -> Ordering
RuleCode -> RuleCode -> RuleCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RuleCode -> RuleCode -> RuleCode
$cmin :: RuleCode -> RuleCode -> RuleCode
max :: RuleCode -> RuleCode -> RuleCode
$cmax :: RuleCode -> RuleCode -> RuleCode
>= :: RuleCode -> RuleCode -> Bool
$c>= :: RuleCode -> RuleCode -> Bool
> :: RuleCode -> RuleCode -> Bool
$c> :: RuleCode -> RuleCode -> Bool
<= :: RuleCode -> RuleCode -> Bool
$c<= :: RuleCode -> RuleCode -> Bool
< :: RuleCode -> RuleCode -> Bool
$c< :: RuleCode -> RuleCode -> Bool
compare :: RuleCode -> RuleCode -> Ordering
$ccompare :: RuleCode -> RuleCode -> Ordering
$cp1Ord :: Eq RuleCode
Ord)

instance IsString RuleCode where
  fromString :: String -> RuleCode
fromString = Text -> RuleCode
RuleCode (Text -> RuleCode) -> (String -> Text) -> String -> RuleCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

data CheckFailure = CheckFailure
  { CheckFailure -> RuleCode
code :: RuleCode,
    CheckFailure -> DLSeverity
severity :: DLSeverity,
    CheckFailure -> Text
message :: Text.Text,
    CheckFailure -> Int
line :: Linenumber
  }
  deriving (Int -> CheckFailure -> ShowS
[CheckFailure] -> ShowS
CheckFailure -> String
(Int -> CheckFailure -> ShowS)
-> (CheckFailure -> String)
-> ([CheckFailure] -> ShowS)
-> Show CheckFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckFailure] -> ShowS
$cshowList :: [CheckFailure] -> ShowS
show :: CheckFailure -> String
$cshow :: CheckFailure -> String
showsPrec :: Int -> CheckFailure -> ShowS
$cshowsPrec :: Int -> CheckFailure -> ShowS
Show, CheckFailure -> CheckFailure -> Bool
(CheckFailure -> CheckFailure -> Bool)
-> (CheckFailure -> CheckFailure -> Bool) -> Eq CheckFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckFailure -> CheckFailure -> Bool
$c/= :: CheckFailure -> CheckFailure -> Bool
== :: CheckFailure -> CheckFailure -> Bool
$c== :: CheckFailure -> CheckFailure -> Bool
Eq)

instance Ord CheckFailure where
  CheckFailure
a compare :: CheckFailure -> CheckFailure -> Ordering
`compare` CheckFailure
b = CheckFailure -> Int
line CheckFailure
a Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CheckFailure -> Int
line CheckFailure
b

type Failures = Seq.Seq CheckFailure

data State a = State
  { State a -> Failures
failures :: Failures,
    State a -> a
state :: a
  }
  deriving (Int -> State a -> ShowS
[State a] -> ShowS
State a -> String
(Int -> State a -> ShowS)
-> (State a -> String) -> ([State a] -> ShowS) -> Show (State a)
forall a. Show a => Int -> State a -> ShowS
forall a. Show a => [State a] -> ShowS
forall a. Show a => State a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State a] -> ShowS
$cshowList :: forall a. Show a => [State a] -> ShowS
show :: State a -> String
$cshow :: forall a. Show a => State a -> String
showsPrec :: Int -> State a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> State a -> ShowS
Show)

type LabelName = Text.Text

data LabelType
  = RawText
  | Url
  | Spdx
  | GitHash
  | Rfc3339
  | SemVer
  | Email
  deriving (LabelType -> LabelType -> Bool
(LabelType -> LabelType -> Bool)
-> (LabelType -> LabelType -> Bool) -> Eq LabelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelType -> LabelType -> Bool
$c/= :: LabelType -> LabelType -> Bool
== :: LabelType -> LabelType -> Bool
$c== :: LabelType -> LabelType -> Bool
Eq, ReadPrec [LabelType]
ReadPrec LabelType
Int -> ReadS LabelType
ReadS [LabelType]
(Int -> ReadS LabelType)
-> ReadS [LabelType]
-> ReadPrec LabelType
-> ReadPrec [LabelType]
-> Read LabelType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LabelType]
$creadListPrec :: ReadPrec [LabelType]
readPrec :: ReadPrec LabelType
$creadPrec :: ReadPrec LabelType
readList :: ReadS [LabelType]
$creadList :: ReadS [LabelType]
readsPrec :: Int -> ReadS LabelType
$creadsPrec :: Int -> ReadS LabelType
Read, Int -> LabelType -> ShowS
[LabelType] -> ShowS
LabelType -> String
(Int -> LabelType -> ShowS)
-> (LabelType -> String)
-> ([LabelType] -> ShowS)
-> Show LabelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelType] -> ShowS
$cshowList :: [LabelType] -> ShowS
show :: LabelType -> String
$cshow :: LabelType -> String
showsPrec :: Int -> LabelType -> ShowS
$cshowsPrec :: Int -> LabelType -> ShowS
Show)

read :: Text.Text -> Either Text.Text LabelType
read :: Text -> Either Text LabelType
read Text
"url"     = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
Url
read Text
"spdx"    = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
Spdx
read Text
"hash"    = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
GitHash
read Text
"rfc3339" = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
Rfc3339
read Text
"semver"  = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
SemVer
read Text
"email"   = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
Email
read Text
"text"    = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
RawText
read Text
""        = LabelType -> Either Text LabelType
forall a b. b -> Either a b
Right LabelType
RawText
read Text
t         = Text -> Either Text LabelType
forall a b. a -> Either a b
Left (Text
"Invalid label type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)

instance Yaml.FromYAML LabelType where
  parseYAML :: Node Pos -> Parser LabelType
parseYAML = (LabelType -> Parser LabelType) -> Node Pos -> Parser LabelType
forall a. (LabelType -> Parser a) -> Node Pos -> Parser a
withLabelType LabelType -> Parser LabelType
forall (f :: * -> *) a. Applicative f => a -> f a
pure

withLabelType :: (LabelType -> Yaml.Parser a) -> Yaml.Node Yaml.Pos -> Yaml.Parser a
withLabelType :: (LabelType -> Parser a) -> Node Pos -> Parser a
withLabelType LabelType -> Parser a
f v :: Node Pos
v@(Yaml.Scalar Pos
_ (Yaml.SStr Text
b)) =
    case Text -> Either Text LabelType
Hadolint.Rule.read Text
b of
      Right LabelType
lt -> LabelType -> Parser a
f LabelType
lt
      Left Text
_ -> String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
Yaml.typeMismatch String
"labeltype" Node Pos
v
withLabelType LabelType -> Parser a
_ Node Pos
v = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
Yaml.typeMismatch String
"labeltype" Node Pos
v

type LabelSchema = Map.Map LabelName LabelType


withLineNumber ::
  (Linenumber -> t1 -> Instruction args -> t2) ->
  t1 ->
  InstructionPos args ->
  t2
withLineNumber :: (Int -> t1 -> Instruction args -> t2)
-> t1 -> InstructionPos args -> t2
withLineNumber Int -> t1 -> Instruction args -> t2
f t1
state InstructionPos {Instruction args
$sel:instruction:InstructionPos :: forall args. InstructionPos args -> Instruction args
instruction :: Instruction args
instruction, Int
$sel:lineNumber:InstructionPos :: forall args. InstructionPos args -> Int
lineNumber :: Int
lineNumber} =
  Int -> t1 -> Instruction args -> t2
f Int
lineNumber t1
state Instruction args
instruction

addFail :: CheckFailure -> State a -> State a
addFail :: CheckFailure -> State a -> State a
addFail CheckFailure
failure state :: State a
state@(State Failures
fails a
_) =
  State a
state
    { failures :: Failures
failures =
        Failures
fails
          Failures -> CheckFailure -> Failures
forall a. Seq a -> a -> Seq a
Seq.|> CheckFailure
failure
    }

emptyState :: a -> State a
emptyState :: a -> State a
emptyState = Failures -> a -> State a
forall a. Failures -> a -> State a
State Failures
forall a. Seq a
Seq.empty

simpleState :: State ()
simpleState :: State ()
simpleState = Failures -> () -> State ()
forall a. Failures -> a -> State a
State Failures
forall a. Seq a
Seq.empty ()

modify :: (a -> a) -> State a -> State a
modify :: (a -> a) -> State a -> State a
modify a -> a
f s :: State a
s@(State Failures
_ a
st) = State a
s {state :: a
state = a -> a
f a
st}

replaceWith :: a -> State a -> State a
replaceWith :: a -> State a -> State a
replaceWith a
newState State a
s = State a
s {state :: a
state = a
newState}

type Rule args = Foldl.Fold (InstructionPos args) Failures

-- | A simple rule that can be implemented in terms of returning True or False for each instruction
-- If you need to calculate some state to decide upon past information, use 'customRule'
simpleRule ::
  -- | rule code
  RuleCode ->
  -- | severity for the rule
  DLSeverity ->
  -- | failure message for the rule
  Text.Text ->
  -- | step calculation for the rule. Returns True or False for each line in the dockerfile depending on its validity.
  (Instruction args -> Bool) ->
  Rule args
simpleRule :: RuleCode
-> DLSeverity -> Text -> (Instruction args -> Bool) -> Rule args
simpleRule RuleCode
code DLSeverity
severity Text
message Instruction args -> Bool
checker = (Int -> State () -> Instruction args -> State ())
-> State () -> Rule args
forall a args.
(Int -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Int -> State () -> Instruction args -> State ()
forall a. Int -> State a -> Instruction args -> State a
step State ()
simpleState
  where
    step :: Int -> State a -> Instruction args -> State a
step Int
line State a
s Instruction args
instr
      | Instruction args -> Bool
checker Instruction args
instr = State a
s
      | Bool
otherwise = State a
s State a -> (State a -> State a) -> State a
forall a b. a -> (a -> b) -> b
|> CheckFailure -> State a -> State a
forall a. CheckFailure -> State a -> State a
addFail (RuleCode -> DLSeverity -> Text -> Int -> CheckFailure
CheckFailure RuleCode
code DLSeverity
severity Text
message Int
line)

-- | A rule that accumulates a State a. The state contains the collection of failed lines and a custom data
-- type that can be used to track properties for the rule. Each step always returns the new State, which offers
-- the ability to both accumulate properties and mark failures for every given instruction.
customRule ::
  (Linenumber -> State a -> Instruction args -> State a) ->
  State a ->
  Rule args
customRule :: (Int -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Int -> State a -> Instruction args -> State a
step State a
initial = (Int -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
forall a args.
(Int -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule Int -> State a -> Instruction args -> State a
step State a
initial State a -> Failures
forall a. State a -> Failures
failures

-- | Similarly to 'customRule', it returns a State a for each step, but it has the ability to run a
-- done callback as the last step of the rule. The done callback can be used to transform the state
-- and mark failures for any arbitrary line in the input. This helper is meant for rules that need
-- to do lookahead. Instead of looking ahead, the state should store the facts and make a decision about
-- them once the input is finished.
veryCustomRule ::
  -- | step calculation for the rule. Called for each instruction in the docker file
  -- it must return the state after being modified by the rule
  (Linenumber -> State a -> Instruction args -> State a) ->
  -- | initial state
  State a ->
  -- | done callaback. It is passed the final accumulated state and it should return all failures
  -- found by the rule
  (State a -> Failures) ->
  Rule args
veryCustomRule :: (Int -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule Int -> State a -> Instruction args -> State a
step = (State a -> InstructionPos args -> State a)
-> State a -> (State a -> Failures) -> Rule args
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Foldl.Fold ((Int -> State a -> Instruction args -> State a)
-> State a -> InstructionPos args -> State a
forall t1 args t2.
(Int -> t1 -> Instruction args -> t2)
-> t1 -> InstructionPos args -> t2
withLineNumber Int -> State a -> Instruction args -> State a
step)

foldArguments :: (a -> b) -> Arguments a -> b
foldArguments :: (a -> b) -> Arguments a -> b
foldArguments a -> b
applyRule Arguments a
args =
  case Arguments a
args of
    ArgumentsText a
as -> a -> b
applyRule a
as
    ArgumentsList a
as -> a -> b
applyRule a
as

-- | Returns the result of running the check function on the image alias
--   name, if the passed instruction is a FROM instruction with a stage alias.
--   Otherwise, returns True.
aliasMustBe :: (Text.Text -> Bool) -> Instruction a -> Bool
aliasMustBe :: (Text -> Bool) -> Instruction a -> Bool
aliasMustBe Text -> Bool
predicate Instruction a
fromInstr =
  case Instruction a
fromInstr of
    From BaseImage {$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Just (ImageAlias Text
as)} -> Text -> Bool
predicate Text
as
    Instruction a
_ -> Bool
True

archiveFileFormatExtensions :: [Text.Text]
archiveFileFormatExtensions :: [Text]
archiveFileFormatExtensions =
  [ Text
".tar",
    Text
".Z",
    Text
".bz2",
    Text
".gz",
    Text
".lz",
    Text
".lzma",
    Text
".tZ",
    Text
".tb2",
    Text
".tbz",
    Text
".tbz2",
    Text
".tgz",
    Text
".tlz",
    Text
".tpz",
    Text
".txz",
    Text
".xz"
  ]