module Docker.Client.Internal where

import           Blaze.ByteString.Builder (toByteString)
import qualified Data.Aeson               as JSON
import           Data.ByteString          (ByteString)
import qualified Data.ByteString.Char8    as BSC
import qualified Data.Conduit.Binary      as CB
import qualified Data.Text                as T
import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
import qualified Network.HTTP.Client      as HTTP
import           Network.HTTP.Conduit     (requestBodySourceChunked)
import           Network.HTTP.Types       (Query, encodePath,
                                           encodePathSegments)
import           Prelude                  hiding (all)

import           Docker.Client.Types


encodeURL :: [T.Text] -> T.Text
encodeURL :: [Text] -> Text
encodeURL [Text]
ps = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Builder
encodePathSegments [Text]
ps

encodeURLWithQuery :: [T.Text] -> Query -> T.Text
encodeURLWithQuery :: [Text] -> Query -> Text
encodeURLWithQuery [Text]
ps Query
q = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Query -> Builder
encodePath [Text]
ps Query
q

encodeQ :: String -> ByteString
encodeQ :: String -> ByteString
encodeQ = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

getEndpoint :: ApiVersion -> Endpoint -> T.Text
getEndpoint :: Text -> Endpoint -> Text
getEndpoint Text
v Endpoint
VersionEndpoint = [Text] -> Text
encodeURL [Text
v, Text
"version"]
getEndpoint Text
v (ListContainersEndpoint (ListOpts Bool
all)) = [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", Text
"json"] [(ByteString
"all", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
all))]
getEndpoint Text
v (ListImagesEndpoint ListOpts
_) = [Text] -> Text
encodeURL [Text
v, Text
"images", Text
"json"] -- Make use of lsOpts here
getEndpoint Text
v (CreateContainerEndpoint CreateOpts
_ Maybe Text
cn) = case Maybe Text
cn of
        Just Text
cn -> [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", Text
"create"] [(ByteString
"name", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
cn))]
        Maybe Text
Nothing -> [Text] -> Text
encodeURL [Text
v, Text
"containers", Text
"create"]
getEndpoint Text
v (StartContainerEndpoint StartOpts
startOpts ContainerID
cid) = [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"start"] Query
query
        where query :: Query
query = case (StartOpts -> DetachKeys
detachKeys StartOpts
startOpts) of
                WithCtrl Char
c -> [(ByteString
"detachKeys", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
ctrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]))]
                WithoutCtrl Char
c -> [(ByteString
"detachKeys", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ [Char
c]))]
                DetachKeys
DefaultDetachKey -> []
              ctrl :: String
ctrl = [Char
'c', Char
't', Char
'r', Char
'l', Char
'-']
getEndpoint Text
v (StopContainerEndpoint Timeout
t ContainerID
cid) = [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"stop"] Query
query
        where query :: Query
query = case Timeout
t of
                Timeout Integer
x      -> [(ByteString
"t", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
x))]
                Timeout
DefaultTimeout -> []
getEndpoint Text
v (WaitContainerEndpoint ContainerID
cid) = [Text] -> Text
encodeURL [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"wait"]
getEndpoint Text
v (KillContainerEndpoint Signal
s ContainerID
cid) = [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"kill"] Query
query
        where query :: Query
query = case Signal
s of
                SIG Integer
x -> [(ByteString
"signal", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
x))]
                Signal
_     -> [(ByteString
"signal", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Signal -> String
forall a. Show a => a -> String
show Signal
s))]
getEndpoint Text
v (RestartContainerEndpoint Timeout
t ContainerID
cid) = [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"restart"] Query
query
        where query :: Query
query = case Timeout
t of
                Timeout Integer
x      -> [(ByteString
"t", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
x))]
                Timeout
DefaultTimeout -> []
getEndpoint Text
v (PauseContainerEndpoint ContainerID
cid) = [Text] -> Text
encodeURL [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"pause"]
getEndpoint Text
v (UnpauseContainerEndpoint ContainerID
cid) = [Text] -> Text
encodeURL [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"unpause"]
-- Make use of since/timestamps/tail logopts here instead of ignoreing them
getEndpoint Text
v (ContainerLogsEndpoint (LogOpts Bool
stdout Bool
stderr Maybe Integer
_ Bool
_ TailLogOpt
_) Bool
follow ContainerID
cid) =
            [Text] -> Query -> Text
encodeURLWithQuery    [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"logs"] Query
query
        where query :: Query
query = [(ByteString
"stdout", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
stdout)), (ByteString
"stderr", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
stderr)), (ByteString
"follow", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
follow))]
getEndpoint Text
v (DeleteContainerEndpoint (ContainerDeleteOpts Bool
removeVolumes Bool
force) ContainerID
cid) =
            [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid] Query
query
        where query :: Query
query = [(ByteString
"v", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
removeVolumes)), (ByteString
"force", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
force))]
getEndpoint Text
v (InspectContainerEndpoint ContainerID
cid) =
            [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"containers", ContainerID -> Text
fromContainerID ContainerID
cid, Text
"json"] []
getEndpoint Text
v (BuildImageEndpoint BuildOpts
o String
_) = [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"build"] Query
query
        where query :: Query
query = [(ByteString
"t", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
t), (ByteString
"dockerfile", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
dockerfile), (ByteString
"q", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
q), (ByteString
"nocache", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
nocache), (ByteString
"rm", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
rm), (ByteString
"forcerm", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
forcerm), (ByteString
"pull", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
pull)]
              t :: ByteString
t = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Text
buildImageName BuildOpts
o
              dockerfile :: ByteString
dockerfile = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Text
buildDockerfileName BuildOpts
o
              q :: ByteString
q = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
buildQuiet BuildOpts
o
              nocache :: ByteString
nocache = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
buildNoCache BuildOpts
o
              rm :: ByteString
rm = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
buildRemoveItermediate BuildOpts
o
              forcerm :: ByteString
forcerm = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
buildForceRemoveIntermediate BuildOpts
o
              pull :: ByteString
pull = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
buildPullParent BuildOpts
o
getEndpoint Text
v (CreateImageEndpoint Text
name Text
tag Maybe Text
_) = [Text] -> Query -> Text
encodeURLWithQuery [Text
v, Text
"images", Text
"create"] Query
query
        where query :: Query
query = [(ByteString
"fromImage", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
n), (ByteString
"tag", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
t)]
              n :: ByteString
n = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
name
              t :: ByteString
t = String -> ByteString
encodeQ (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
tag
getEndpoint Text
v (DeleteImageEndpoint ImageDeleteOpts
_ ImageID
cid) = [Text] -> Text
encodeURL [Text
v, Text
"images", ImageID -> Text
fromImageID ImageID
cid]
getEndpoint Text
v (CreateNetworkEndpoint CreateNetworkOpts
_) = [Text] -> Text
encodeURL [Text
v, Text
"networks", Text
"create"]
getEndpoint Text
v (RemoveNetworkEndpoint NetworkID
nid) = [Text] -> Text
encodeURL [Text
v, Text
"networks", NetworkID -> Text
fromNetworkID NetworkID
nid]

getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
getEndpointRequestBody :: Endpoint -> Maybe RequestBody
getEndpointRequestBody Endpoint
VersionEndpoint = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (ListContainersEndpoint ListOpts
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (ListImagesEndpoint ListOpts
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (CreateContainerEndpoint CreateOpts
opts Maybe Text
_) = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just (RequestBody -> Maybe RequestBody)
-> RequestBody -> Maybe RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
HTTP.RequestBodyLBS (CreateOpts -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode CreateOpts
opts)
getEndpointRequestBody (StartContainerEndpoint StartOpts
_ ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (StopContainerEndpoint Timeout
_ ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (WaitContainerEndpoint ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (KillContainerEndpoint Signal
_ ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (RestartContainerEndpoint Timeout
_ ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (PauseContainerEndpoint ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (UnpauseContainerEndpoint ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (ContainerLogsEndpoint LogOpts
_ Bool
_ ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (DeleteContainerEndpoint ContainerDeleteOpts
_ ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (InspectContainerEndpoint ContainerID
_) = Maybe RequestBody
forall a. Maybe a
Nothing

getEndpointRequestBody (BuildImageEndpoint BuildOpts
_ String
fp) = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just (RequestBody -> Maybe RequestBody)
-> RequestBody -> Maybe RequestBody
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString (ResourceT IO) () -> RequestBody
requestBodySourceChunked (ConduitM () ByteString (ResourceT IO) () -> RequestBody)
-> ConduitM () ByteString (ResourceT IO) () -> RequestBody
forall a b. (a -> b) -> a -> b
$ String -> ConduitM () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
CB.sourceFile String
fp
getEndpointRequestBody (CreateImageEndpoint Text
_ Text
_ Maybe Text
_) = Maybe RequestBody
forall a. Maybe a
Nothing
getEndpointRequestBody (DeleteImageEndpoint ImageDeleteOpts
_ ImageID
_) = Maybe RequestBody
forall a. Maybe a
Nothing

getEndpointRequestBody (CreateNetworkEndpoint CreateNetworkOpts
opts) = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just (RequestBody -> Maybe RequestBody)
-> RequestBody -> Maybe RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
HTTP.RequestBodyLBS (CreateNetworkOpts -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode CreateNetworkOpts
opts)
getEndpointRequestBody (RemoveNetworkEndpoint NetworkID
_) = Maybe RequestBody
forall a. Maybe a
Nothing

getEndpointContentType :: Endpoint -> BSC.ByteString
getEndpointContentType :: Endpoint -> ByteString
getEndpointContentType (BuildImageEndpoint BuildOpts
_ String
_) = String -> ByteString
BSC.pack String
"application/tar"
getEndpointContentType Endpoint
_ = String -> ByteString
BSC.pack String
"application/json; charset=utf-8"

#if MIN_VERSION_http_client(0,5,0)
getEndpointTimeout :: Endpoint -> HTTP.ResponseTimeout
getEndpointTimeout :: Endpoint -> ResponseTimeout
getEndpointTimeout (WaitContainerEndpoint ContainerID
_) = ResponseTimeout
HTTP.responseTimeoutNone
getEndpointTimeout Endpoint
_ = ResponseTimeout
HTTP.responseTimeoutDefault
#else
-- Prior to version 0.5.0 of `http-client`, `ResponseTimeout` does not exist
-- and we can't easily say "use the manager setting" here. So this is a bit
-- ugly and only exists for the sake of backwards compatibility.
getEndpointTimeout :: Endpoint -> Maybe Int
getEndpointTimeout (WaitContainerEndpoint _) = Nothing
getEndpointTimeout _ = Just 30000000
#endif