{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Docker types.

module Stack.Types.Docker where

import Stack.Prelude hiding (Display (..))
import Pantry.Internal.AesonExtended
import Data.List (intercalate)
import qualified Data.Text as T
import Distribution.System (Platform(..), OS(..), Arch(..))
import Distribution.Text (simpleParse, display)
import Distribution.Version (anyVersion)
import Generics.Deriving.Monoid (mappenddefault, memptydefault)
import Path
import Stack.Types.Version
import Text.Read (Read (..))

-- | Docker configuration.
data DockerOpts = DockerOpts
  {DockerOpts -> Bool
dockerEnable :: !Bool
    -- ^ Is using Docker enabled?
  ,DockerOpts -> Either SomeException String
dockerImage :: !(Either SomeException String)
    -- ^ Exact Docker image tag or ID.  Overrides docker-repo-*/tag.
  ,DockerOpts -> Bool
dockerRegistryLogin :: !Bool
    -- ^ Does registry require login for pulls?
  ,DockerOpts -> Maybe String
dockerRegistryUsername :: !(Maybe String)
    -- ^ Optional username for Docker registry.
  ,DockerOpts -> Maybe String
dockerRegistryPassword :: !(Maybe String)
    -- ^ Optional password for Docker registry.
  ,DockerOpts -> Bool
dockerAutoPull :: !Bool
    -- ^ Automatically pull new images.
  ,DockerOpts -> Bool
dockerDetach :: !Bool
    -- ^ Whether to run a detached container
  ,DockerOpts -> Bool
dockerPersist :: !Bool
    -- ^ Create a persistent container (don't remove it when finished).  Implied by
    -- `dockerDetach`.
  ,DockerOpts -> Maybe String
dockerContainerName :: !(Maybe String)
    -- ^ Container name to use, only makes sense from command-line with `dockerPersist`
    -- or `dockerDetach`.
  ,DockerOpts -> Maybe String
dockerNetwork :: !(Maybe String)
   -- ^ The network docker uses.
  ,DockerOpts -> [String]
dockerRunArgs :: ![String]
    -- ^ Arguments to pass directly to @docker run@.
  ,DockerOpts -> [Mount]
dockerMount :: ![Mount]
    -- ^ Volumes to mount in the container.
  ,DockerOpts -> Maybe String
dockerMountMode :: !(Maybe String)
    -- ^ Volume mount mode
  ,DockerOpts -> [String]
dockerEnv :: ![String]
    -- ^ Environment variables to set in the container.
  ,DockerOpts -> Maybe DockerStackExe
dockerStackExe :: !(Maybe DockerStackExe)
    -- ^ Location of container-compatible stack executable
  ,DockerOpts -> Maybe Bool
dockerSetUser :: !(Maybe Bool)
   -- ^ Set in-container user to match host's
  ,DockerOpts -> VersionRange
dockerRequireDockerVersion :: !VersionRange
   -- ^ Require a version of Docker within this range.
  }
  deriving (Int -> DockerOpts -> ShowS
[DockerOpts] -> ShowS
DockerOpts -> String
(Int -> DockerOpts -> ShowS)
-> (DockerOpts -> String)
-> ([DockerOpts] -> ShowS)
-> Show DockerOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockerOpts] -> ShowS
$cshowList :: [DockerOpts] -> ShowS
show :: DockerOpts -> String
$cshow :: DockerOpts -> String
showsPrec :: Int -> DockerOpts -> ShowS
$cshowsPrec :: Int -> DockerOpts -> ShowS
Show)

-- | An uninterpreted representation of docker options.
-- Configurations may be "cascaded" using mappend (left-biased).
data DockerOptsMonoid = DockerOptsMonoid
  {DockerOptsMonoid -> Any
dockerMonoidDefaultEnable :: !Any
    -- ^ Should Docker be defaulted to enabled (does @docker:@ section exist in the config)?
  ,DockerOptsMonoid -> First Bool
dockerMonoidEnable :: !(First Bool)
    -- ^ Is using Docker enabled?
  ,DockerOptsMonoid -> First DockerMonoidRepoOrImage
dockerMonoidRepoOrImage :: !(First DockerMonoidRepoOrImage)
    -- ^ Docker repository name (e.g. @fpco/stack-build@ or @fpco/stack-full:lts-2.8@)
  ,DockerOptsMonoid -> First Bool
dockerMonoidRegistryLogin :: !(First Bool)
    -- ^ Does registry require login for pulls?
  ,DockerOptsMonoid -> First String
dockerMonoidRegistryUsername :: !(First String)
    -- ^ Optional username for Docker registry.
  ,DockerOptsMonoid -> First String
dockerMonoidRegistryPassword :: !(First String)
    -- ^ Optional password for Docker registry.
  ,DockerOptsMonoid -> FirstTrue
dockerMonoidAutoPull :: !FirstTrue
    -- ^ Automatically pull new images.
  ,DockerOptsMonoid -> FirstFalse
dockerMonoidDetach :: !FirstFalse
    -- ^ Whether to run a detached container
  ,DockerOptsMonoid -> FirstFalse
dockerMonoidPersist :: !FirstFalse
    -- ^ Create a persistent container (don't remove it when finished).  Implied by
    -- `dockerDetach`.
  ,DockerOptsMonoid -> First String
dockerMonoidContainerName :: !(First String)
    -- ^ Container name to use, only makes sense from command-line with `dockerPersist`
    -- or `dockerDetach`.
  ,DockerOptsMonoid -> First String
dockerMonoidNetwork :: !(First String)
    -- ^ See: 'dockerNetwork'
  ,DockerOptsMonoid -> [String]
dockerMonoidRunArgs :: ![String]
    -- ^ Arguments to pass directly to @docker run@
  ,DockerOptsMonoid -> [Mount]
dockerMonoidMount :: ![Mount]
    -- ^ Volumes to mount in the container
  ,DockerOptsMonoid -> First String
dockerMonoidMountMode :: !(First String)
    -- ^ Volume mount mode
  ,DockerOptsMonoid -> [String]
dockerMonoidEnv :: ![String]
    -- ^ Environment variables to set in the container
  ,DockerOptsMonoid -> First DockerStackExe
dockerMonoidStackExe :: !(First DockerStackExe)
    -- ^ Location of container-compatible stack executable
  ,DockerOptsMonoid -> First Bool
dockerMonoidSetUser :: !(First Bool)
   -- ^ Set in-container user to match host's
  ,DockerOptsMonoid -> IntersectingVersionRange
dockerMonoidRequireDockerVersion :: !IntersectingVersionRange
  -- ^ See: 'dockerRequireDockerVersion'
  }
  deriving (Int -> DockerOptsMonoid -> ShowS
[DockerOptsMonoid] -> ShowS
DockerOptsMonoid -> String
(Int -> DockerOptsMonoid -> ShowS)
-> (DockerOptsMonoid -> String)
-> ([DockerOptsMonoid] -> ShowS)
-> Show DockerOptsMonoid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockerOptsMonoid] -> ShowS
$cshowList :: [DockerOptsMonoid] -> ShowS
show :: DockerOptsMonoid -> String
$cshow :: DockerOptsMonoid -> String
showsPrec :: Int -> DockerOptsMonoid -> ShowS
$cshowsPrec :: Int -> DockerOptsMonoid -> ShowS
Show, (forall x. DockerOptsMonoid -> Rep DockerOptsMonoid x)
-> (forall x. Rep DockerOptsMonoid x -> DockerOptsMonoid)
-> Generic DockerOptsMonoid
forall x. Rep DockerOptsMonoid x -> DockerOptsMonoid
forall x. DockerOptsMonoid -> Rep DockerOptsMonoid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DockerOptsMonoid x -> DockerOptsMonoid
$cfrom :: forall x. DockerOptsMonoid -> Rep DockerOptsMonoid x
Generic)

-- | Decode uninterpreted docker options from JSON/YAML.
instance FromJSON (WithJSONWarnings DockerOptsMonoid) where
  parseJSON :: Value -> Parser (WithJSONWarnings DockerOptsMonoid)
parseJSON = String
-> (Object -> WarningParser DockerOptsMonoid)
-> Value
-> Parser (WithJSONWarnings DockerOptsMonoid)
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"DockerOptsMonoid"
    (\Object
o -> do let dockerMonoidDefaultEnable :: Any
dockerMonoidDefaultEnable = Bool -> Any
Any Bool
True
              First Bool
dockerMonoidEnable           <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerEnableArgName
              First DockerMonoidRepoOrImage
dockerMonoidRepoOrImage      <- Maybe DockerMonoidRepoOrImage -> First DockerMonoidRepoOrImage
forall a. Maybe a -> First a
First (Maybe DockerMonoidRepoOrImage -> First DockerMonoidRepoOrImage)
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
-> WriterT
     WarningParserMonoid Parser (First DockerMonoidRepoOrImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                              ((DockerMonoidRepoOrImage -> Maybe DockerMonoidRepoOrImage
forall a. a -> Maybe a
Just (DockerMonoidRepoOrImage -> Maybe DockerMonoidRepoOrImage)
-> (String -> DockerMonoidRepoOrImage)
-> String
-> Maybe DockerMonoidRepoOrImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DockerMonoidRepoOrImage
DockerMonoidImage (String -> Maybe DockerMonoidRepoOrImage)
-> WriterT WarningParserMonoid Parser String
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser String
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
dockerImageArgName) WriterT WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                              (DockerMonoidRepoOrImage -> Maybe DockerMonoidRepoOrImage
forall a. a -> Maybe a
Just (DockerMonoidRepoOrImage -> Maybe DockerMonoidRepoOrImage)
-> (String -> DockerMonoidRepoOrImage)
-> String
-> Maybe DockerMonoidRepoOrImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DockerMonoidRepoOrImage
DockerMonoidRepo (String -> Maybe DockerMonoidRepoOrImage)
-> WriterT WarningParserMonoid Parser String
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser String
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
dockerRepoArgName) WriterT WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                              Maybe DockerMonoidRepoOrImage
-> WriterT
     WarningParserMonoid Parser (Maybe DockerMonoidRepoOrImage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DockerMonoidRepoOrImage
forall a. Maybe a
Nothing)
              First Bool
dockerMonoidRegistryLogin    <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerRegistryLoginArgName
              First String
dockerMonoidRegistryUsername <- Maybe String -> First String
forall a. Maybe a -> First a
First (Maybe String -> First String)
-> WriterT WarningParserMonoid Parser (Maybe String)
-> WriterT WarningParserMonoid Parser (First String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerRegistryUsernameArgName
              First String
dockerMonoidRegistryPassword <- Maybe String -> First String
forall a. Maybe a -> First a
First (Maybe String -> First String)
-> WriterT WarningParserMonoid Parser (Maybe String)
-> WriterT WarningParserMonoid Parser (First String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerRegistryPasswordArgName
              FirstTrue
dockerMonoidAutoPull         <- Maybe Bool -> FirstTrue
FirstTrue (Maybe Bool -> FirstTrue)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstTrue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerAutoPullArgName
              FirstFalse
dockerMonoidDetach           <- Maybe Bool -> FirstFalse
FirstFalse (Maybe Bool -> FirstFalse)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstFalse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerDetachArgName
              FirstFalse
dockerMonoidPersist          <- Maybe Bool -> FirstFalse
FirstFalse (Maybe Bool -> FirstFalse)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser FirstFalse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerPersistArgName
              First String
dockerMonoidContainerName    <- Maybe String -> First String
forall a. Maybe a -> First a
First (Maybe String -> First String)
-> WriterT WarningParserMonoid Parser (Maybe String)
-> WriterT WarningParserMonoid Parser (First String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerContainerNameArgName
              First String
dockerMonoidNetwork          <- Maybe String -> First String
forall a. Maybe a -> First a
First (Maybe String -> First String)
-> WriterT WarningParserMonoid Parser (Maybe String)
-> WriterT WarningParserMonoid Parser (First String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerNetworkArgName
              [String]
dockerMonoidRunArgs          <- Object
o Object -> Text -> WarningParser (Maybe [String])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerRunArgsArgName WarningParser (Maybe [String])
-> [String] -> WarningParser [String]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
              [Mount]
dockerMonoidMount            <- Object
o Object -> Text -> WarningParser (Maybe [Mount])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerMountArgName WarningParser (Maybe [Mount]) -> [Mount] -> WarningParser [Mount]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
              First String
dockerMonoidMountMode        <- Maybe String -> First String
forall a. Maybe a -> First a
First (Maybe String -> First String)
-> WriterT WarningParserMonoid Parser (Maybe String)
-> WriterT WarningParserMonoid Parser (First String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerMountModeArgName
              [String]
dockerMonoidEnv              <- Object
o Object -> Text -> WarningParser (Maybe [String])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerEnvArgName WarningParser (Maybe [String])
-> [String] -> WarningParser [String]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= []
              First DockerStackExe
dockerMonoidStackExe         <- Maybe DockerStackExe -> First DockerStackExe
forall a. Maybe a -> First a
First (Maybe DockerStackExe -> First DockerStackExe)
-> WriterT WarningParserMonoid Parser (Maybe DockerStackExe)
-> WriterT WarningParserMonoid Parser (First DockerStackExe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe DockerStackExe)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerStackExeArgName
              First Bool
dockerMonoidSetUser          <- Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (Maybe Bool -> First Bool)
-> WriterT WarningParserMonoid Parser (Maybe Bool)
-> WriterT WarningParserMonoid Parser (First Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerSetUserArgName
              IntersectingVersionRange
dockerMonoidRequireDockerVersion
                                           <- VersionRange -> IntersectingVersionRange
IntersectingVersionRange (VersionRange -> IntersectingVersionRange)
-> (VersionRangeJSON -> VersionRange)
-> VersionRangeJSON
-> IntersectingVersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRangeJSON -> VersionRange
unVersionRangeJSON (VersionRangeJSON -> IntersectingVersionRange)
-> WriterT WarningParserMonoid Parser VersionRangeJSON
-> WriterT WarningParserMonoid Parser IntersectingVersionRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
                                                 Object
o Object -> Text -> WarningParser (Maybe VersionRangeJSON)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
dockerRequireDockerVersionArgName
                                                   WarningParser (Maybe VersionRangeJSON)
-> VersionRangeJSON
-> WriterT WarningParserMonoid Parser VersionRangeJSON
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= VersionRange -> VersionRangeJSON
VersionRangeJSON VersionRange
anyVersion)
              DockerOptsMonoid -> WarningParser DockerOptsMonoid
forall (m :: * -> *) a. Monad m => a -> m a
return DockerOptsMonoid :: Any
-> First Bool
-> First DockerMonoidRepoOrImage
-> First Bool
-> First String
-> First String
-> FirstTrue
-> FirstFalse
-> FirstFalse
-> First String
-> First String
-> [String]
-> [Mount]
-> First String
-> [String]
-> First DockerStackExe
-> First Bool
-> IntersectingVersionRange
-> DockerOptsMonoid
DockerOptsMonoid{[String]
[Mount]
Any
First Bool
First String
First DockerMonoidRepoOrImage
First DockerStackExe
FirstFalse
FirstTrue
IntersectingVersionRange
dockerMonoidRequireDockerVersion :: IntersectingVersionRange
dockerMonoidSetUser :: First Bool
dockerMonoidStackExe :: First DockerStackExe
dockerMonoidEnv :: [String]
dockerMonoidMountMode :: First String
dockerMonoidMount :: [Mount]
dockerMonoidRunArgs :: [String]
dockerMonoidNetwork :: First String
dockerMonoidContainerName :: First String
dockerMonoidPersist :: FirstFalse
dockerMonoidDetach :: FirstFalse
dockerMonoidAutoPull :: FirstTrue
dockerMonoidRegistryPassword :: First String
dockerMonoidRegistryUsername :: First String
dockerMonoidRegistryLogin :: First Bool
dockerMonoidRepoOrImage :: First DockerMonoidRepoOrImage
dockerMonoidEnable :: First Bool
dockerMonoidDefaultEnable :: Any
dockerMonoidRequireDockerVersion :: IntersectingVersionRange
dockerMonoidSetUser :: First Bool
dockerMonoidStackExe :: First DockerStackExe
dockerMonoidEnv :: [String]
dockerMonoidMountMode :: First String
dockerMonoidMount :: [Mount]
dockerMonoidRunArgs :: [String]
dockerMonoidNetwork :: First String
dockerMonoidContainerName :: First String
dockerMonoidPersist :: FirstFalse
dockerMonoidDetach :: FirstFalse
dockerMonoidAutoPull :: FirstTrue
dockerMonoidRegistryPassword :: First String
dockerMonoidRegistryUsername :: First String
dockerMonoidRegistryLogin :: First Bool
dockerMonoidRepoOrImage :: First DockerMonoidRepoOrImage
dockerMonoidEnable :: First Bool
dockerMonoidDefaultEnable :: Any
..})

-- | Left-biased combine Docker options
instance Semigroup DockerOptsMonoid where
  <> :: DockerOptsMonoid -> DockerOptsMonoid -> DockerOptsMonoid
(<>) = DockerOptsMonoid -> DockerOptsMonoid -> DockerOptsMonoid
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

-- | Left-biased combine Docker options
instance Monoid DockerOptsMonoid where
  mempty :: DockerOptsMonoid
mempty = DockerOptsMonoid
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault
  mappend :: DockerOptsMonoid -> DockerOptsMonoid -> DockerOptsMonoid
mappend = DockerOptsMonoid -> DockerOptsMonoid -> DockerOptsMonoid
forall a. Semigroup a => a -> a -> a
(<>)

-- | Where to get the `stack` executable to run in Docker containers
data DockerStackExe
    = DockerStackExeDownload  -- ^ Download from official bindist
    | DockerStackExeHost  -- ^ Host's `stack` (linux-x86_64 only)
    | DockerStackExeImage  -- ^ Docker image's `stack` (versions must match)
    | DockerStackExePath (Path Abs File) -- ^ Executable at given path
    deriving (Int -> DockerStackExe -> ShowS
[DockerStackExe] -> ShowS
DockerStackExe -> String
(Int -> DockerStackExe -> ShowS)
-> (DockerStackExe -> String)
-> ([DockerStackExe] -> ShowS)
-> Show DockerStackExe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockerStackExe] -> ShowS
$cshowList :: [DockerStackExe] -> ShowS
show :: DockerStackExe -> String
$cshow :: DockerStackExe -> String
showsPrec :: Int -> DockerStackExe -> ShowS
$cshowsPrec :: Int -> DockerStackExe -> ShowS
Show)

instance FromJSON DockerStackExe where
    parseJSON :: Value -> Parser DockerStackExe
parseJSON Value
a = do
        String
s <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a
        case String -> Either SomeException DockerStackExe
forall (m :: * -> *). MonadThrow m => String -> m DockerStackExe
parseDockerStackExe String
s of
            Right DockerStackExe
dse -> DockerStackExe -> Parser DockerStackExe
forall (m :: * -> *) a. Monad m => a -> m a
return DockerStackExe
dse
            Left SomeException
e -> String -> Parser DockerStackExe
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)

-- | Parse 'DockerStackExe'.
parseDockerStackExe :: (MonadThrow m) => String -> m DockerStackExe
parseDockerStackExe :: String -> m DockerStackExe
parseDockerStackExe String
t
    | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dockerStackExeDownloadVal = DockerStackExe -> m DockerStackExe
forall (m :: * -> *) a. Monad m => a -> m a
return DockerStackExe
DockerStackExeDownload
    | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dockerStackExeHostVal = DockerStackExe -> m DockerStackExe
forall (m :: * -> *) a. Monad m => a -> m a
return DockerStackExe
DockerStackExeHost
    | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dockerStackExeImageVal = DockerStackExe -> m DockerStackExe
forall (m :: * -> *) a. Monad m => a -> m a
return DockerStackExe
DockerStackExeImage
    | Bool
otherwise = case String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
t of
        Just Path Abs File
p -> DockerStackExe -> m DockerStackExe
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> DockerStackExe
DockerStackExePath Path Abs File
p)
        Maybe (Path Abs File)
Nothing -> StackDockerException -> m DockerStackExe
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> StackDockerException
DockerStackExeParseException String
t)

-- | Docker volume mount.
data Mount = Mount String String

-- | For optparse-applicative.
instance Read Mount where
  readsPrec :: Int -> ReadS Mount
readsPrec Int
_ String
s =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
s of
      (String
a,Char
':':String
b) -> [(String -> String -> Mount
Mount String
a String
b,String
"")]
      (String
a,[]) -> [(String -> String -> Mount
Mount String
a String
a,String
"")]
      (String, String)
_ -> ReadS Mount
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid value for Docker mount (expect '/host/path:/container/path')"

-- | Show instance.
instance Show Mount where
  show :: Mount -> String
show (Mount String
a String
b) = if String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b
                        then String
a
                        else [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
a,String
":",String
b]

-- | For YAML.
instance FromJSON Mount where
  parseJSON :: Value -> Parser Mount
parseJSON Value
v = do
    String
s <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case String -> Maybe Mount
forall a. Read a => String -> Maybe a
readMaybe String
s of
      Maybe Mount
Nothing -> String -> Parser Mount
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Mount) -> String -> Parser Mount
forall a b. (a -> b) -> a -> b
$ String
"Mount read failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
      Just Mount
x -> Mount -> Parser Mount
forall (m :: * -> *) a. Monad m => a -> m a
return Mount
x

-- | Options for Docker repository or image.
data DockerMonoidRepoOrImage
  = DockerMonoidRepo String
  | DockerMonoidImage String
  deriving (Int -> DockerMonoidRepoOrImage -> ShowS
[DockerMonoidRepoOrImage] -> ShowS
DockerMonoidRepoOrImage -> String
(Int -> DockerMonoidRepoOrImage -> ShowS)
-> (DockerMonoidRepoOrImage -> String)
-> ([DockerMonoidRepoOrImage] -> ShowS)
-> Show DockerMonoidRepoOrImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockerMonoidRepoOrImage] -> ShowS
$cshowList :: [DockerMonoidRepoOrImage] -> ShowS
show :: DockerMonoidRepoOrImage -> String
$cshow :: DockerMonoidRepoOrImage -> String
showsPrec :: Int -> DockerMonoidRepoOrImage -> ShowS
$cshowsPrec :: Int -> DockerMonoidRepoOrImage -> ShowS
Show)

-- | Newtype for non-orphan FromJSON instance.
newtype VersionRangeJSON = VersionRangeJSON { VersionRangeJSON -> VersionRange
unVersionRangeJSON :: VersionRange }

-- | Parse VersionRange.
instance FromJSON VersionRangeJSON where
  parseJSON :: Value -> Parser VersionRangeJSON
parseJSON = String
-> (Text -> Parser VersionRangeJSON)
-> Value
-> Parser VersionRangeJSON
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionRange"
                (\Text
s -> Parser VersionRangeJSON
-> (VersionRange -> Parser VersionRangeJSON)
-> Maybe VersionRange
-> Parser VersionRangeJSON
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser VersionRangeJSON
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid cabal-style VersionRange: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s))
                             (VersionRangeJSON -> Parser VersionRangeJSON
forall (m :: * -> *) a. Monad m => a -> m a
return (VersionRangeJSON -> Parser VersionRangeJSON)
-> (VersionRange -> VersionRangeJSON)
-> VersionRange
-> Parser VersionRangeJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionRangeJSON
VersionRangeJSON)
                             (String -> Maybe VersionRange
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse (Text -> String
T.unpack Text
s)))

