Docker.hs

module Docker
       ( Docker           -- :: * -> *
       , ExecType(..)     -- :: *
       , EntrySpec(..)    -- :: *
       , dockerfile       -- ::

       -- * Core commands
       -- ** Port specification
       , PortType(..)     -- :: *
       , PortRedirect(..) -- :: *
       , expose           -- ::

       , run              -- ::
       , env              -- ::
       , add              -- ::
       , volume           -- ::
       , user             -- ::
       , workdir          -- ::

       -- * Utilities
       , initApt          -- ::
       , installPkg
       , addPPA
       , wget
       , rm
       ) where
import           Control.Monad.State.Strict
import           Data.List
import           Data.Monoid

import qualified Data.Text.Lazy.Builder     as B
import qualified Data.Text.Lazy.IO          as T

-- | A type of actions which will be spit out as a @Dockerfile@.
type Docker a = State B.Builder a

data PortType = TCP | UDP
data PortRedirect
  = Random PortType Int
  | Public PortType Int Int

data ExecType = Exec | Shell
data EntrySpec
  = Entrypoint ExecType [String] (Maybe [String])
  | Cmd        ExecType [String]

-- | The EXPOSE instruction sets ports to be publicly exposed when
-- running the image. This is functionally equivalent to running
-- @docker commit -run '{"PortSpecs": ["<port>", "<port2>"]}'@ outside
-- the builder.
expose :: [PortRedirect]
       -> Docker ()
expose ports = do
  let final = unwords (map formatRedirect ports)
  appendDocker ("EXPOSE " ++ final)
  where
    formatRedirect :: PortRedirect -> String
    formatRedirect (Random ty p)        = concat [show p, "/", formatType ty]
    formatRedirect (Public ty pub priv) =
      concat [show pub, ":", show priv, "/", formatType ty]

    formatType TCP = "tcp"
    formatType UDP = "udp"

-- | The 'run' instruction will execute any commands on the current
-- image and commit the results. The resulting committed image will be
-- used for the next step in the Dockerfile.
--
-- Layering RUN instructions and generating commits conforms to the
-- core concepts of Docker where commits are cheap and containers can
-- be created from any point in an image’s history, much like source
-- control.
run :: String -- ^ Command to run inside container
    -> Docker ()
run c = appendDocker ("RUN " ++ c)

-- | The @'env' k v@ instruction sets the environment variable @k@ to
-- the value @v@. This value will be passed to all future RUN
-- instructions.
env :: String -- ^ Key
    -> String -- ^ Value
    -> Docker ()
env k v = appendDocker (unwords ["ENV",k,v])

add :: String -- ^ Source
    -> String -- ^ Destination
    -> Docker ()
add src dst = appendDocker (unwords ["ADD",src,dst])

-- | The 'user' instruction sets the username or UID to use when
-- running the image.
user :: String -- ^ Username to run image as
     -> Docker ()
user u = appendDocker ("USER " ++ u)

-- | The VOLUME instruction will add one or more new volumes to any
-- container created from the image.
volume :: [String] -- ^ A list of volumes to mount
       -> Docker ()
volume vs = appendDocker ("VOLUME " ++ listify vs)

-- | The 'workdir' instruction sets the working directory in which the
-- command given by 'cmd' is executed.
workdir :: String -- ^ Working directory
        -> Docker ()
workdir dir = appendDocker ("WORKDIR " ++ dir)

-- | Build a @Dockerfile@.
dockerfile :: String           -- ^ FROM tag
           -> String           -- ^ Maintainer
           -> Docker EntrySpec -- ^ Actions to render to the Dockerfile
           -> IO ()
dockerfile from maintainer act = do
  let (ret, st) = runState act mempty

      renderList Exec  = listify
      renderList Shell = unwords

      entry = case ret of
        Cmd        ty cmdline ->
          B.fromString ("CMD " ++ renderList ty cmdline)
        Entrypoint ty cmdline Nothing ->
          B.fromString ("ENTRYPOINT " ++ renderList ty cmdline)
        Entrypoint ty cmdline (Just def) ->
          B.fromString ("CMD "        ++ renderList ty def ++ "\n" ++
                        "ENTRYPOINT " ++ renderList ty cmdline)

  let final = B.fromString ("FROM " ++ from ++ "\n")
           <> B.fromString ("MAINTAINER " ++ maintainer ++ "\n\n")
           <> st <> B.singleton '\n'
           <> entry
  T.putStrLn (B.toLazyText final)

--------------------------------------------------------------------------------
-- Convenient helpers ----------------------------------------------------------

initApt :: Docker ()
initApt = do
  run "rm /etc/apt/sources.list"
  run "echo deb http://archive.ubuntu.com/ubuntu precise main universe multiverse > /etc/apt/sources.list"
  run "apt-get update"
  run "apt-get install -y python-software-properties less wget"

installPkg :: String -> Docker ()
installPkg name = run ("apt-get install " ++ name)

wget :: String -> String -> Docker ()
wget url out = run (unwords ["wget",url,"-o",out])

rm :: String -> Docker ()
rm path = run ("rm " ++ path)

addPPA :: String -> Docker ()
addPPA str = run ("add-apt-repository ppa:"++str)

--------------------------------------------------------------------------------
-- Utilities -------------------------------------------------------------------

appendDocker :: String -> Docker ()
appendDocker str = modify (\s -> s <> B.fromString str <> B.singleton '\n')

listify :: [String] -> String
listify xs = concat ["[", concat (intersperse "," res), "]"]
  where res = map (\x -> "\"" ++ x ++ "\"") xs

ElasticSearch.hs

module Main where
import Docker

tarball    = "elasticsearch-0.90.5.tar.gz"
tarballUrl = "https://download.elasticsearch.org/elasticsearch/elasticsearch/" ++ tarball

configFiles = [ ("logging.yml",       "config/logging.yml")
              , ("elasticsearch.yml", "config/elasticsearch.yml")
              ]

main :: IO ()
main = dockerfile "ubuntu:12.04" "Austin Seipp <aseipp@pobox.com>" $ do
  initApt
  installPkg "openjdk-7-jre-headless"

  wget tarballUrl tarball
  run ("tar -xaf " ++ tarball ++ " --strip-components=1")
  rm tarball

  mapM_ (uncurry add) configFiles

  expose (map (Random TCP) [9200, 9300, 9292])
  return $ Entrypoint Exec ["/bin/elasticsearch"] (Just ["-f"])

result

$ runghc ElasticSearch.hs

FROM ubuntu:12.04
MAINTAINER Austin Seipp <aseipp@pobox.com>

RUN rm /etc/apt/sources.list
RUN echo deb http://archive.ubuntu.com/ubuntu precise main universe multiverse > /etc/apt/sources.list
RUN apt-get update
RUN apt-get install -y python-software-properties less wget
RUN apt-get install openjdk-7-jre-headless
RUN wget https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-0.90.5.tar.gz -o elasticsearch-0.90.5.tar.gz
RUN tar -xaf elasticsearch-0.90.5.tar.gz --strip-components=1
RUN rm elasticsearch-0.90.5.tar.gz
ADD logging.yml config/logging.yml
ADD elasticsearch.yml config/elasticsearch.yml
EXPOSE 9200/tcp 9300/tcp 9292/tcp

CMD ["-f"]
ENTRYPOINT ["/bin/elasticsearch"]