content: {-# LANGUAGE ExplicitForAll      #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  module Docker.Client.Api (
      -- * Containers
        listContainers
      , createContainer
      , startContainer
      , stopContainer
      , waitContainer
      , killContainer
      , restartContainer
      , pauseContainer
      , unpauseContainer
      , deleteContainer
      , inspectContainer
      , getContainerLogs
      , getContainerLogsStream
      -- * Images
      , listImages
      , deleteImage
      , buildImageFromDockerfile
      , pullImage
      -- * Network
      , createNetwork
      , removeNetwork
      -- * Other
      , getDockerVersion
      ) where
  
  import           Control.Monad.Catch    (MonadMask (..))
  import           Control.Monad.IO.Class
  import           Control.Monad.Reader   (ask, lift)
  import           Data.Aeson             (FromJSON, eitherDecode')
  import qualified Data.ByteString        as BS
  import qualified Data.ByteString.Lazy   as BSL
  import           Data.Conduit           (Sink)
  import qualified Data.Conduit.Binary    as Conduit
  import qualified Data.Text              as T
  import qualified Data.Text              as Text
  import           Network.HTTP.Client    (responseStatus)
  import           Network.HTTP.Types     (StdMethod (..))
  import           System.Exit            (ExitCode (..))
  
  import           Docker.Client.Http
  import           Docker.Client.Types
  import           Docker.Client.Utils
  
  requestUnit :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())
  requestUnit verb endpoint = fmap (const ()) <$> requestHelper verb endpoint
  
  requestHelper :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError BSL.ByteString)
  requestHelper verb endpoint = requestHelper' verb endpoint Conduit.sinkLbs
  
  requestHelper' :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> Sink BS.ByteString m a -> DockerT m (Either DockerError a)
  requestHelper' verb endpoint sink = do
      (opts, HttpHandler httpHandler) <- ask
      case mkHttpRequest verb endpoint opts of
          Nothing ->
              return $ Left $ DockerInvalidRequest endpoint
          Just request -> do
              -- JP: Do we need runResourceT?
              -- lift $ NHS.httpSink request $ \response ->
              lift $ httpHandler request $ \response ->
                  -- Check status code.
                  let status = responseStatus response in
                  case statusCodeToError endpoint status of
                      Just err ->
                          return $ Left err
                      Nothing ->
                          fmap Right sink
  
  parseResponse :: (FromJSON a, Monad m) => Either DockerError BSL.ByteString -> DockerT m (Either DockerError a)
  parseResponse (Left err) =
      return $ Left err
  parseResponse (Right response) =
      -- Parse request body.
      case eitherDecode' response of
          Left err ->
              return $ Left $ DockerClientDecodeError $ Text.pack err
          Right r ->
              return $ Right r
  
  -- | Gets the version of the docker engine remote API.
  getDockerVersion :: forall m. (MonadIO m, MonadMask m) => DockerT m (Either DockerError DockerVersion)
  getDockerVersion = requestHelper GET VersionEndpoint >>= parseResponse
  
  -- | Lists all running docker containers. Pass in @'defaultListOpts' {all
  -- = True}@ to get a list of stopped containers as well.
  listContainers :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Container])
  listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseResponse
  
  -- | Lists all docker images.
  listImages :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Image])
  listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse
  
  -- | Deletes an image with the given 'ImageID'.
  -- See "ImageDeleteOpts" for options and use 'defaultImageDeleteOpts' for sane
  -- defaults.
  deleteImage :: forall m. (MonadIO m, MonadMask m) => ImageDeleteOpts -> ImageID -> DockerT m (Either DockerError ())
  deleteImage dopts iid = requestUnit DELETE $ DeleteImageEndpoint dopts iid
  
  -- | Creates a docker container but does __not__ start it. See
  -- 'CreateOpts' for a list of options and you can use 'defaultCreateOpts'
  -- for some sane defaults.
  createContainer :: forall m. (MonadIO m, MonadMask m) => CreateOpts -> Maybe ContainerName -> DockerT m (Either DockerError ContainerID)
  createContainer opts cn = requestHelper POST (CreateContainerEndpoint opts cn) >>= parseResponse
  
  -- | Start a container from a given 'ContainerID' that we get from
  -- 'createContainer'. See 'StartOpts' for a list of configuration options
  -- for starting a container. Use 'defaultStartOpts' for sane defaults.
  startContainer :: forall m. (MonadIO m, MonadMask m) => StartOpts -> ContainerID -> DockerT m (Either DockerError ())
  startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid
  
  -- | Attempts to stop a container with the given 'ContainerID' gracefully
  -- (SIGTERM).
  -- The docker daemon will wait for the given 'Timeout' and then send
  -- a SIGKILL killing the container.
  stopContainer :: forall m. (MonadIO m, MonadMask m) => Timeout -> ContainerID -> DockerT m (Either DockerError ())
  stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid
  
  -- | Blocks until a container with the given 'ContainerID' stops,
  -- then returns the exit code
  -- 
  -- __NOTE__: this endpoint will not return a response until the container
  -- has stopped. This function may therefore fail with a timeout error if
  -- the timeout is configured incorrectly in the HTTP manager.
  waitContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ExitCode)
  waitContainer cid = fmap (fmap statusCodeToExitCode) (requestHelper POST (WaitContainerEndpoint cid) >>= parseResponse)
    where
      statusCodeToExitCode (StatusCode 0) = ExitSuccess
      statusCodeToExitCode (StatusCode x) = ExitFailure x
  
  -- | Sends a 'Signal' to the container with the given 'ContainerID'. Same
  -- as 'stopContainer' but you choose the signal directly.
  killContainer :: forall m. (MonadIO m, MonadMask m) => Signal -> ContainerID -> DockerT m (Either DockerError ())
  killContainer s cid = requestUnit POST $ KillContainerEndpoint s cid
  
  -- | Restarts a container with the given 'ContainerID'.
  restartContainer :: forall m. (MonadIO m, MonadMask m) => Timeout -> ContainerID -> DockerT m (Either DockerError ())
  restartContainer t cid = requestUnit POST $ RestartContainerEndpoint t cid
  
  -- | Pauses a container with the given 'ContainerID'.
  pauseContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ())
  pauseContainer cid = requestUnit POST $ PauseContainerEndpoint cid
  
  -- | Unpauses a container with the given 'ContainerID'.
  unpauseContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ())
  unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid
  
  -- | Deletes a container with the given 'ContainerID'.
  -- See "ContainerDeleteOpts" for options and use 'defaultContainerDeleteOpts' for sane
  -- defaults.
  deleteContainer :: forall m. (MonadIO m, MonadMask m) => ContainerDeleteOpts -> ContainerID -> DockerT m (Either DockerError ())
  deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid
  
  -- | Gets 'ContainerDetails' for a given 'ContainerID'.
  inspectContainer :: forall m . (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ContainerDetails)
  inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= parseResponse
  
  -- | Get's container's logs for a given 'ContainerID'.
  -- This will only work with the 'JsonFile' 'LogDriverType' as the other driver types disable
  -- this endpoint and it will return a 'DockerError'.
  --
  -- See 'LogOpts' for options that you can pass and
  -- 'defaultLogOpts' for sane defaults.
  --
  -- __NOTE__: his function will fetch the entire log that the
  -- container produced in the json-file on disk. Depending on the logging
  -- setup of the process in your container this can be a significant amount
  -- which might block your application...so use with caution.
  --
  -- If you want to stream the logs from the container continuosly then use
  -- 'getContainerLogsStream'
  --
  -- __NOTE__: It's recommended to use one of the other 'LogDriverType's available (like
  -- syslog) for creating your containers.
  getContainerLogs ::  forall m. (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)
  getContainerLogs logopts cid = requestHelper GET (ContainerLogsEndpoint logopts False cid)
  
  {-| Continuously gets the container's logs as a stream. Uses conduit.
  
  __Example__:
  
  @
  >>> import Docker.Client
  >>> import Data.Maybe
  >>> import Conduit
  >>> h <- defaultHttpHanlder
  >>> let cid = fromJust $ toContainerID "fee86e1d522b"
  >>> runDockerT (defaultClientOpts, h) $ getContainerLogsStream defaultLogOpts cid stdoutC
  @
  
  -}
  getContainerLogsStream :: forall m b . (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)
  getContainerLogsStream logopts cid = requestHelper' GET (ContainerLogsEndpoint logopts True cid)
  -- JP: Should the second (follow) argument be True? XXX
  
  -- | Build an Image from a Dockerfile
  --
  -- TODO: Add X-Registry-Config
  --
  -- TODO: Add support for remote URLs to a Dockerfile
  --
  -- TODO: Clean up temp tar.gz file after the image is built
  buildImageFromDockerfile :: forall m. (MonadIO m, MonadMask m) => BuildOpts -> FilePath -> DockerT m (Either DockerError ())
  buildImageFromDockerfile opts base = do
      ctx <- makeBuildContext $ BuildContextRootDir base
      case ctx of
          Left e  -> return $ Left e
          Right c -> requestUnit POST (BuildImageEndpoint opts c)
  
  -- | Pulls an image from Docker Hub (by default).
  --
  -- TODO: Add support for X-Registry-Auth and pulling from private docker
  -- registries.
  --
  -- TODO: Implement importImage function that uses he same
  -- CreateImageEndpoint but rather than pulling from docker hub it imports
  -- the image from a tarball or a URL.
  pullImage :: forall m b . (MonadIO m, MonadMask m) => T.Text -> Tag -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)
  pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing)
  
  -- | Creates network
  createNetwork :: forall m. (MonadIO m, MonadMask m) => CreateNetworkOpts -> DockerT m (Either DockerError NetworkID)
  createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts)  >>= parseResponse
  
  -- | Removes a network
  removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())
  removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid
  
  