-- | Exceptions thrown by Stack.Docker.
data StackDockerException
    = DockerMustBeEnabledException
      -- ^ Docker must be enabled to use the command.
    | OnlyOnHostException
      -- ^ Command must be run on host OS (not in a container).
    | InspectFailedException String
      -- ^ @docker inspect@ failed.
    | NotPulledException String
      -- ^ Image does not exist.
    | InvalidImagesOutputException String
      -- ^ Invalid output from @docker images@.
    | InvalidPSOutputException String
      -- ^ Invalid output from @docker ps@.
    | InvalidInspectOutputException String
      -- ^ Invalid output from @docker inspect@.
    | PullFailedException String
      -- ^ Could not pull a Docker image.
    | DockerTooOldException Version Version
      -- ^ Installed version of @docker@ below minimum version.
    | DockerVersionProhibitedException [Version] Version
      -- ^ Installed version of @docker@ is prohibited.
    | BadDockerVersionException VersionRange Version
      -- ^ Installed version of @docker@ is out of range specified in config file.
    | InvalidVersionOutputException
      -- ^ Invalid output from @docker --version@.
    | HostStackTooOldException Version (Maybe Version)
      -- ^ Version of @stack@ on host is too old for version in image.
    | ContainerStackTooOldException Version Version
      -- ^ Version of @stack@ in container/image is too old for version on host.
    | CannotDetermineProjectRootException
      -- ^ Can't determine the project root (where to put docker sandbox).
    | DockerNotInstalledException
      -- ^ @docker --version@ failed.
    | UnsupportedStackExeHostPlatformException
      -- ^ Using host stack-exe on unsupported platform.
    | DockerStackExeParseException String
      -- ^ @stack-exe@ option fails to parse.
    deriving (Typeable)
