DL3045.hs

module Hadolint.Rule.DL3045 (rule) where

import qualified Data.Char as Char
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Hadolint.Rule
import Language.Docker.Syntax

-- This data encapsulates the name of a build stage. It may be None withing an
-- `ONBUILD` context.
data Stage
  = Stage {stage :: Text}
  | None
  deriving (Eq, Ord)

-- | The state here keeps the image name/alias of the current build stage
-- and a map from image names/aliases to a Bool, saving whether or
-- not a `WORKDIR` has been set in a build stage.
data Acc
  = Acc {current :: Stage, workdirSet :: Map Stage Bool}
  | Empty

rule :: Rule args
rule = customRule check (emptyState Empty)
  where
    code = "DL3045"
    severity = DLWarningC
    message = "`COPY` to a relative destination without `WORKDIR` set."

    check _ st (From from) = st |> modify (rememberStage from)
    check _ st (Workdir _) = st |> modify rememberWorkdir
    check line st (Copy (CopyArgs _ (TargetPath dest) _ _ _))
      | Acc s m <- state st, Just True <- Map.lookup s m = st -- workdir has been set
      | "/" `Text.isPrefixOf` Text.dropAround quotePredicate dest = st -- absolute dest. normal
      | isWindowsAbsolute (Text.dropAround quotePredicate dest) = st -- absolute dest. windows
      | "$" `Text.isPrefixOf` Text.dropAround quotePredicate dest = st -- dest is a variable
      | otherwise = st |> addFail CheckFailure {..}
    check _ st _ = st
{-# INLINEABLE rule #-}

rememberStage :: BaseImage -> Acc -> Acc
rememberStage BaseImage {alias = Just als} Empty =
  Acc
    { current = Stage {stage = unImageAlias als},
      workdirSet = mempty
    }
rememberStage BaseImage {alias = Nothing, image} Empty =
  Acc
    { current = Stage {stage = imageName image},
      workdirSet = mempty
    }
rememberStage BaseImage {alias = Just als, image} Acc {..} =
  Acc
    { current = Stage {stage = unImageAlias als},
      workdirSet =
        let parentValue =
              Map.lookup (Stage {stage = imageName image}) workdirSet
                |> fromMaybe False
         in workdirSet
              |> Map.insert (Stage {stage = unImageAlias als}) parentValue
    }
rememberStage BaseImage {alias = Nothing, image} Acc {..} =
  Acc
    { current = Stage {stage = imageName image},
      workdirSet =
        let parentValue =
              Map.lookup (Stage {stage = imageName image}) workdirSet
                |> fromMaybe False
         in workdirSet
              |> Map.insert (Stage {stage = imageName image}) parentValue
    }

rememberWorkdir :: Acc -> Acc
rememberWorkdir Empty = Acc {current = None, workdirSet = Map.insert None True Map.empty}
rememberWorkdir Acc {..} = Acc {current, workdirSet = Map.insert current True workdirSet}

quotePredicate :: Char -> Bool
quotePredicate c
  | c == '"' = True
  | c == '\'' = True
  | otherwise = False

isWindowsAbsolute :: Text.Text -> Bool
isWindowsAbsolute path
  | Char.isLetter (Text.index path 0) && (':' == Text.index path 1) = True
  | otherwise = False