@@ -1,4 +1,5 @@
11{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE OverloadedStrings #-}
34{-# LANGUAGE TypeFamilies #-}
45
@@ -7,6 +8,7 @@ module Network.Docker where
78import Control.Applicative ((<$>), (<*>))
89import Control.Lens
910import Control.Monad.Free
11+import Control.Monad.Reader (ask)
1012import Data.Aeson (FromJSON, ToJSON, Value, decode,
1113 eitherDecode, toJSON)
1214import Data.Aeson.Lens (key, _String)
@@ -23,65 +25,81 @@ import Text.Printf (printf)
2325import Network.Docker.Internal
2426import Network.Docker.Types
2527
26−getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)
27−getDockerVersion clientOpts = decodeResponse <$>
28− runDocker (getDockerVersionM clientOpts SVersionEndpoint)
29−
30−listContainers :: DockerClientOpts -> IO (Maybe [DockerContainer])
31−listContainers clientOpts = decodeResponse <$>
32− runDocker (listContainersM clientOpts SListContainersEndpoint)
33−
34−listImages :: DockerClientOpts -> IO (Maybe [DockerImage])
35−listImages clientOpts = decodeResponse <$>
36− runDocker (listImagesM clientOpts SListImagesEndpoint)
37−
38−createContainer :: DockerClientOpts -> CreateContainerOpts -> IO(Maybe T.Text)
39−createContainer clientOpts createOpts = getElemFromResponse "Id" <$>
40− runDocker (createContainerM clientOpts (SCreateContainerEndpoint) createOpts)
41−
42−startContainer :: DockerClientOpts -> String -> StartContainerOpts -> IO(Status)
43−startContainer clientOpts cid startOpts = (^. responseStatus) <$>
44− runDocker (startContainerM clientOpts (SStartContainerEndpoint cid) startOpts)
45−
46−stopContainer :: DockerClientOpts -> String -> IO (Status)
47−stopContainer clientOpts cid = (^. responseStatus) <$>
48− runDocker (stopContainerM clientOpts (SStopContainerEndpoint cid))
49−
50−killContainer :: DockerClientOpts -> String -> IO (Status)
51−killContainer clientOpts cid = (^. responseStatus) <$>
52− runDocker (killContainerM clientOpts (SKillContainerEndpoint cid))
53−
54−restartContainer :: DockerClientOpts -> String -> IO (Status)
55−restartContainer clientOpts cid = (^. responseStatus) <$>
56− runDocker (restartContainerM clientOpts (SRestartContainerEndpoint cid))
57−
58−pauseContainer :: DockerClientOpts -> String -> IO (Status)
59−pauseContainer clientOpts cid = (^. responseStatus) <$>
60− runDocker (pauseContainerM clientOpts (SPauseContainerEndpoint cid))
61−
62−unpauseContainer :: DockerClientOpts -> String -> IO (Status)
63−unpauseContainer clientOpts cid = (^. responseStatus) <$>
64− runDocker (unpauseContainerM clientOpts (SUnpauseContainerEndpoint cid))
65−
66−deleteContainer :: DockerClientOpts -> String -> IO (Status)
67−deleteContainer c cid = deleteContainerWithOpts c defaultDeleteOpts cid
68−
69−deleteContainerWithOpts :: DockerClientOpts -> DeleteOpts -> String -> IO (Status)
70−deleteContainerWithOpts clientOpts deleteOpts cid = (^. responseStatus) <$>
71− runDocker (deleteContainerM clientOpts (SDeleteContainerEndpoint cid deleteOpts))
72−
73−getContainerLogsWithOpts :: DockerClientOpts -> LogOpts -> String -> IO (L.ByteString)
74−getContainerLogsWithOpts clientOpts l cid = (^. responseBody) <$>
75− runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid l))
76−
77−getContainerLogs :: DockerClientOpts -> String -> IO (L.ByteString)
78−getContainerLogs clientOpts cid = (^. responseBody) <$>
79− runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid defaultLogOpts))
80−
81−getContainerLogsStream :: DockerClientOpts -> String -> IO ()
82−getContainerLogsStream clientOpts cid = do
83− req <- PH.parseUrl (fullUrl clientOpts url)
84− let req' = req {PH.method = "GET"}
85− PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout
86− where url = SContainerLogsEndpoint cid defaultLogOpts{follow=True}
28+getDockerVersion :: DockerM IO (Maybe DockerVersion)
29+getDockerVersion = do
30+ clientOpts <- ask
31+ decodeResponse <$> runDocker (getDockerVersionM clientOpts SVersionEndpoint)
32+
33+listContainers :: DockerM IO (Maybe [DockerContainer])
34+listContainers = do
35+ clientOpts <- ask
36+ decodeResponse <$> runDocker (listContainersM clientOpts SListContainersEndpoint)
37+
38+listImages :: DockerM IO (Maybe [DockerImage])
39+listImages = do
40+ clientOpts <- ask
41+ decodeResponse <$> runDocker (listImagesM clientOpts SListImagesEndpoint)
42+
43+createContainer :: CreateContainerOpts -> DockerM IO (Maybe T.Text)
44+createContainer createOpts = do
45+ clientOpts <- ask
46+ getElemFromResponse "Id" <$> runDocker (createContainerM clientOpts (SCreateContainerEndpoint) createOpts)
47+
48+startContainer :: String -> StartContainerOpts -> DockerM IO (Status)
49+startContainer cid startOpts = do
50+ clientOpts <- ask
51+ (^. responseStatus) <$> runDocker (startContainerM clientOpts (SStartContainerEndpoint cid) startOpts)
52+
53+stopContainer :: String -> DockerM IO (Status)
54+stopContainer cid = do
55+ clientOpts <- ask
56+ (^. responseStatus) <$> runDocker (stopContainerM clientOpts (SStopContainerEndpoint cid))
57+
58+killContainer :: String -> DockerM IO (Status)
59+killContainer cid = do
60+ clientOpts <- ask
61+ (^. responseStatus) <$> runDocker (killContainerM clientOpts (SKillContainerEndpoint cid))
62+
63+restartContainer :: String -> DockerM IO (Status)
64+restartContainer cid = do
65+ clientOpts <- ask
66+ (^. responseStatus) <$> runDocker (restartContainerM clientOpts (SRestartContainerEndpoint cid))
67+
68+pauseContainer :: String -> DockerM IO (Status)
69+pauseContainer cid = do
70+ clientOpts <- ask
71+ (^. responseStatus) <$> runDocker (pauseContainerM clientOpts (SPauseContainerEndpoint cid))
72+
73+unpauseContainer :: String -> DockerM IO (Status)
74+unpauseContainer cid = do
75+ clientOpts <- ask
76+ (^. responseStatus) <$> runDocker (unpauseContainerM clientOpts (SUnpauseContainerEndpoint cid))
77+
78+deleteContainer :: String -> DockerM IO (Status)
79+deleteContainer cid = do
80+ c <- ask
81+ deleteContainerWithOpts defaultDeleteOpts cid
82+
83+deleteContainerWithOpts :: DeleteOpts -> String -> DockerM IO (Status)
84+deleteContainerWithOpts deleteOpts cid = do
85+ clientOpts <- ask
86+ (^. responseStatus) <$> runDocker (deleteContainerM clientOpts (SDeleteContainerEndpoint cid deleteOpts))
87+
88+getContainerLogsWithOpts :: LogOpts -> String -> DockerM IO (L.ByteString)
89+getContainerLogsWithOpts l cid = do
90+ clientOpts <- ask
91+ (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid l))
92+
93+getContainerLogs :: String -> DockerM IO (L.ByteString)
94+getContainerLogs cid = do
95+ clientOpts <- ask
96+ (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid defaultLogOpts))
97+
98+getContainerLogsStream :: String -> DockerM IO ()
99+getContainerLogsStream cid = do
100+ clientOpts <- ask
101+ req <- PH.parseUrl (fullUrl clientOpts url)
102+ let req' = req {PH.method = "GET"}
103+ liftIO $ PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout
104+ where url = SContainerLogsEndpoint cid defaultLogOpts{follow=True}
87105