instance Exception StackDockerException

instance Show StackDockerException where
    show :: StackDockerException -> String
show StackDockerException
DockerMustBeEnabledException =
        String
"Docker must be enabled in your configuration file to use this command."
    show StackDockerException
OnlyOnHostException =
        String
"This command must be run on host OS (not in a Docker container)."
    show (InspectFailedException String
image) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"'docker inspect' failed for image after pull: ",String
image,String
"."]
    show (NotPulledException String
image) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"The Docker image referenced by your configuration file"
               ,String
" has not\nbeen downloaded:\n    "
               ,String
image
               ,String
"\n\nRun '"
               ,[String] -> String
unwords [String
stackProgName, String
dockerCmdName, String
dockerPullCmdName]
               ,String
"' to download it, then try again."]
    show (InvalidImagesOutputException String
line) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Invalid 'docker images' output line: '",String
line,String
"'."]
    show (InvalidPSOutputException String
line) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Invalid 'docker ps' output line: '",String
line,String
"'."]
    show (InvalidInspectOutputException String
msg) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Invalid 'docker inspect' output: ",String
msg,String
"."]
    show (PullFailedException String
image) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Could not pull Docker image:\n    "
               ,String
image
               ,String
"\nThere may not be an image on the registry for your resolver's LTS version in\n"
               ,String
