git.iko.soy/docker-hs
on 201fe06 help sign in
docker-hs/src/Docker/Client/Internal.hs
73 lines 4.2 kB history raw
1module Docker.Client.Internal where
4import Blaze.ByteString.Builder (toByteString)
5import qualified Data.Aeson as JSON
6import Data.ByteString (ByteString)
7import qualified Data.ByteString.Lazy as BSL
8import Data.Text as T
9import Data.Text.Encoding (decodeUtf8, encodeUtf8)
10import Network.HTTP.Types (Query, encodePath,
11 encodePathSegments)
13import Docker.Client.Types
16encodeURL :: [T.Text] -> T.Text
17encodeURL ps = decodeUtf8 $ toByteString $ encodePathSegments ps
19encodeURLWithQuery :: [T.Text] -> Query -> T.Text
20encodeURLWithQuery ps q = decodeUtf8 $ toByteString $ encodePath ps q
22encodeQ :: String -> ByteString
23encodeQ = encodeUtf8 . T.pack
25getEndpoint :: Endpoint -> T.Text
26getEndpoint VersionEndpoint = encodeURL ["version"]
27getEndpoint (ListContainersEndpoint _) = encodeURL ["containers", "json"] -- Make use of lsOpts here
28getEndpoint (ListImagesEndpoint _) = encodeURL ["images", "json"] -- Make use of lsOpts here
29getEndpoint (CreateContainerEndpoint _) = encodeURL ["containers", "create"]
30getEndpoint (StartContainerEndpoint startOpts cid) = encodeURLWithQuery ["containers", fromContainerID cid, "start"] query
31 where query = case (detachKeys startOpts) of
32 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]
33 WithoutCtrl c -> [("detachKeys", Just (encodeQ [c]))]
34 DefaultDetachKey -> []
35 ctrl = ['c', 't', 'r', 'l', '-']
36getEndpoint (StopContainerEndpoint t cid) = encodeURLWithQuery ["containers", fromContainerID cid, "stop"] query
37 where query = case t of
38 Timeout x -> [("t", Just (encodeQ $ show x))]
39 DefaultTimeout -> []
40getEndpoint (KillContainerEndpoint s cid) = encodeURLWithQuery ["containers", fromContainerID cid, "kill"] query
41 where query = case s of
42 SIG x -> [("signal", Just (encodeQ $ show x))]
43 _ -> [("signal", Just (encodeQ $ show s))]
44getEndpoint (RestartContainerEndpoint t cid) = encodeURLWithQuery ["containers", fromContainerID cid, "restart"] query
45 where query = case t of
46 Timeout x -> [("t", Just (encodeQ $ show x))]
47 DefaultTimeout -> []
48getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "pause"]
49getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "unpause"]
50-- Make use of since/timestamps/tail logopts here instead of ignoreing them
51getEndpoint (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =
52 encodeURLWithQuery ["containers", fromContainerID cid, "logs"] query
53 where query = [("stdout", Just (encodeQ $ show stdout)), ("stderr", Just (encodeQ $ show stderr)), ("follow", Just (encodeQ $ show follow))]
54getEndpoint (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =
55 encodeURLWithQuery ["containers", fromContainerID cid] query
56 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]
57getEndpoint (InspectContainerEndpoint cid) =
58 encodeURLWithQuery ["containers", fromContainerID cid, "json"] []
60getEndpointRequestBody :: Endpoint -> Maybe BSL.ByteString
61getEndpointRequestBody VersionEndpoint = Nothing
62getEndpointRequestBody (ListContainersEndpoint _) = Nothing
63getEndpointRequestBody (ListImagesEndpoint _) = Nothing
64getEndpointRequestBody (CreateContainerEndpoint opts) = Just $ JSON.encode opts
65getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing
66getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing
67getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing
68getEndpointRequestBody (RestartContainerEndpoint _ _) = Nothing
69getEndpointRequestBody (PauseContainerEndpoint _) = Nothing
70getEndpointRequestBody (UnpauseContainerEndpoint _) = Nothing
71getEndpointRequestBody (ContainerLogsEndpoint _ _ _) = Nothing
72getEndpointRequestBody (DeleteContainerEndpoint _ _) = Nothing
73getEndpointRequestBody (InspectContainerEndpoint _) = Nothing