Make sure, that no exceptions escape doHttps (see haskell-github#7)

Author: sol

Github/Data/Definitions.hs

@@ -4,19 +4,16 @@ module Github.Data.Definitions where
 
 import Data.Time
 import Data.Data
-import Network.HTTP.Conduit (HttpException(..))
 import qualified Control.Exception as E
 
-deriving instance Eq Network.HTTP.Conduit.HttpException
-
 -- | Errors have been tagged according to their source, so you can more easily
 -- dispatch and handle them.
 data Error =
- HTTPConnectionError E.IOException -- ^ A HTTP error occurred. The actual caught error is included, if available.
+ HTTPConnectionError E.SomeException -- ^ A HTTP error occurred. The actual caught error is included.
  | ParseError String -- ^ An error in the parser itself.
  | JsonError String -- ^ The JSON is malformed or unexpected.
  | UserError String -- ^ Incorrect input.
- deriving (Show, Eq)
+ deriving Show
 
 -- | A date in the Github format, which is a special case of ISO-8601.
 newtype GithubDate = GithubDate { fromGithubDate :: UTCTime }

Github/Private.hs

@@ -37,7 +37,7 @@ githubAPI method url body = do
  result
  where encodedBody = RequestBodyLBS $ encode $ toJSON body
 
-doHttps :: BS.ByteString -> String -> Maybe (RequestBody IO) -> IO (Either E.IOException (Response LBS.ByteString))
+doHttps :: BS.ByteString -> String -> Maybe (RequestBody IO) -> IO (Either E.SomeException (Response LBS.ByteString))
 doHttps method url body = do
  let (Just uri) = parseURI url
  (Just host) = uriRegName uri
@@ -52,7 +52,15 @@ doHttps method url body = do
  , queryString = queryString
  }
 
- (getResponse request >>= return . Right) `catch` (return . Left)
+ (getResponse request >>= return . Right) `E.catches` [
+ -- Re-throw AsyncException, otherwise execution will not terminate on
+ -- SIGINT (ctrl-c). All AsyncExceptions are re-thrown (not just
+ -- UserInterrupt) because all of them indicate severe conditions and
+ -- should not occur during normal operation.
+ E.Handler (\e -> E.throw (e :: E.AsyncException)),
+
+ E.Handler (\e -> (return . Left) (e :: E.SomeException))
+ ]
  where
  getResponse request = withManager $ \manager -> httpLbs request manager