"your configuration file."]
    show (DockerTooOldException Version
minVersion Version
haveVersion) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Minimum docker version '"
               ,Version -> String
versionString Version
minVersion
               ,String
"' is required by "
               ,String
stackProgName
               ,String
" (you have '"
               ,Version -> String
versionString Version
haveVersion
               ,String
"')."]
    show (DockerVersionProhibitedException [Version]
prohibitedVersions Version
haveVersion) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"These Docker versions are incompatible with "
               ,String
stackProgName
               ,String
" (you have '"
               ,Version -> String
versionString Version
haveVersion
               ,String
"'): "
               ,String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Version -> String) -> [Version] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Version -> String
versionString [Version]
prohibitedVersions)
               ,String
"."]
    show (BadDockerVersionException VersionRange
requiredRange Version
haveVersion) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"The version of 'docker' you are using ("
               ,Version -> String
forall a. Show a => a -> String
show Version
haveVersion
               ,String
") is outside the required\n"
               ,String
"version range specified in stack.yaml ("
               ,Text -> String
T.unpack (VersionRange -> Text
versionRangeText VersionRange
requiredRange)
               ,String
")."]
    show StackDockerException
InvalidVersionOutputException =
        String
"Cannot get Docker version (invalid 'docker --version' output)."
    show (HostStackTooOldException Version
minVersion (Just Version
hostVersion)) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"The host's version of '"
               ,String
