module Network.HTTP
( module Network.HTTP.Base
, module Network.HTTP.Headers
, simpleHTTP
, simpleHTTP_
, sendHTTP
, sendHTTP_notify
, receiveHTTP
, respondHTTP
, module Network.TCP
, getRequest
, headRequest
, postRequest
, postRequestWithBody
, getResponseBody
, getResponseCode
) where
import Network.HTTP.Headers
import Network.HTTP.Base
import qualified Network.HTTP.HandleStream as S
import Network.TCP
import Network.Stream ( Result )
import Network.URI ( parseURI )
import Data.Maybe ( fromMaybe )
simpleHTTP :: (HStream ty) => Request ty -> IO (Result (Response ty))
simpleHTTP :: Request ty -> IO (Result (Response ty))
simpleHTTP r :: Request ty
r = do
URIAuthority
auth <- Request ty -> IO URIAuthority
forall (m :: * -> *) ty.
MonadFail m =>
Request ty -> m URIAuthority
getAuth Request ty
r
URI -> IO ()
forall (m :: * -> *). MonadFail m => URI -> m ()
failHTTPS (Request ty -> URI
forall a. Request a -> URI
rqURI Request ty
r)
HandleStream ty
c <- String -> Int -> IO (HandleStream ty)
forall bufType.
HStream bufType =>
String -> Int -> IO (HandleStream bufType)
openStream (URIAuthority -> String
host URIAuthority
auth) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 80 (URIAuthority -> Maybe Int
port URIAuthority
auth))
let norm_r :: Request ty
norm_r = NormalizeRequestOptions ty -> Request ty -> Request ty
forall ty. NormalizeRequestOptions ty -> Request ty -> Request ty
normalizeRequest NormalizeRequestOptions ty
forall ty. NormalizeRequestOptions ty
defaultNormalizeRequestOptions{normDoClose :: Bool
normDoClose=Bool
True} Request ty
r
HandleStream ty -> Request ty -> IO (Result (Response ty))
forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO (Result (Response ty))
simpleHTTP_ HandleStream ty
c Request ty
norm_r
simpleHTTP_ :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
simpleHTTP_ :: HandleStream ty -> Request ty -> IO (Result (Response ty))
simpleHTTP_ s :: HandleStream ty
s r :: Request ty
r = do
let norm_r :: Request ty
norm_r = NormalizeRequestOptions ty -> Request ty -> Request ty
forall ty. NormalizeRequestOptions ty -> Request ty -> Request ty
normalizeRequest NormalizeRequestOptions ty
forall ty. NormalizeRequestOptions ty
defaultNormalizeRequestOptions{normDoClose :: Bool
normDoClose=Bool
True} Request ty
r
HandleStream ty -> Request ty -> IO (Result (Response ty))
forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO (Result (Response ty))
S.sendHTTP HandleStream ty
s Request ty
norm_r
sendHTTP :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
sendHTTP :: HandleStream ty -> Request ty -> IO (Result (Response ty))
sendHTTP conn :: HandleStream ty
conn rq :: Request ty
rq = do
let norm_r :: Request ty
norm_r = NormalizeRequestOptions ty -> Request ty -> Request ty
forall ty. NormalizeRequestOptions ty -> Request ty -> Request ty
normalizeRequest NormalizeRequestOptions ty
forall ty. NormalizeRequestOptions ty
defaultNormalizeRequestOptions Request ty
rq
HandleStream ty -> Request ty -> IO (Result (Response ty))
forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO (Result (Response ty))
S.sendHTTP HandleStream ty
conn Request ty
norm_r
sendHTTP_notify :: HStream ty
=> HandleStream ty
-> Request ty
-> IO ()
-> IO (Result (Response ty))
sendHTTP_notify :: HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
sendHTTP_notify conn :: HandleStream ty
conn rq :: Request ty
rq onSendComplete :: IO ()
onSendComplete = do
let norm_r :: Request ty
norm_r = NormalizeRequestOptions ty -> Request ty -> Request ty
forall ty. NormalizeRequestOptions ty -> Request ty -> Request ty
normalizeRequest NormalizeRequestOptions ty
forall ty. NormalizeRequestOptions ty
defaultNormalizeRequestOptions Request ty
rq
HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
S.sendHTTP_notify HandleStream ty
conn Request ty
norm_r IO ()
onSendComplete
receiveHTTP :: HStream ty => HandleStream ty -> IO (Result (Request ty))
receiveHTTP :: HandleStream ty -> IO (Result (Request ty))
receiveHTTP conn :: HandleStream ty
conn = HandleStream ty -> IO (Result (Request ty))
forall bufTy.
HStream bufTy =>
HandleStream bufTy -> IO (Result (Request bufTy))
S.receiveHTTP HandleStream ty
conn
respondHTTP :: HStream ty => HandleStream ty -> Response ty -> IO ()
respondHTTP :: HandleStream ty -> Response ty -> IO ()
respondHTTP conn :: HandleStream ty
conn rsp :: Response ty
rsp = HandleStream ty -> Response ty -> IO ()
forall ty. HStream ty => HandleStream ty -> Response ty -> IO ()
S.respondHTTP HandleStream ty
conn Response ty
rsp
getRequest
:: String
-> Request_String
getRequest :: String -> Request_String
getRequest urlString :: String
urlString =
case String -> Maybe URI
parseURI String
urlString of
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error ("getRequest: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just u :: URI
u -> RequestMethod -> URI -> Request_String
forall ty. BufferType ty => RequestMethod -> URI -> Request ty
mkRequest RequestMethod
GET URI
u
headRequest
:: String
-> Request_String
headRequest :: String -> Request_String
headRequest urlString :: String
urlString =
case String -> Maybe URI
parseURI String
urlString of
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error ("headRequest: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just u :: URI
u -> RequestMethod -> URI -> Request_String
forall ty. BufferType ty => RequestMethod -> URI -> Request ty
mkRequest RequestMethod
HEAD URI
u
postRequest
:: String
-> Request_String
postRequest :: String -> Request_String
postRequest urlString :: String
urlString =
case String -> Maybe URI
parseURI String
urlString of
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error ("postRequest: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just u :: URI
u -> RequestMethod -> URI -> Request_String
forall ty. BufferType ty => RequestMethod -> URI -> Request ty
mkRequest RequestMethod
POST URI
u
postRequestWithBody
:: String
-> String
-> String
-> Request_String
postRequestWithBody :: String -> String -> String -> Request_String
postRequestWithBody urlString :: String
urlString typ :: String
typ body :: String
body =
case String -> Maybe URI
parseURI String
urlString of
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error ("postRequestWithBody: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just u :: URI
u -> Request_String -> (String, String) -> Request_String
setRequestBody (RequestMethod -> URI -> Request_String
forall ty. BufferType ty => RequestMethod -> URI -> Request ty
mkRequest RequestMethod
POST URI
u) (String
typ, String
body)
getResponseBody :: Result (Response ty) -> IO ty
getResponseBody :: Result (Response ty) -> IO ty
getResponseBody (Left err :: ConnError
err) = String -> IO ty
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ConnError -> String
forall a. Show a => a -> String
show ConnError
err)
getResponseBody (Right r :: Response ty
r) = ty -> IO ty
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ty -> ty
forall a. Response a -> a
rspBody Response ty
r)
getResponseCode :: Result (Response ty) -> IO ResponseCode
getResponseCode :: Result (Response ty) -> IO ResponseCode
getResponseCode (Left err :: ConnError
err) = String -> IO ResponseCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ConnError -> String
forall a. Show a => a -> String
show ConnError
err)
getResponseCode (Right r :: Response ty
r) = ResponseCode -> IO ResponseCode
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ty -> ResponseCode
forall a. Response a -> ResponseCode
rspCode Response ty
r)