commit 243f8660bae4c3cd30fe16ad0180e71b78070179 Author: David Kaloper david@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