stackProgName
               ,String
"' is too old for this Docker image.\nVersion "
               ,Version -> String
versionString Version
minVersion
               ,String
" is required; you have "
               ,Version -> String
versionString Version
hostVersion
               ,String
"."]
    show (HostStackTooOldException Version
minVersion Maybe Version
Nothing) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"The host's version of '"
               ,String
stackProgName
               ,String
"' is too old.\nVersion "
               ,Version -> String
versionString Version
minVersion
               ,String
" is required."]
    show (ContainerStackTooOldException Version
requiredVersion Version
containerVersion) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"The Docker container's version of '"
               ,String
stackProgName
               ,String
"' is too old.\nVersion "
               ,Version -> String
versionString Version
requiredVersion
               ,String
" is required; the container has "
               ,Version -> String
versionString Version
containerVersion
               ,String
"."]
    show StackDockerException
CannotDetermineProjectRootException =
        String
"Cannot determine project root directory for Docker sandbox."
    show StackDockerException
DockerNotInstalledException =
        String
"Cannot find 'docker' in PATH.  Is Docker installed?"
    show StackDockerException
UnsupportedStackExeHostPlatformException = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Using host's "
        , String
stackProgName
        , String
" executable in Docker container is only supported on "
        , Platform -> String
forall a. Pretty a => a -> String
display Platform
dockerContainerPlatform
        , String
