Skip to content
Browse files

Handle IO exceptions

  • Loading branch information...
1 parent 166a084 commit ffb3d77c4361de2a8e4a5fb3be46d0bf25a7834d @singpolyma committed
Showing with 12 additions and 3 deletions.
  1. +4 −1 Keyserver.hs
  2. +4 −1 OTC.hs
  3. +4 −1 Util.hs
View
5 Keyserver.hs
@@ -3,14 +3,17 @@ module Keyserver where
import Control.Error (hush, MaybeT(..), runMaybeT, hoistMaybe, headMay)
import Data.Binary (decodeOrFail)
import qualified Network.HTTP as HTTP
+import qualified Network.HTTP.Stream as HTTP (ConnError(..))
import qualified Data.OpenPGP as OpenPGP
import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor
import qualified Codec.Encryption.OpenPGP.ASCIIArmor.Types as ASCIIArmor
import qualified Data.ByteString.Lazy as LZ
+import Util
+
fetchKey :: String -> IO (Maybe OpenPGP.Message)
fetchKey fpr = runMaybeT $ do
- r <- MaybeT $ fmap hush $ HTTP.simpleHTTP req
+ r <- MaybeT $ fmap hush $ tryIO' (HTTP.ErrorMisc . show) $ HTTP.simpleHTTP req
-- XXX: Data is all ASCII, but this is still a terrible hack
let rbytes = LZ.pack $ map (toEnum.fromEnum) (HTTP.rspBody r)
armor <- hoistMaybe $ headMay =<< hush (ASCIIArmor.decodeLazy rbytes :: Either String [ASCIIArmor.Armor])
View
5 OTC.hs
@@ -3,10 +3,13 @@ module OTC where
import Control.Applicative ((<$>), (<*>))
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Network.HTTP as HTTP
+import qualified Network.HTTP.Stream as HTTP (ConnError(..))
import qualified Data.Aeson as Aeson
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as LZ
+import Util
+
data OTCKey = OTCKey String String deriving (Eq, Show)
instance Aeson.FromJSON OTCKey where
@@ -21,7 +24,7 @@ otcKeyToTuple (OTCKey fpr nick) = Just (fpr, nick)
otcKeys :: IO [(String, String)]
otcKeys = do
- r <- HTTP.simpleHTTP req
+ r <- tryIO' (HTTP.ErrorMisc . show) $ HTTP.simpleHTTP req
-- XXX: Data is all ASCII, but this is still a terrible hack
let rbytes = LZ.pack . map (toEnum.fromEnum) . HTTP.rspBody <$> r
case rbytes of
View
5 Util.hs
@@ -1,9 +1,12 @@
module Util where
-import Control.Error (readMay)
+import Control.Error (readMay, tryIO, eitherT)
import Data.Binary (Binary, decodeOrFail)
import qualified Data.ByteString.Lazy as LZ
+tryIO' :: (IOError -> e) -> IO (Either e b) -> IO (Either e b)
+tryIO' mapErr io = eitherT (return . Left . mapErr) return (tryIO io)
+
decodeM :: (Binary a, Monad m) => LZ.ByteString -> m a
decodeM bytes = case decodeOrFail bytes of
Left (_,_,e) -> fail e

0 comments on commit ffb3d77

Please sign in to comment.
Something went wrong with that request. Please try again.