{-# LANGUAGE DuplicateRecordFields #-}

module Language.Docker.Parser.Run
  ( parseRun,
    runFlags,
  )
where

import Data.Functor (($>))
import qualified Data.Set as Set
import Language.Docker.Parser.Arguments (arguments)
import Language.Docker.Parser.Prelude
import Language.Docker.Syntax

data RunFlag
  = RunFlagMount RunMount
  | RunFlagSecurity RunSecurity
  | RunFlagNetwork RunNetwork
  deriving (Int -> RunFlag -> ShowS
[RunFlag] -> ShowS
RunFlag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RunFlag] -> ShowS
$cshowList :: [RunFlag] -> ShowS
show :: RunFlag -> [Char]
$cshow :: RunFlag -> [Char]
showsPrec :: Int -> RunFlag -> ShowS
$cshowsPrec :: Int -> RunFlag -> ShowS
Show)

data RunMountArg
  = MountArgFromImage Text
  | MountArgId Text
  | MountArgMode Text
  | MountArgReadOnly Bool
  | MountArgRequired Bool
  | MountArgSharing CacheSharing
  | MountArgSource SourcePath
  | MountArgTarget TargetPath
  | MountArgType Text
  | MountArgUid Text
  | MountArgGid Text
  deriving (Int -> RunMountArg -> ShowS
[RunMountArg] -> ShowS
RunMountArg -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RunMountArg] -> ShowS
$cshowList :: [RunMountArg] -> ShowS
show :: RunMountArg -> [Char]
$cshow :: RunMountArg -> [Char]
showsPrec :: Int -> RunMountArg -> ShowS
$cshowsPrec :: Int -> RunMountArg -> ShowS
Show)

data MountType
  = Bind
  | Cache
  | Tmpfs
  | Secret
  | Ssh

parseRun :: (?esc :: Char) => Parser (Instruction Text)
parseRun :: (?esc::Char) => Parser (Instruction Text)
parseRun = do
  (?esc::Char) => Text -> Parser ()
reserved Text
"RUN"
  forall args. RunArgs args -> Instruction args
Run forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => Parser (RunArgs Text)
runArguments

runArguments :: (?esc :: Char) => Parser (RunArgs Text)
runArguments :: (?esc::Char) => Parser (RunArgs Text)
runArguments = do
  RunFlags
presentFlags <- forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [(?esc::Char) => ParsecT DockerfileError Text Identity RunFlags
runFlags forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (?esc::Char) => Parser ()
requiredWhitespace, forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set RunMount -> Maybe RunSecurity -> Maybe RunNetwork -> RunFlags
RunFlags forall a. Monoid a => a
mempty forall a. Maybe a
Nothing forall a. Maybe a
Nothing)]
  Arguments Text
args <- (?esc::Char) => Parser (Arguments Text)
arguments
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall args. Arguments args -> RunFlags -> RunArgs args
RunArgs Arguments Text
args RunFlags
presentFlags

runFlags :: (?esc :: Char) => Parser RunFlags
runFlags :: (?esc::Char) => ParsecT DockerfileError Text Identity RunFlags
runFlags = do
  [RunFlag]