" platform" ]
    show (DockerStackExeParseException String
s) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Failed to parse "
        , ShowS
forall a. Show a => a -> String
show String
s
        , String
". Expected "
        , ShowS
forall a. Show a => a -> String
show String
dockerStackExeDownloadVal
        , String
", "
        , ShowS
forall a. Show a => a -> String
show String
dockerStackExeHostVal
        , String
", "
        , ShowS
forall a. Show a => a -> String
show String
dockerStackExeImageVal
        , String
" or absolute path to executable."
        ]

-- | Docker enable argument name.
dockerEnableArgName :: Text
dockerEnableArgName :: Text
dockerEnableArgName = Text
"enable"

-- | Docker repo arg argument name.
dockerRepoArgName :: Text
dockerRepoArgName :: Text
dockerRepoArgName = Text
"repo"

-- | Docker image argument name.
dockerImageArgName :: Text
dockerImageArgName :: Text
dockerImageArgName = Text
"image"

-- | Docker registry login argument name.
dockerRegistryLoginArgName :: Text
dockerRegistryLoginArgName :: Text
dockerRegistryLoginArgName = Text
"registry-login"

-- | Docker registry username argument name.
dockerRegistryUsernameArgName :: Text
dockerRegistryUsernameArgName :: Text
dockerRegistryUsernameArgName = Text
"registry-username"

