@@ -1,6 +1,9 @@
1+{-# LANGUAGE ExplicitForAll #-}
1module Docker where
3module Docker where
3import Control.Applicative ((<$>), (<*>))
5import Control.Applicative ((<$>), (<*>))
6+import Control.Monad.Catch
4import Control.Monad.Except (catchError, throwError)
7import Control.Monad.Except (catchError, throwError)
5import Control.Monad.IO.Class (MonadIO, liftIO)
8import Control.Monad.IO.Class (MonadIO, liftIO)
6import Control.Monad.Reader (ask)
9import Control.Monad.Reader (ask)
@@ -13,85 +16,85 @@ import Network.HTTP.Types (StdMethod (..))
13import Docker.Internal
16import Docker.Internal
14import Docker.Types
17import Docker.Types
16−getDockerVersion :: DockerT IO DockerVersion
19+getDockerVersion :: forall m a. MonadThrow m => DockerT m DockerVersion
17getDockerVersion = do
20getDockerVersion = do
18 (opts, httpHandler) <- ask
21 (opts, httpHandler) <- ask
19 let request = fromJust $ mkHttpRequest GET VersionEndpoint opts
22 let request = fromJust $ mkHttpRequest GET VersionEndpoint opts
20− response <- liftIO $ httpHandler request
23+ response <- lift $ ((httpHandler request) :: m Response)
21 let body = responseBody response
24 let body = responseBody response
22 let res = decode body
25 let res = decode body
23 return $ fromJust res
26 return $ fromJust res
25−listContainers :: ListOpts -> DockerT IO [Container]
28+listContainers :: forall m a. MonadThrow m => ListOpts -> DockerT m [Container]
26listContainers lopts = do
29listContainers lopts = do
27 (opts, httpHandler) <- ask
30 (opts, httpHandler) <- ask
28 let request = fromJust $ mkHttpRequest GET (ListContainersEndpoint lopts) opts
31 let request = fromJust $ mkHttpRequest GET (ListContainersEndpoint lopts) opts
29− response <- liftIO $ httpHandler request
32+ response <- lift $ httpHandler request
30 let body = responseBody response
33 let body = responseBody response
31 let res = decode body
34 let res = decode body
32 return $ fromJust res
35 return $ fromJust res
34−listImages :: ListOpts -> DockerT IO [Image]
37+listImages :: forall m a. MonadThrow m => ListOpts -> DockerT m [Image]
35listImages lopts = do
38listImages lopts = do
36 (opts, httpHandler) <- ask
39 (opts, httpHandler) <- ask
37 let request = fromJust $ mkHttpRequest GET (ListImagesEndpoint lopts) opts
40 let request = fromJust $ mkHttpRequest GET (ListImagesEndpoint lopts) opts
38− response <- liftIO $ httpHandler request
41+ response <- lift $ ((httpHandler request) :: m Response)
39 let body = responseBody response
42 let body = responseBody response
40 let res = decode body
43 let res = decode body
41 return $ fromJust res
44 return $ fromJust res
43−createContainer :: CreateOpts -> DockerT IO ContainerID
46+createContainer :: forall m a. MonadThrow m => CreateOpts -> DockerT m ContainerID
44createContainer = undefined
47createContainer = undefined
46−startContainer :: StartOpts -> ContainerID -> DockerT IO ContainerID
49+startContainer :: forall m a. MonadThrow m => StartOpts -> ContainerID -> DockerT m ContainerID
47startContainer sopts cid = do
50startContainer sopts cid = do
48 (opts, httpHandler) <- ask
51 (opts, httpHandler) <- ask
49 let request = fromJust $ mkHttpRequest POST (StartContainerEndpoint sopts cid) opts
52 let request = fromJust $ mkHttpRequest POST (StartContainerEndpoint sopts cid) opts
50− _ <- liftIO $ httpHandler request
53+ _ <- lift $ ((httpHandler request) :: m Response)
51 return cid
54 return cid
53−stopContainer :: Timeout -> ContainerID ->DockerT IO ContainerID
56+stopContainer :: forall m a. MonadThrow m => Timeout -> ContainerID ->DockerT m ContainerID
54stopContainer t cid = do
57stopContainer t cid = do
55 (opts, httpHandler) <- ask
58 (opts, httpHandler) <- ask
56 let request = fromJust $ mkHttpRequest POST (StopContainerEndpoint t cid) opts
59 let request = fromJust $ mkHttpRequest POST (StopContainerEndpoint t cid) opts
57− _ <- liftIO $ httpHandler request
60+ _ <- lift $ ((httpHandler request) :: m Response)
58 return cid
61 return cid
60−killContainer :: Signal -> ContainerID -> DockerT IO ContainerID
63+killContainer :: forall m a. MonadThrow m => Signal -> ContainerID -> DockerT m ContainerID
61killContainer s cid = do
64killContainer s cid = do
62 (opts, httpHandler) <- ask
65 (opts, httpHandler) <- ask
63 let request = fromJust $ mkHttpRequest POST (KillContainerEndpoint s cid) opts
66 let request = fromJust $ mkHttpRequest POST (KillContainerEndpoint s cid) opts
64− _ <- liftIO $ httpHandler request
67+ _ <- lift $ ((httpHandler request) :: m Response)
65 return cid
68 return cid
67−restartContainer :: Timeout -> ContainerID -> DockerT IO ContainerID
70+restartContainer :: forall m a. MonadThrow m => Timeout -> ContainerID -> DockerT m ContainerID
68restartContainer t cid = do
71restartContainer t cid = do
69 (opts, httpHandler) <- ask
72 (opts, httpHandler) <- ask
70 let request = fromJust $ mkHttpRequest POST (RestartContainerEndpoint t cid) opts
73 let request = fromJust $ mkHttpRequest POST (RestartContainerEndpoint t cid) opts
71− _ <- liftIO $ httpHandler request
74+ _ <- lift $ ((httpHandler request) :: m Response)
72 return cid
75 return cid
74−pauseContainer :: ContainerID -> DockerT IO ContainerID
77+pauseContainer :: forall m a. MonadThrow m => ContainerID -> DockerT m ContainerID
75pauseContainer cid = do
78pauseContainer cid = do
76 (opts, httpHandler) <- ask
79 (opts, httpHandler) <- ask
77 let request = fromJust $ mkHttpRequest POST (PauseContainerEndpoint cid) opts
80 let request = fromJust $ mkHttpRequest POST (PauseContainerEndpoint cid) opts
78− _ <- liftIO $ httpHandler request
81+ _ <- lift $ ((httpHandler request) :: m Response)
79 return cid
82 return cid
81−unpauseContainer :: ContainerID -> DockerT IO ContainerID
84+unpauseContainer :: forall m a. MonadThrow m => ContainerID -> DockerT m ContainerID
82unpauseContainer cid = do
85unpauseContainer cid = do
83 (opts, httpHandler) <- ask
86 (opts, httpHandler) <- ask
84 let request = fromJust $ mkHttpRequest GET (UnpauseContainerEndpoint cid) opts
87 let request = fromJust $ mkHttpRequest GET (UnpauseContainerEndpoint cid) opts
85− _ <- liftIO $ httpHandler request
88+ _ <- lift $ ((httpHandler request) :: m Response)
86 return cid
89 return cid
88−deleteContainer :: DeleteOpts -> ContainerID -> DockerT IO ContainerID
91+deleteContainer :: forall m a. MonadThrow m => DeleteOpts -> ContainerID -> DockerT m ContainerID
89deleteContainer dopts cid = do
92deleteContainer dopts cid = do
90 (opts, httpHandler) <- ask
93 (opts, httpHandler) <- ask
91 let request = fromJust $ mkHttpRequest DELETE (DeleteContainerEndpoint dopts cid) opts
94 let request = fromJust $ mkHttpRequest DELETE (DeleteContainerEndpoint dopts cid) opts
92− _ <- liftIO $ httpHandler request
95+ _ <- lift $ ((httpHandler request) :: m Response)
93 return cid
96 return cid
95−getContainerLogs :: LogOpts -> ContainerID -> DockerT IO ()
98+getContainerLogs :: forall m a. MonadThrow m => LogOpts -> ContainerID -> DockerT m ()
96getContainerLogs = undefined
99getContainerLogs = undefined