module System.Docker where
import Data.Char (toLower)
import Data.List (foldl1', intercalate)
import Data.Monoid ((<>))
import System.Network.Extra
newtype ImageName = ImageName { imageName :: String } deriving (Eq)
instance Show ImageName where
show = imageName
instance Read ImageName where
readsPrec _ s = [(ImageName s,"")]
newtype ContainerName = ContainerName { containerName :: String } deriving (Eq)
instance Show ContainerName where
show = containerName
instance Read ContainerName where
readsPrec _ s = [(ContainerName s, "")]
dockerParams :: RunParam -> [String]
dockerParams NoParam = []
dockerParams Detach = ["-d"]
dockerParams (Restart policy)
= ["--restart=" <> show policy]
dockerParams Port{..} = ["-p", (intercalate ":" [hostInterface, show hostPort, show containerPort] ++ "/" ++ (map toLower $ show proto))]
dockerParams Volume{..} = ["-v", hostPath <> ":" <> containerPath]
dockerParams Link{..} = ["--link=" ++ show linkedName <> ":" <> show linkeeName]
dockerParams Name{..} = ["--name=" ++ show contName]
dockerParams Image{..} = [show dockerImage]
dockerParams LogConfig{..} = ("--log-driver=" ++ show logDriver) : concatMap paramsLogOptions logOptions
where
paramsLogOptions (k,v) = ["--log-opt",k ++ "=" ++ v]
dockerParams (p :-- p') = dockerParams p ++ dockerParams p'
infixl 2 :--
data RunParam = Port { hostInterface :: IPInterface, hostPort :: Port, containerPort :: Port, proto :: IPProto }
| Volume { hostPath :: FilePath, containerPath :: FilePath }
| Link { linkedName :: ContainerName, linkeeName :: ContainerName }
| Name { contName :: ContainerName }
| Image { dockerImage :: ImageName }
| Restart { restartPolicy :: RestartPolicy }
| LogConfig { logDriver :: LogDriver, logOptions :: [ LogOption ] }
| RunParam :-- RunParam
| Detach
| NoParam
instance Monoid RunParam where
mempty = NoParam
mappend = (:--)
data LogDriver = JsonFile
| Syslog
| Journald
| Gelf
| Fluentd
| Awslogs
instance Show LogDriver where
show JsonFile = "json-file"
show Syslog = "syslog"
show Journald = "journald"
show Gelf = "gelf"
show Fluentd = "fluentd"
show Awslogs = "awslogs"
type LogOption = (String, String)
data RestartPolicy = NeverRestart
| OnFailure { maxRetries :: Int }
| AlwaysRestart
instance Show RestartPolicy where
show NeverRestart = "no"
show (OnFailure mr) = "on-failure:"++ show mr
show AlwaysRestart = "always"
ip :: IPInterface -> RunParam -> RunParam
ip iface p@Port{..} = p { hostInterface = iface }
ip _ p = p
port :: Port -> RunParam
port p = Port allInterfaces p p TCP
udp :: RunParam -> RunParam
udp p@Port{} = p { proto = UDP }
udp r = r
volume :: FilePath -> FilePath -> RunParam
volume = Volume
link :: ContainerName -> ContainerName -> RunParam
link = Link
name :: String -> RunParam
name = Name . ContainerName
detach :: RunParam
detach = Detach
restart :: RestartPolicy -> RunParam
restart = Restart
logConfig :: LogDriver -> [ LogOption ] -> RunParam
logConfig = LogConfig
container :: [RunParam] -> RunParam
container [] = NoParam
container ps = foldl1' (:--) ps