{-# 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
_ ->
[ (?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,
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
]
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"