-- | Docker registry password argument name.
dockerRegistryPasswordArgName :: Text
dockerRegistryPasswordArgName :: Text
dockerRegistryPasswordArgName = Text
"registry-password"

-- | Docker auto-pull argument name.
dockerAutoPullArgName :: Text
dockerAutoPullArgName :: Text
dockerAutoPullArgName = Text
"auto-pull"

-- | Docker detach argument name.
dockerDetachArgName :: Text
dockerDetachArgName :: Text
dockerDetachArgName = Text
"detach"

-- | Docker run args argument name.
dockerRunArgsArgName :: Text
dockerRunArgsArgName :: Text
dockerRunArgsArgName = Text
"run-args"

-- | Docker mount argument name.
dockerMountArgName :: Text
dockerMountArgName :: Text
dockerMountArgName = Text
"mount"

-- | Docker mount mode argument name.
dockerMountModeArgName :: Text
dockerMountModeArgName :: Text
dockerMountModeArgName = Text
"mount-mode"

-- | Docker environment variable argument name.
dockerEnvArgName :: Text
dockerEnvArgName :: Text
dockerEnvArgName = Text
"env"

-- | Docker container name argument name.
dockerContainerNameArgName :: Text
dockerContainerNameArgName :: Text
dockerContainerNameArgName = Text
"container-name"
--
-- | Docker container name argument name.
dockerNetworkArgName :: Text
dockerNetworkArgName :: Text
dockerNetworkArgName = Text
"network"