flags <- (?esc::Char) => Parser RunFlag
runFlag forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` ParsecT DockerfileError Text Identity Text
flagSeparator
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RunFlag -> RunFlags -> RunFlags
toRunFlags RunFlags
emptyFlags [RunFlag]
flags
  where
    flagSeparator :: ParsecT DockerfileError Text Identity (Tokens Text)
flagSeparator = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((?esc::Char) => Parser ()
requiredWhitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected flag"
    emptyFlags :: RunFlags
emptyFlags = Set RunMount -> Maybe RunSecurity -> Maybe RunNetwork -> RunFlags
RunFlags forall a. Monoid a => a
mempty forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    toRunFlags :: RunFlag -> RunFlags -> RunFlags
toRunFlags (RunFlagMount RunMount
m) rf :: RunFlags
rf@RunFlags { $sel:mount:RunFlags :: RunFlags -> Set RunMount
mount = Set RunMount
mnt } = RunFlags
rf {$sel:mount:RunFlags :: Set RunMount
mount = forall a. Ord a => a -> Set a -> Set a
Set.insert RunMount
m Set RunMount
mnt}
    toRunFlags (RunFlagNetwork RunNetwork
n) RunFlags
rf = RunFlags
rf {$sel:network:RunFlags :: Maybe RunNetwork
network = forall a. a -> Maybe a
Just RunNetwork
n}
    toRunFlags (RunFlagSecurity RunSecurity
s) RunFlags
rf = RunFlags
rf {$sel:security:RunFlags :: Maybe RunSecurity
security = forall a. a -> Maybe a
Just RunSecurity
s}

runFlag :: (?esc :: Char) => Parser RunFlag
runFlag :: (?esc::Char) => Parser RunFlag
runFlag =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ RunMount -> RunFlag
RunFlagMount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => Parser RunMount
runFlagMount,
      RunSecurity -> RunFlag
RunFlagSecurity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunSecurity
runFlagSecurity,
      RunNetwork -> RunFlag
RunFlagNetwork forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunNetwork
runFlagNetwork
    ]

runFlagSecurity :: Parser RunSecurity
runFlagSecurity :: Parser RunSecurity
runFlagSecurity = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--security="
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [RunSecurity
Insecure forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"insecure", RunSecurity
Sandbox forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"sandbox"]

runFlagNetwork :: Parser RunNetwork
runFlagNetwork :: Parser RunNetwork
runFlagNetwork = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--network="
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [RunNetwork
NetworkNone forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"none", RunNetwork
NetworkHost forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"host", RunNetwork
NetworkDefault forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"default"]

runFlagMount :: (?esc :: Char) => Parser RunMount
runFlagMount :: (?esc::Char) => Parser RunMount
runFlagMount = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--mount="
  Maybe MountType
maybeType <-
    forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"type="
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ forall a. a -> Maybe a
Just MountType
Bind forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"bind",
              forall a. a -> Maybe a
Just MountType
Cache forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"cache",
              forall a. a -> Maybe a
Just MountType
Tmpfs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"tmpfs",
              forall a. a -> Maybe a
Just MountType
Secret forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"secret",
              forall a. a -> Maybe a
Just MountType
Ssh forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"ssh"
            ],
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      ]
  (MountType
mountType, Parser [RunMountArg]
args) <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case Maybe MountType
maybeType of
      Maybe MountType
Nothing -> (MountType
Bind, (?esc::Char) => MountType -> Parser [RunMountArg]
argsParser MountType
Bind)
      Just MountType
Ssh -> (MountType
Ssh, forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"," forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (?esc::Char) => MountType -> Parser [RunMountArg]
argsParser MountType
Ssh, forall (f :: * -> *) a. Applicative f => a -> f a
pure []])
      Just MountType
t -> (MountType
t, forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"," forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (?esc::Char) => MountType -> Parser [RunMountArg]
argsParser MountType
t)
  case MountType
mountType of
    MountType
Bind -> BindOpts -> RunMount
BindMount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([RunMountArg] -> ParsecT DockerfileError Text Identity BindOpts
bindMount forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser [RunMountArg]
args)
    MountType
Cache -> CacheOpts -> RunMount
CacheMount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([RunMountArg] -> ParsecT DockerfileError Text Identity CacheOpts
cacheMount forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser [RunMountArg]
args)
    MountType
Tmpfs -> TmpOpts -> RunMount
TmpfsMount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([RunMountArg] -> ParsecT DockerfileError Text Identity TmpOpts
tmpfsMount forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser [RunMountArg]
args)
    MountType
Secret -> SecretOpts -> RunMount
SecretMount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([RunMountArg] -> ParsecT DockerfileError Text Identity SecretOpts
secretMount forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser [RunMountArg]
args)
    MountType
Ssh -> SecretOpts -> RunMount
SshMount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([RunMountArg] -> ParsecT DockerfileError Text Identity SecretOpts
secretMount forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser [RunMountArg]
args)

argsParser :: (?esc :: Char) => MountType -> Parser [RunMountArg]
argsParser :: (?esc::Char) => MountType -> Parser [RunMountArg]
argsParser MountType
mountType = (?esc::Char) => MountType -> Parser RunMountArg
mountChoices MountType
mountType forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
","

bindMount :: [RunMountArg] -> Parser BindOpts
bindMount :: [RunMountArg] -> ParsecT DockerfileError Text Identity BindOpts
bindMount [RunMountArg]
args =
  case forall (t :: * -> *).
Foldable t =>
Text
-> Set Text
-> Set Text
-> t RunMountArg
-> Either DockerfileError [RunMountArg]
validArgs Text
"bind" Set Text
allowed Set Text
required [RunMountArg]
args of
    Left DockerfileError
e -> forall a. DockerfileError -> Parser a
customError DockerfileError
e
    Right [RunMountArg]
as -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RunMountArg -> BindOpts -> BindOpts
bindOpts forall a. Default a => a
def [RunMountArg]
as
  where
    allowed :: Set Text
allowed = forall a. Ord a => [a] -> Set a
Set.fromList [Text
"target", Text
"source", Text
"from", Text
"ro"]
    required :: Set Text
required = forall a. a -> Set a
Set.singleton Text
"target"
    bindOpts :: RunMountArg -> BindOpts -> BindOpts
    bindOpts :: RunMountArg -> BindOpts -> BindOpts
bindOpts (MountArgTarget TargetPath
path) BindOpts
bo = BindOpts
bo {$sel:bTarget:BindOpts :: TargetPath
bTarget = TargetPath
path}
    bindOpts (MountArgSource SourcePath
path) BindOpts
bo = BindOpts
bo {$sel:bSource:BindOpts :: Maybe SourcePath
bSource = forall a. a -> Maybe a
Just SourcePath
path}
    bindOpts (MountArgFromImage Text
img) BindOpts
bo = BindOpts
bo {$sel:bFromImage:BindOpts :: Maybe Text
bFromImage = forall a. a -> Maybe a
Just Text
img}
    bindOpts (MountArgReadOnly Bool
ro) BindOpts
bo = BindOpts
bo {$sel:bReadOnly:BindOpts :: Maybe Bool
bReadOnly = forall a. a -> Maybe a
Just Bool
ro}
    bindOpts RunMountArg
invalid BindOpts
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RunMountArg
invalid forall a. Semigroup a => a -> a -> a
<> [Char]
" please report this bug"

cacheMount :: [RunMountArg] -> Parser CacheOpts
cacheMount :: [RunMountArg] -> ParsecT DockerfileError Text Identity CacheOpts
cacheMount [RunMountArg]
args =
  case forall (t :: * -> *).
Foldable t =>
Text
-> Set Text
-> Set Text
-> t RunMountArg
-> Either DockerfileError [RunMountArg]
validArgs Text
"cache" Set Text
allowed Set Text
required [RunMountArg]
args of
    Left DockerfileError
e -> forall a. DockerfileError -> Parser a
customError DockerfileError
e
    Right [RunMountArg]
as -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RunMountArg -> CacheOpts -> CacheOpts
cacheOpts forall a. Default a => a
def [RunMountArg]
as
  where
    allowed :: Set Text
allowed = forall a. Ord a => [a] -> Set a
Set.fromList [Text
"target", Text
"sharing", Text
"id", Text
"ro", Text
"from", Text
"source", Text
"mode", Text
"uid", Text
"gid"]
    required :: Set Text
required = forall a. a -> Set a
Set.singleton Text
"target"
    cacheOpts :: RunMountArg -> CacheOpts -> CacheOpts
    cacheOpts :: RunMountArg -> CacheOpts -> CacheOpts
cacheOpts (MountArgTarget TargetPath
path) CacheOpts
co = CacheOpts
co {$sel:cTarget:CacheOpts :: TargetPath
cTarget = TargetPath
path}
    cacheOpts (MountArgSharing CacheSharing
sh) CacheOpts
co = CacheOpts
co {$sel:cSharing:CacheOpts :: Maybe CacheSharing
cSharing = forall a. a -> Maybe a
Just CacheSharing
sh}
    cacheOpts (MountArgId Text
i) CacheOpts
co = CacheOpts
co {$sel:cCacheId:CacheOpts :: Maybe Text
cCacheId = forall a. a -> Maybe a
Just Text
i}
    cacheOpts (MountArgReadOnly Bool
ro) CacheOpts
co = CacheOpts
co {$sel:cReadOnly:CacheOpts :: Maybe Bool
cReadOnly = forall a. a -> Maybe a
Just Bool
ro}
    cacheOpts (MountArgFromImage Text
img) CacheOpts
co = CacheOpts
co {$sel:cFromImage:CacheOpts :: Maybe Text
cFromImage = forall a. a -> Maybe a
Just Text
img}
    cacheOpts (MountArgSource SourcePath
path) CacheOpts
co = CacheOpts
co {$sel:cSource:CacheOpts :: Maybe SourcePath
cSource = forall a. a -> Maybe a
Just SourcePath
path}
    cacheOpts (MountArgMode Text
m) CacheOpts
co = CacheOpts
co {$sel:cMode:CacheOpts :: Maybe Text
cMode = forall a. a -> Maybe a
Just Text
m}
    cacheOpts (MountArgUid Text
u) CacheOpts
co = CacheOpts
co {$sel:cUid:CacheOpts :: Maybe Text
cUid = forall a. a -> Maybe a
Just Text
u}
    cacheOpts (MountArgGid Text
g) CacheOpts
co = CacheOpts
co {$sel:cGid:CacheOpts :: Maybe Text
cGid = forall a. a -> Maybe a
Just Text
g}
    cacheOpts RunMountArg
invalid CacheOpts
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RunMountArg
invalid forall a. Semigroup a => a -> a -> a
<> [Char]
" please report this bug"

tmpfsMount :: [RunMountArg] -> Parser TmpOpts
tmpfsMount :: [RunMountArg] -> ParsecT DockerfileError Text Identity TmpOpts
tmpfsMount [RunMountArg]
args =
  case forall (t :: * -> *).
Foldable t =>
Text
-> Set Text
-> Set Text
-> t RunMountArg
-> Either DockerfileError [RunMountArg]
validArgs Text
"tmpfs" Set Text
required Set Text
required [RunMountArg]
args of
    Left DockerfileError
e -> forall a. DockerfileError -> Parser a
customError DockerfileError
e
    Right [RunMountArg]
as -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RunMountArg -> TmpOpts -> TmpOpts
tmpOpts forall a. Default a => a
def [RunMountArg]
as
  where
    required :: Set Text
required = forall a. a -> Set a
Set.singleton Text
"target"
    tmpOpts :: RunMountArg -> TmpOpts -> TmpOpts
    tmpOpts :: RunMountArg -> TmpOpts -> TmpOpts
tmpOpts (MountArgTarget TargetPath
path) TmpOpts
t = TmpOpts
t {$sel:tTarget:TmpOpts :: TargetPath
tTarget = TargetPath
path}
    tmpOpts RunMountArg
invalid TmpOpts
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RunMountArg
invalid forall a. Semigroup a => a -> a -> a
<> [Char]
" please report this bug"

secretMount :: [RunMountArg] -> Parser SecretOpts
secretMount :: [RunMountArg] -> ParsecT DockerfileError Text Identity SecretOpts
secretMount [RunMountArg]
args =
  case forall (t :: * -> *).
Foldable t =>
Text
-> Set Text
-> Set Text
-> t RunMountArg
-> Either DockerfileError [RunMountArg]
validArgs Text
"secret" Set Text
allowed forall {a}. Set a
required [RunMountArg]
args of
    Left DockerfileError
e -> forall a. DockerfileError -> Parser a
customError DockerfileError
e
    Right [RunMountArg]
as -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RunMountArg -> SecretOpts -> SecretOpts
secretOpts forall a. Default a => a
def [RunMountArg]
as
  where
    allowed :: Set Text
allowed = forall a. Ord a => [a] -> Set a
Set.fromList [Text
"target", Text
"id", Text
"required", Text
"source", Text
"mode", Text
"uid", Text
"gid"]
    required :: Set a
required = forall {a}. Set a
Set.empty
    secretOpts :: RunMountArg -> SecretOpts -> SecretOpts
    secretOpts :: RunMountArg -> SecretOpts -> SecretOpts
secretOpts (MountArgTarget TargetPath
path) SecretOpts
co = SecretOpts
co {$sel:sTarget:SecretOpts :: Maybe TargetPath
sTarget = forall a. a -> Maybe a
Just TargetPath
path}
    secretOpts (MountArgId Text
i) SecretOpts
co = SecretOpts
co {$sel:sCacheId:SecretOpts :: Maybe Text
sCacheId = forall a. a -> Maybe a
Just Text
i}
    secretOpts (MountArgRequired Bool
r) SecretOpts
co = SecretOpts
co {$sel:sIsRequired:SecretOpts :: Maybe Bool
sIsRequired = forall a. a -> Maybe a
Just Bool
r}
    secretOpts (MountArgSource SourcePath
path) SecretOpts
co = SecretOpts
co {$sel:sSource:SecretOpts :: Maybe SourcePath
sSource = forall a. a -> Maybe a
Just SourcePath
path}
    secretOpts (MountArgMode Text
m) SecretOpts
co = SecretOpts
co {$sel:sMode:SecretOpts :: Maybe Text
sMode = forall a. a -> Maybe a
Just Text
m}
    secretOpts (MountArgUid Text
u) SecretOpts
co = SecretOpts
co {$sel:sUid:SecretOpts :: Maybe Text
sUid = forall a. a -> Maybe a
Just Text
u}
    secretOpts (MountArgGid Text
g) SecretOpts
co = SecretOpts
co {$sel:sGid:SecretOpts :: Maybe Text
sGid = forall a. a -> Maybe a
Just Text
g}
    secretOpts RunMountArg
invalid SecretOpts
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RunMountArg
invalid forall a. Semigroup a => a -> a -> a
<> [Char]
" please report this bug"

validArgs ::
  Foldable t =>
  Text ->
  Set.Set Text ->
  Set.Set Text ->
  t RunMountArg ->
  Either DockerfileError [RunMountArg]
validArgs :: forall (t :: * -> *).
Foldable t =>
Text
-> Set Text
-> Set Text
-> t RunMountArg
-> Either DockerfileError [RunMountArg]
validArgs Text
typeName Set Text
allowed Set Text
required t RunMountArg
args =
  let (Either DockerfileError [RunMountArg]
result, Set Text
seen) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RunMountArg
-> (Either DockerfileError [RunMountArg], Set Text)
-> (Either DockerfileError [RunMountArg], Set Text)
checkValidArg (forall a b. b -> Either a b
Right [], forall {a}. Set a
Set.empty) t RunMountArg
args
   in case forall a. Set a -> [a]
Set.toList (forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Text
required Set Text
seen) of
        [] -> Either DockerfileError [RunMountArg]
result
        [Text]
missing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Text] -> DockerfileError
MissingArgument [Text]
missing
  where
    checkValidArg :: RunMountArg
-> (Either DockerfileError [RunMountArg], Set Text)
-> (Either DockerfileError [RunMountArg], Set Text)
checkValidArg RunMountArg
_ x :: (Either DockerfileError [RunMountArg], Set Text)
x@(Left DockerfileError
_, Set Text
_) = (Either DockerfileError [RunMountArg], Set Text)
x
    checkValidArg RunMountArg
a (Right [RunMountArg]
as, Set Text
seen) =
      let name :: Text
name = RunMountArg -> Text
toArgName RunMountArg
a
       in case (forall a. Ord a => a -> Set a -> Bool
Set.member Text
name Set Text
allowed, forall a. Ord a => a -> Set a -> Bool
Set.member Text
name Set Text
seen) of
            (Bool
False, Bool
_) -> (forall a b. a -> Either a b
Left (Text -> Text -> DockerfileError
UnexpectedArgument Text
name Text
typeName), Set Text
seen)
            (Bool
_, Bool
True) -> (forall a b. a -> Either a b
Left (Text -> DockerfileError
DuplicateArgument Text
name), Set Text
seen)
            (Bool
True, Bool
False) -> (forall a b. b -> Either a b
Right (RunMountArg
a forall a. a -> [a] -> [a]
: [RunMountArg]
as), forall a. Ord a => a -> Set a -> Set a
Set.insert Text
name Set Text
seen)

mountChoices :: (?esc :: Char) => MountType -> Parser RunMountArg
mountChoices :: (?esc::Char) => MountType -> Parser RunMountArg
mountChoices MountType
mountType =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$
    case MountType
mountType of
      MountType
Bind ->
        [ (?esc::Char) => Parser RunMountArg
mountArgTarget,
          (?esc::Char) => Parser RunMountArg
mountArgSource,
          (?esc::Char) => Parser RunMountArg
mountArgFromImage,
          Parser RunMountArg
mountArgReadOnly
        ]
      MountType
Cache ->
        [ (?esc::Char) => Parser RunMountArg
mountArgTarget,
          (?esc::Char) => Parser RunMountArg
mountArgSource,
          (?esc::Char) => Parser RunMountArg
mountArgFromImage,
          Parser RunMountArg
mountArgReadOnly,
          (?esc::Char) => Parser RunMountArg
mountArgId,
          Parser RunMountArg
mountArgSharing,
          (?esc::Char) => Parser RunMountArg
mountArgMode,
          (?esc::Char) => Parser RunMountArg
mountArgUid,
          (?esc::Char) => Parser RunMountArg
mountArgGid
        ]
      MountType
Tmpfs -> [(?esc::Char) => Parser RunMountArg
mountArgTarget]
      MountType
_ -> -- Secret and Ssh
        [ (?esc::Char) => Parser RunMountArg
mountArgTarget,
          (?esc::Char) => Parser RunMountArg
mountArgId,
          Parser RunMountArg
mountArgRequired,
          (?esc::Char) => Parser RunMountArg
mountArgSource,
          (?esc::Char) => Parser RunMountArg
mountArgMode,
          (?esc::Char) => Parser RunMountArg
mountArgUid,
          (?esc::Char) => Parser RunMountArg
mountArgGid
        ]

stringArg :: (?esc :: Char) => Parser Text
stringArg :: (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT DockerfileError Text Identity Text
doubleQuotedString, (?esc::Char) =>
[Char]
-> (Char -> Bool) -> ParsecT DockerfileError Text Identity Text
someUnless [Char]
"a string" (forall a. Eq a => a -> a -> Bool
== Char
',')]

key :: Text -> Parser a -> Parser a
key :: forall a. Text -> Parser a -> Parser a
key Text
name Parser a
p = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text
name forall a. Semigroup a => a -> a -> a
<> Text
"=") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p

tryKeyValue' :: Text -> Text -> Parser Text
tryKeyValue' :: Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
k Text
v = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' (Text
k forall a. Semigroup a => a -> a -> a
<> Text
"=") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Text
v

cacheSharing :: Parser CacheSharing
cacheSharing :: Parser CacheSharing
cacheSharing =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [CacheSharing
Private forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"private", CacheSharing
Shared forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"shared", CacheSharing
Locked forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"locked"]

mountArgFromImage :: (?esc :: Char) => Parser RunMountArg
mountArgFromImage :: (?esc::Char) => Parser RunMountArg
mountArgFromImage = Text -> RunMountArg
MountArgFromImage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
key Text
"from" (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg

mountArgGid :: (?esc :: Char) => Parser RunMountArg
mountArgGid :: (?esc::Char) => Parser RunMountArg
mountArgGid = Text -> RunMountArg
MountArgGid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
key Text
"gid" (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg

mountArgId :: (?esc :: Char) => Parser RunMountArg
mountArgId :: (?esc::Char) => Parser RunMountArg
mountArgId = Text -> RunMountArg
MountArgId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
key Text
"id" (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg

mountArgMode :: (?esc :: Char) => Parser RunMountArg
mountArgMode :: (?esc::Char) => Parser RunMountArg
mountArgMode = Text -> RunMountArg
MountArgMode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
key Text
"mode" (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg

mountArgReadOnly :: Parser RunMountArg
mountArgReadOnly :: Parser RunMountArg
mountArgReadOnly =
  Bool -> RunMountArg
MountArgReadOnly
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ ParsecT DockerfileError Text Identity Bool
choiceRoExplicit,
            ParsecT DockerfileError Text Identity Bool
choiceRwExplicit,
            ParsecT DockerfileError Text Identity Bool
choiceRo,  -- these two must come last and be separate
            ParsecT DockerfileError Text Identity Bool
choiceRw
          ]
  where
    choiceRoExplicit :: ParsecT DockerfileError Text Identity Bool
choiceRoExplicit =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"ro" Text
"true",
          Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"rw" Text
"false",
          Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"readonly" Text
"true",
          Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"readwrite" Text
"false"
        ] forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True

    choiceRwExplicit :: ParsecT DockerfileError Text Identity Bool
choiceRwExplicit =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"rw" Text
"true",
          Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"ro" Text
"false",
          Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"readwrite" Text
"true",
          Text -> Text -> ParsecT DockerfileError Text Identity Text
tryKeyValue' Text
"readonly" Text
"false"
        ] forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False

    choiceRo :: ParsecT DockerfileError Text Identity Bool
choiceRo =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"ro",
          forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"readonly"
        ] forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True

    choiceRw :: ParsecT DockerfileError Text Identity Bool
choiceRw =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"rw",
          forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"readwrite"
        ] forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False

mountArgRequired :: Parser RunMountArg
mountArgRequired :: Parser RunMountArg
mountArgRequired = Bool -> RunMountArg
MountArgRequired forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT DockerfileError Text Identity Text
"required=true",
              ParsecT DockerfileError Text Identity Text
"required=True"
             ] forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True,
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT DockerfileError Text Identity Text
"required=false",
              ParsecT DockerfileError Text Identity Text
"required=False"
             ] forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False,
      forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"required" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True  -- This must come last in the list!
    ]

mountArgSharing :: Parser RunMountArg
mountArgSharing :: Parser RunMountArg
mountArgSharing = CacheSharing -> RunMountArg
MountArgSharing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
key Text
"sharing" Parser CacheSharing
cacheSharing

mountArgSource :: (?esc :: Char) => Parser RunMountArg
mountArgSource :: (?esc::Char) => Parser RunMountArg
mountArgSource = do
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"source=" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"source=", forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"src="]
  SourcePath -> RunMountArg
MountArgSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SourcePath
SourcePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg

mountArgTarget :: (?esc :: Char) => Parser RunMountArg
mountArgTarget :: (?esc::Char) => Parser RunMountArg
mountArgTarget = do
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"target=" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"target=", forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"dst=", forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"destination="]
  TargetPath -> RunMountArg
MountArgTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TargetPath
TargetPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg

mountArgUid :: (?esc :: Char) => Parser RunMountArg
mountArgUid :: (?esc::Char) => Parser RunMountArg
mountArgUid = Text -> RunMountArg
MountArgUid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
key Text
"uid" (?esc::Char) => ParsecT DockerfileError Text Identity Text
stringArg

toArgName :: RunMountArg -> Text
toArgName :: RunMountArg -> Text
toArgName (MountArgFromImage Text
_) = Text
"from"
toArgName (MountArgGid Text
_) = Text
"gid"
toArgName (MountArgId Text
_) = Text
"id"
toArgName (MountArgMode Text
_) = Text
"mode"
toArgName (MountArgReadOnly Bool
_) = Text
"ro"
toArgName (MountArgRequired Bool
_) = Text
"required"
toArgName (MountArgSharing CacheSharing
_) = Text
"sharing"
toArgName (MountArgSource SourcePath
_) = Text
"source"
toArgName (MountArgTarget TargetPath
_) = Text
"target"
toArgName (MountArgType Text
_) = Text
"type"
toArgName (MountArgUid Text
_) = Text
"uid"