on f3e8cc8 help sign in
docker-hs/src/Docker/Internal.hs
60 lines 3.1 kB history raw
1module Docker.Internal where
4import Blaze.ByteString.Builder (toByteString)
5import Data.ByteString as BS
6import Data.ByteString (ByteString)
7import Data.Maybe
8import Data.Text as T
9import Data.Text (Text)
10import Data.Text.Encoding (decodeUtf8, encodeUtf8)
11import qualified Network.HTTP.Client as HTTP
12import Network.HTTP.Types (Query, encodePath,
13 encodePathSegments)
15import Docker.Types
17-- The reason we return Maybe Request is because the parseURL function
18-- might find out parameters are invalid and will fail to build a Request
19-- Since we're building the Requests this shouldn't happen, but would
20-- benefit from testing that for instance all of our Endpoints are solid
21-- and so on.
22mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
23mkHttpRequest verb e opts = request
24 where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint e)
25 initialR = HTTP.parseUrl fullE
26 request = case initialR of
27 Just ir -> return $ ir { HTTP.method = (encodeUtf8 . T.pack $ show verb) } -- , requestBody = RequestBodyLBS $ encode requestObject }
28 Nothing -> Nothing
29 -- TODO: manager = newManager defaultManagerSettings -- We likely need
30 -- this for TLS.
32defaultHandler :: Request -> IO Response
33defaultHandler = undefined
35encodeURL :: [Text] -> Text
36encodeURL ps = decodeUtf8 $ toByteString $ encodePathSegments ps
38encodeURLWithQuery :: [Text] -> Query -> Text
39encodeURLWithQuery ps q = decodeUtf8 $ toByteString $ encodePath ps q
41encodeQ = encodeUtf8 . T.pack . show
43getEndpoint :: Endpoint -> Text
44getEndpoint VersionEndpoint = encodeURL ["version"]
45getEndpoint (ListContainersEndpoint lsOpts) = encodeURL ["containers", "json"]
46getEndpoint (ListImagesEndpoint lsOpts) = encodeURL ["images", "json"]
47getEndpoint CreateContainerEndpoint = encodeURL ["containers", "create"]
48getEndpoint (StartContainerEndpoint cid) = encodeURL ["containers", cid, "start"]
49getEndpoint (StopContainerEndpoint cid) = encodeURL ["containers", cid, "stop"]
50getEndpoint (KillContainerEndpoint cid) = encodeURL ["containers", cid, "kill"]
51getEndpoint (RestartContainerEndpoint cid) = encodeURL ["containers", cid, "restart"]
52getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", cid, "pause"]
53getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", cid, "unpause"]
54getEndpoint (ContainerLogsEndpoint cid (LogOpts follow stdout stderr since timestamps tail)) =
55 encodeURLWithQuery ["containers", cid, "logs"] query
56 where query = [("stdout", Just (encodeQ stdout)), ("stderr", Just (encodeQ stderr)), ("follow", Just (encodeQ follow))]
57getEndpoint (DeleteContainerEndpoint cid (DeleteOpts removeVolumes force)) =
58 encodeURLWithQuery ["containers", cid] query
59 where query = [("v", Just (encodeQ removeVolumes)), ("force", Just (encodeQ force))]