Bryan O'Sullivan avatar Bryan O'Sullivan committed 9f42abc

Make ErrorResponse an exception. Handle error responses properly.

Comments (0)

Files changed (3)

src/Network/Riak/Connection/Internal.hs

     ) where
 
 import Control.Concurrent
-import Control.Exception (IOException)
-import Control.Monad (forM_, replicateM, replicateM_, unless, when)
+import Control.Exception (Exception, IOException, throw)
+import Control.Monad (forM_, replicateM, replicateM_, unless)
 import Data.Binary.Put (Put, putWord32be, runPut)
 import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)
 import Data.Int (Int64)
 import Network.Riak.Debug (debug)
+import Network.Riak.Protocol.ErrorResponse
 import Network.Riak.Protocol.SetClientIDRequest
 import Network.Riak.Tag (getTag, putTag)
 import Network.Riak.Types.Internal hiding (MessageTag(..))
   putTag (messageTag req)
   messagePutM req
 
-getResponse :: (Response a) => T.MessageTag -> Get (Either String a)
+instance Exception ErrorResponse
+
+throwError :: ErrorResponse -> a
+throwError = throw
+
+getResponse :: (Response a) => T.MessageTag -> Get a
 getResponse expected = do
   tag <- getTag
-  if tag == expected
-    then Right `fmap` messageGetM
-    else return . Left $ "received unexpected response: expected " ++
-                         show expected ++ ", received " ++ show tag
+  case undefined of
+   _| tag == expected        -> messageGetM
+    | tag == T.ErrorResponse -> throwError `fmap` messageGetM
+    | otherwise ->
+        moduleError "getResponse" $ "received unexpected response: expected " ++
+                                    show expected ++ ", received " ++ show tag
 
 exchange :: Exchange req resp => Connection -> req -> IO resp
 exchange conn@Connection{..} req = do
   go :: Response b => b -> IO b
   go dummy = do
     len <- fromIntegral `fmap` recvGet conn getWord32be
-    r <- recvGetN conn len (getResponse (messageTag dummy))
-    case r of
-      Left err  -> moduleError "recvResponse" err
-      Right ret -> return ret
+    recvGetN conn len (getResponse (messageTag dummy))
 
 recvResponse_ :: Connection -> T.MessageTag -> IO ()
 recvResponse_ conn expected = do
   len <- fromIntegral `fmap` recvGet conn getWord32be
   tag <- recvGet conn getTag
-  when (tag /= expected) .
-    moduleError "recvResponse_" $ "received unexpected response: expected " ++
-                                  show expected ++ ", received " ++ show tag
-  recvExactly conn (len-1) >> return ()
+  case undefined of
+   _| tag == expected -> recvExactly conn (len-1) >> return ()
+    | tag == T.ErrorResponse -> throwError `fmap` recvGetN conn len messageGetM
+    | otherwise -> moduleError "recvResponse_" $
+                   "received unexpected response: expected " ++
+                   show expected ++ ", received " ++ show tag
 
 recvMaybeResponse :: (Response a) => Connection -> IO (Maybe a)
 recvMaybeResponse conn =  go undefined where
   go :: Response b => b -> IO (Maybe b)
   go dummy = do
     len <- fromIntegral `fmap` recvGet conn getWord32be
-    print len
     if len == 1
       then return Nothing
-      else do
-        r <- recvGetN conn len (getResponse (messageTag dummy))
-        case r of
-          Left err  -> moduleError "recvMaybeResponse" err
-          Right ret -> return (Just ret)
+      else Just `fmap` recvGetN conn len (getResponse (messageTag dummy))
 
 pipe :: (Request req) => (Connection -> IO resp) -> Connection -> [req]
      -> IO [resp]
       moduleError func s
 
 moduleError :: String -> String -> a
-moduleError = riakError "Network.Riak.Connection.Internal"
+moduleError = netError "Network.Riak.Connection.Internal"

src/Network/Riak/Tag.hs

 {-# INLINE getTag #-}
 
 moduleError :: String -> String -> a
-moduleError = riakError "Network.Riak.Tag"
+moduleError = netError "Network.Riak.Tag"

src/Network/Riak/Types/Internal.hs

     -- * Connection management
     , Connection(..)
     -- * Errors
-    , RiakException(..)
-    , riakError
+    , RiakException(excModule, excFunction, excMessage)
+    , netError
+    , typeError
     -- * Data types
     , Bucket
     , Key
     , connBuffer :: IORef ByteString
     } deriving (Eq)
 
-data RiakException = RiakException {
+data RiakException = NetException {
+      excModule :: String
+    , excFunction :: String
+    , excMessage :: String
+    } | TypeException {
       excModule :: String
     , excFunction :: String
     , excMessage :: String
     } deriving (Typeable)
 
 showRiakException :: RiakException -> String
-showRiakException RiakException{..} =
-    "Riak error (" ++ excModule ++ "." ++ excFunction ++ "): " ++ excMessage
+showRiakException exc@NetException{..} =
+    "Riak network error " ++ formatRiakException exc
+showRiakException exc@TypeException{..} =
+    "Riak type error " ++ formatRiakException exc
+
+formatRiakException :: RiakException -> String
+formatRiakException exc =
+    "(" ++ excModule exc ++ "." ++ excFunction exc ++ "): " ++ excMessage exc
 
 instance Show RiakException where
     show = showRiakException
 
 instance Exception RiakException 
 
-riakError :: String -> String -> String -> a
-riakError modu func msg = throw (RiakException modu func msg)
+netError :: String -> String -> String -> a
+netError modu func msg = throw (NetException modu func msg)
+
+typeError :: String -> String -> String -> a
+typeError modu func msg = throw (TypeException modu func msg)
 
 instance Show Connection where
     show conn = show "Connection " ++ host c ++ ":" ++ port c
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.