{-# LANGUAGE OverloadedStrings #-}

module Network.Docker where

import           Control.Applicative         ((<$>), (<*>))
import           Control.Lens
import           Data.Aeson                  (FromJSON, ToJSON, decode,
                                              eitherDecode, toJSON)
import           Data.Aeson.Lens             (key, _String)
import           Data.Aeson.TH
import qualified Data.ByteString.Lazy        as L
import           Data.Char
import qualified Data.Text                   as T
import           Network.Docker.Options
import           Network.Docker.Types
import           Network.HTTP.Client.OpenSSL
import           Network.Wreq
import           OpenSSL                     (withOpenSSL)
import           OpenSSL.Session             (SSLContext, context)
import qualified OpenSSL.Session             as SSL
import           Pipes
import qualified Pipes.ByteString            as PB
import qualified Pipes.HTTP                  as PH
import           Text.Printf                 (printf)


defaultClientOpts :: DockerClientOpts
defaultClientOpts = DockerClientOpts
                { apiVersion = "v1.12"
                , baseUrl = "http://127.0.0.1:3128/"
                , ssl = NoSSL
                }

constructUrl :: URL -> ApiVersion -> Endpoint -> URL
constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint

constructRelativeUrl url = url :: String

decodeResponse r = decode <$> (^. responseBody) <$> r

getOutOfResponse k r = (^? responseBody . key k . _String) r

getResponseStatusCode r = (^. responseStatus) r

fullUrl :: DockerClientOpts -> Endpoint -> URL
fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) endpoint

setupSSLCtx :: SSLOptions -> IO SSLContext
setupSSLCtx (SSLOptions key cert) = do
  ctx <- SSL.context
  SSL.contextSetPrivateKeyFile  ctx key
  SSL.contextSetCertificateFile ctx cert
  SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3
  SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2
  return ctx


mkOpts c = defaults & manager .~ Left (opensslManagerSettings c)

getSSL
  :: SSLOptions
  -> String
  -> IO (Response L.ByteString)
getSSL sopts url = withOpenSSL $ getWith (mkOpts $ setupSSLCtx sopts) url

postSSL
  :: ToJSON a
  => SSLOptions
  -> String
  -> a
  -> IO (Response L.ByteString)
postSSL sopts url = withOpenSSL . postWith (mkOpts $ setupSSLCtx sopts) url . toJSON

_dockerGetQuery :: Endpoint -> DockerClientOpts -> IO(Response L.ByteString)
_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} =
  get (fullUrl clientOpts endpoint)
_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} =
  getSSL sslOpts (fullUrl clientOpts endpoint)

_dockerPostQuery :: ToJSON a => Endpoint -> DockerClientOpts -> a -> IO (Response L.ByteString)
_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} postObject =
  post (fullUrl clientOpts endpoint) (toJSON postObject)
_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} postObject =
  postSSL sslOpts (fullUrl clientOpts endpoint) postObject

emptyPost = "" :: String
_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost)

_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)
getDockerVersion = decodeResponse . _dockerGetQuery "/version"

getDockerContainers :: DockerClientOpts -> IO (Maybe [DockerContainer])
getDockerContainers = decodeResponse . _dockerGetQuery "/containers/json"

getDockerImages :: DockerClientOpts -> IO (Maybe [DockerImage])
getDockerImages = decodeResponse . _dockerGetQuery "/images/json"

createContainer :: DockerClientOpts -> CreateContainerOpts -> IO(Maybe T.Text)
createContainer clientOpts createOpts = getOutOfResponse "Id" <$> (_dockerPostQuery "/containers/create" clientOpts createOpts)

startContainer :: DockerClientOpts -> String -> StartContainerOpts -> IO(Status)
startContainer clientOpts containerId startOpts = (^. responseStatus) <$> _dockerPostQuery (printf "/containers/%s/start" containerId) clientOpts startOpts

stopContainer :: DockerClientOpts -> String -> IO (Status)
stopContainer  clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/stop" containerId) clientOpts

killContainer :: DockerClientOpts -> String -> IO (Status)
killContainer  clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/kill" containerId) clientOpts

restartContainer :: DockerClientOpts -> String -> IO (Status)
restartContainer  clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/restart" containerId) clientOpts

pauseContainer :: DockerClientOpts -> String -> IO (Status)
pauseContainer  clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/pause" containerId) clientOpts

unpauseContainer :: DockerClientOpts -> String -> IO (Status)
unpauseContainer  clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/unpause" containerId) clientOpts

deleteContainer :: DockerClientOpts -> String -> IO (Status)
deleteContainer = deleteContainerWithOpts defaultDeleteOpts

deleteContainerWithOpts :: DeleteOpts -> DockerClientOpts -> String -> IO (Status)
deleteContainerWithOpts (DeleteOpts removeVolumes force) clientOpts containerId = (^. responseStatus) <$> _dockerEmptyDeleteQuery req clientOpts
  where req = printf "/containers/%s?v=%s;force=%s" containerId (show removeVolumes) (show force)

getContainerLogsStream :: DockerClientOpts -> String -> IO ()
getContainerLogsStream  clientOpts containerId = do
                req <- PH.parseUrl (fullUrl clientOpts url)
                let req' =  req {PH.method = "GET"}
                PH.withManager PH.defaultManagerSettings $ \m  -> PH.withHTTP req' m  $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout
        where url = (printf "/containers/%s/logs?stdout=1&stderr=1&follow=1" containerId)

getContainerLogs :: DockerClientOpts -> String -> IO (L.ByteString)
getContainerLogs  clientOpts containerId = (^. responseBody) <$> _dockerGetQuery url clientOpts
        where url = (printf "/containers/%s/logs?stdout=1&stderr=1" containerId)