imm-0.4.0.0: Imm/HTTP.hs

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, KindSignatures #-}
-- | HTTP client related functions
module Imm.HTTP where

-- {{{ Imports
import Imm.Types
import Imm.Util as U

import Control.Exception as E
import Control.Monad.Error hiding(forM_, mapM_)

import Data.ByteString.Lazy as BL
import Data.ByteString.Char8 as BC
import Data.CaseInsensitive
import Data.Functor

import Network.HTTP.Conduit as H
import Network.URI

import Prelude hiding(catch)
-- }}}


getRaw :: (MonadIO m, MonadError ImmError m) => URI -> m BL.ByteString
getRaw uri = do
    logVerbose $ "Downloading " ++ show uri
    req <- request $ show uri
    res <- withManager' (httpLbs req)
    return $ responseBody res


-- | Monad-agnostic version of 'withManager
withManager' f = do
    res <- timeout 11000000 $ (Right <$> withManager f) `catch` (return . Left . IOE) `catch` (return . Left . HTTPError) `catch` (return . Left . TLSError)
    either throwError return res

-- | Monad-agnostic version of 'parseUrl'
parseURL :: forall (m :: * -> *) (m' :: * -> *) . (MonadIO m, MonadError ImmError m) => String -> m (Request m')
parseURL uri = do
    result <- io $ (Right <$> parseUrl uri) `catch` (return . Left . HTTPError)
    either throwError return result
    

-- | Build an HTTP request for given URI.
request :: (MonadError ImmError m, MonadIO m) => String -> m (Request a)
request uri = do
    req <- parseURL uri
    return $ req { requestHeaders = [
        (mk $ BC.pack "User-Agent", BC.pack "Mozilla/4.0"),
        (mk $ BC.pack "Accept", BC.pack "*/*")]}