@@ -1,30 +1,70 @@
1+{-# LANGUAGE RankNTypes #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+
14module Docker.Http where
25
3−import Control.Monad.Except (ExceptT, runExceptT)
4−import Control.Monad.Reader (ReaderT, runReaderT)
5−import qualified Data.ByteString.Lazy as BL
6−import Data.Text as T
7−import Data.Text.Encoding (encodeUtf8)
8−import Network.HTTP.Client (defaultManagerSettings, httpLbs,
9− managerRawConnection, method, newManager,
10− parseUrl)
11−import qualified Network.HTTP.Client as HTTP
12−import Network.HTTP.Types (StdMethod)
6+import Control.Exception (catch, throw)
7+import Control.Monad.Except (ExceptT, runExceptT)
8+import Control.Monad.Reader (ReaderT, runReaderT)
9+import qualified Data.ByteString.Lazy as BL
10+import Data.Text as T
11+import Data.Text.Encoding (encodeUtf8)
12+import Network.HTTP.Client (defaultManagerSettings, httpLbs,
13+ managerRawConnection, method,
14+ newManager, parseUrl)
15+import qualified Network.HTTP.Client as HTTP
16+import Network.HTTP.Types (StdMethod)
17+
18+-- import Control.Monad.Except (ExceptT, MonadError, MonadError,
19+-- catchError, lift, runExceptT,
20+-- throwError, throwError)
21+import Control.Applicative
22+import Control.Exception (catch, try)
23+import Control.Monad.Except
24+import Control.Monad.IO.Class (liftIO)
25+-- import Control.Monad.Reader (ReaderT, runReaderT)
26+-- import Control.Monad.Reader.Class (MonadReader)
27+import Control.Monad.Reader
28+import Control.Monad.Reader.Class
29+import Control.Monad.Trans.Except
30+import qualified Data.ByteString.Lazy as BL
31+import Data.Text as T
32+import Data.Text.Encoding (encodeUtf8)
33+import Data.Typeable (Typeable)
34+import Network.HTTP.Client (defaultManagerSettings, httpLbs,
35+ method, newManager, parseUrl)
36+import qualified Network.HTTP.Client as HTTP
37+import Network.HTTP.Types (StdMethod)
38+import System.IO.Error (catchIOError, ioError)
1339
14−import Docker.Internal (getEndpoint)
15−import Docker.Types (DockerClientOpts, Endpoint, baseUrl)
40+import Docker.Internal (getEndpoint)
41+import Docker.Types (DockerClientOpts, Endpoint,
42+ baseUrl)
1643
1744type Request = HTTP.Request
1845type Response = HTTP.Response BL.ByteString
1946type HttpVerb = StdMethod
20−type HttpHandler m = Request -> m Response
47+type HttpHandler m = Request -> m (Either DockerError Response)
48+
49+data DockerError = DockerConnectionError
50+ | GenericDockerError Text deriving (Eq, Show, Typeable)
51+
52+newtype DockerT m a = DockerT {
53+ unDockerT :: Monad m => ReaderT (DockerClientOpts, HttpHandler m) m a
54+ } deriving (Functor) -- Applicative, Monad, MonadReader, MonadError, MonadTrans
2155
22−type DockerT m a = ReaderT (DockerClientOpts, HttpHandler m) (ExceptT String m) a
2356
24−runDockerT :: Monad m => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m (Either String a)
25−runDockerT (opts, h) r = runExceptT $ runReaderT r (opts, h)
57+-- instance Applicative m => Applicative (DockerT m) where
58+-- pure a = DockerT $ pure a
59+-- (<*>) (DockerT f) (DockerT v) = DockerT $ f <*> v
2660
2761
62+-- type DockerT m a = ReaderT (DockerClientOpts, HttpHandler m) (ExceptT DockerError m) a
63+
64+-- runDockerT :: forall m a. Monad m => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m (Either DockerError a)
65+runDockerT :: Monad m => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m a
66+runDockerT (opts, h) r = runReaderT (unDockerT r) (opts, h)
67+
2868-- The reason we return Maybe Request is because the parseURL function
2969-- might find out parameters are invalid and will fail to build a Request
3070-- Since we are the ones building the Requests this shouldn't happen, but would
@@ -39,11 +79,21 @@ mkHttpRequest verb e opts = request
3979 -- TODO: manager = newManager defaultManagerSettings -- We likely need
4080 -- this for TLS.
4181
82+-- mapHttpToDocker :: HTTP.HttpException -> DockerError
83+-- mapHttpToDocker e = case e of
84+-- HTTP.FailedConnectionException{} -> DockerConnectionError
85+-- HTTP.FailedConnectionException2{} -> DockerConnectionError
86+-- otherwise -> GenericDockerError "dinamo"
87+
4288defaultHttpHandler :: HttpHandler IO
4389defaultHttpHandler request = do
44− manager <- newManager defaultManagerSettings
45− response <- httpLbs request manager
46− return response
90+ manager <- newManager defaultManagerSettings
91+ -- either mapHttpToDocker id <$> try httpLbs request manager
92+ try (httpLbs request manager) >>= \res -> case res of
93+ Right res -> return $ Right res
94+ Left HTTP.FailedConnectionException{} -> return $ Left DockerConnectionError
95+ Left HTTP.FailedConnectionException2{} -> return $ Left DockerConnectionError
96+ Left e -> return $ Left $ GenericDockerError (T.pack $ show e)
4797
4898-- | Connect to a unix domain socket (the default docker socket is
4999-- at \/var\/run\/docker.sock)