WIP: Adds ongoing work on refactoring the http client

Does not compile yet.

src/Docker.hs

@@ -17,9 +17,14 @@ getDockerVersion :: forall m. Monad m => DockerT m DockerVersion
 getDockerVersion = do
     (opts, httpHandler) <- ask
     let request = fromJust $ mkHttpRequest GET VersionEndpoint opts
-    response <- lift . lift $ (httpHandler request :: m Response)
-    let res = decode $ responseBody response
-    return $ fromJust res
+    response <- lift $ httpHandler request
+    -- let res = decode $ responseBody response
+    -- return $ fromJust res
+    case response of
+        Right r -> do
+            let res = decode $ responseBody r
+            fromJust res
+        Left err -> err
 
 listContainers :: forall m. Monad m => ListOpts -> DockerT m [Container]
 listContainers lopts = do

src/Docker/Http.hs

@@ -1,30 +1,70 @@
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Docker.Http where
 
-import           Control.Monad.Except (ExceptT, runExceptT)
-import           Control.Monad.Reader (ReaderT, runReaderT)
-import qualified Data.ByteString.Lazy as BL
-import           Data.Text            as T
-import           Data.Text.Encoding   (encodeUtf8)
-import           Network.HTTP.Client  (defaultManagerSettings, httpLbs,
-                                       managerRawConnection, method, newManager,
-                                       parseUrl)
-import qualified Network.HTTP.Client  as HTTP
-import           Network.HTTP.Types   (StdMethod)
+import           Control.Exception          (catch, throw)
+import           Control.Monad.Except       (ExceptT, runExceptT)
+import           Control.Monad.Reader       (ReaderT, runReaderT)
+import qualified Data.ByteString.Lazy       as BL
+import           Data.Text                  as T
+import           Data.Text.Encoding         (encodeUtf8)
+import           Network.HTTP.Client        (defaultManagerSettings, httpLbs,
+                                             managerRawConnection, method,
+                                             newManager, parseUrl)
+import qualified Network.HTTP.Client        as HTTP
+import           Network.HTTP.Types         (StdMethod)
 
-import           Docker.Internal      (getEndpoint)
-import           Docker.Types         (DockerClientOpts, Endpoint, baseUrl)
+-- import           Control.Monad.Except       (ExceptT, MonadError, MonadError,
+--                                              catchError, lift, runExceptT,
+--                                              throwError, throwError)
+import           Control.Applicative
+import           Control.Exception          (catch, try)
+import           Control.Monad.Except
+import           Control.Monad.IO.Class     (liftIO)
+-- import           Control.Monad.Reader       (ReaderT, runReaderT)
+-- import           Control.Monad.Reader.Class (MonadReader)
+import           Control.Monad.Reader
+import           Control.Monad.Reader.Class
+import           Control.Monad.Trans.Except
+import qualified Data.ByteString.Lazy       as BL
+import           Data.Text                  as T
+import           Data.Text.Encoding         (encodeUtf8)
+import           Data.Typeable              (Typeable)
+import           Network.HTTP.Client        (defaultManagerSettings, httpLbs,
+                                             method, newManager, parseUrl)
+import qualified Network.HTTP.Client        as HTTP
+import           Network.HTTP.Types         (StdMethod)
+import           System.IO.Error            (catchIOError, ioError)
+
+import           Docker.Internal            (getEndpoint)
+import           Docker.Types               (DockerClientOpts, Endpoint,
+                                             baseUrl)
 
 type Request = HTTP.Request
 type Response = HTTP.Response BL.ByteString
 type HttpVerb = StdMethod
-type HttpHandler m = Request -> m Response
+type HttpHandler m = Request -> m (Either DockerError Response)
 
-type DockerT m a = ReaderT (DockerClientOpts, HttpHandler m) (ExceptT String m) a
+data DockerError = DockerConnectionError
+                 | GenericDockerError Text deriving (Eq, Show, Typeable)
 
-runDockerT :: Monad m => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m (Either String a)
-runDockerT (opts, h) r = runExceptT $ runReaderT r (opts, h)
+newtype DockerT m a = DockerT {
+        unDockerT :: Monad m => ReaderT (DockerClientOpts, HttpHandler m) m a
+    } deriving (Functor) -- Applicative, Monad, MonadReader, MonadError, MonadTrans
 
 
+-- instance Applicative m => Applicative (DockerT m) where
+--     pure a = DockerT $ pure a
+--     (<*>) (DockerT f) (DockerT v) =  DockerT $ f <*> v
+
+
+-- type DockerT m a = ReaderT (DockerClientOpts, HttpHandler m) (ExceptT DockerError m) a
+
+-- runDockerT :: forall m a. Monad m => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m (Either DockerError a)
+runDockerT :: Monad m => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m a
+runDockerT (opts, h) r = runReaderT (unDockerT r) (opts, h)
+
 -- The reason we return Maybe Request is because the parseURL function
 -- might find out parameters are invalid and will fail to build a Request
 -- Since we are the ones building the Requests this shouldn't happen, but would
@@ -39,11 +79,21 @@ mkHttpRequest verb e opts = request
               -- TODO: manager = newManager defaultManagerSettings -- We likely need
               -- this for TLS.
 
+-- mapHttpToDocker :: HTTP.HttpException -> DockerError
+-- mapHttpToDocker e = case e of
+--     HTTP.FailedConnectionException{}  -> DockerConnectionError
+--     HTTP.FailedConnectionException2{} -> DockerConnectionError
+--     otherwise                         -> GenericDockerError "dinamo"
+
 defaultHttpHandler :: HttpHandler IO
 defaultHttpHandler request = do
-        manager <- newManager defaultManagerSettings
-        response <- httpLbs request manager
-        return response
+    manager <- newManager defaultManagerSettings
+    -- either mapHttpToDocker id <$> try httpLbs request manager
+    try (httpLbs request manager) >>= \res -> case res of
+        Right res                              -> return $ Right res
+        Left HTTP.FailedConnectionException{}  -> return $ Left DockerConnectionError
+        Left HTTP.FailedConnectionException2{} -> return $ Left DockerConnectionError
+        Left e                                 -> return $ Left $ GenericDockerError (T.pack $ show e)
 
 -- | Connect to a unix domain socket (the default docker socket is
 --   at \/var\/run\/docker.sock)