-- | Docker persist argument name.
dockerPersistArgName :: Text
dockerPersistArgName :: Text
dockerPersistArgName = Text
"persist"

-- | Docker stack executable argument name.
dockerStackExeArgName :: Text
dockerStackExeArgName :: Text
dockerStackExeArgName = Text
"stack-exe"

-- | Value for @--docker-stack-exe=download@
dockerStackExeDownloadVal :: String
dockerStackExeDownloadVal :: String
dockerStackExeDownloadVal = String
"download"

-- | Value for @--docker-stack-exe=host@
dockerStackExeHostVal :: String
dockerStackExeHostVal :: String
dockerStackExeHostVal = String
"host"

-- | Value for @--docker-stack-exe=image@
dockerStackExeImageVal :: String
dockerStackExeImageVal :: String
dockerStackExeImageVal = String
"image"

-- | Docker @set-user@ argument name
dockerSetUserArgName :: Text
dockerSetUserArgName :: Text
dockerSetUserArgName = Text
"set-user"

-- | Docker @require-version@ argument name
dockerRequireDockerVersionArgName :: Text
dockerRequireDockerVersionArgName :: Text
dockerRequireDockerVersionArgName = Text
"require-docker-version"

-- | Argument name used to pass docker entrypoint data (only used internally)
dockerEntrypointArgName :: String
dockerEntrypointArgName :: String
dockerEntrypointArgName = String
"internal-docker-entrypoint"

-- | Command-line argument for "docker"
dockerCmdName :: String
dockerCmdName :: String
dockerCmdName = String
"docker"

dockerHelpOptName :: String
dockerHelpOptName :: String
dockerHelpOptName = String
dockerCmdName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-help"

-- | Command-line argument for @docker pull@.
dockerPullCmdName :: String
dockerPullCmdName :: String
dockerPullCmdName = String
"pull"

-- | Command-line option for @--internal-re-exec-version@.
reExecArgName :: String
reExecArgName :: String
reExecArgName = String
"internal-re-exec-version"

-- | Platform that Docker containers run
dockerContainerPlatform :: Platform
dockerContainerPlatform :: Platform
dockerContainerPlatform = Arch -> OS -> Platform
Platform Arch
X86_64 OS
Linux