[tor-commits] [tordnsel/master] precise parsing exceptions

[arlo at torproject.org]

commit 243f8660bae4c3cd30fe16ad0180e71b78070179
Author: David Kaloper <david at numm.org>
Date:   Sat Aug 24 03:40:24 2013 +0200

    precise parsing exceptions
---
 src/TorDNSEL/DNS/Internals.hs   |  9 ++++++---
 src/TorDNSEL/Socks/Internals.hs | 10 ++++++----
 2 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/src/TorDNSEL/DNS/Internals.hs b/src/TorDNSEL/DNS/Internals.hs
index 0eed2be..91b2391 100644
--- a/src/TorDNSEL/DNS/Internals.hs
+++ b/src/TorDNSEL/DNS/Internals.hs
@@ -165,10 +165,13 @@ encodeMessage :: Message -> Packet
 encodeMessage = Packet . B.concat . L.toChunks . runPutMessage . putPacket
 
 -- | Decode a DNS message strictly, returning @'Just' _@ if parsing succeeded.
+--
+-- XXX We just fight lazy decoding here -- we should replace `binary` with
+-- `cereal`. ( See `Socks`. )
 decodeMessage :: Packet -> IO (Maybe Message)
-decodeMessage pkt = do
-  r <- E.tryJust syncExceptions (E.evaluate $!! unsafeDecodeMessage pkt)
-  return $ either (const Nothing) Just r
+decodeMessage pkt =
+  ( E.evaluate $ Just $!! unsafeDecodeMessage pkt )
+    `E.catch` \(E.ErrorCall _) -> return Nothing
 
 -- | Lazily decode a DNS message. If parsing fails, the result will contain an
 -- exceptional value at some level.
diff --git a/src/TorDNSEL/Socks/Internals.hs b/src/TorDNSEL/Socks/Internals.hs
index c5ce474..7999b91 100644
--- a/src/TorDNSEL/Socks/Internals.hs
+++ b/src/TorDNSEL/Socks/Internals.hs
@@ -142,11 +142,13 @@ encodeRequest = B.concat . L.toChunks . runPut . putRequest
           putWord8 0
 
 -- | Decode a Socks4 response.
+--
+-- XXX We just fight lazy decoding here -- we should replace `binary` with
+-- `cereal`. ( See `DNS`. )
 decodeResponse :: ByteString -> IO (Maybe Response)
-decodeResponse resp = do
-  r <- E.tryJust syncExceptions
-                 (E.evaluate $!! runGet getResponse (L.fromChunks [resp]))
-  return $ either (const Nothing) Just r
+decodeResponse resp =
+  ( E.evaluate $ Just $!! runGet getResponse (L.fromChunks [resp]) )
+    `E.catch` \(E.ErrorCall _) -> return Nothing
   where
     getResponse = do
       0 <- getWord8