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 :: forall ty. HStream ty => Request ty -> IO (Result (Response ty))
simpleHTTP 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 Int
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=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_ :: forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO (Result (Response ty))
simpleHTTP_ HandleStream ty
s 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=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 :: forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO (Result (Response ty))
sendHTTP HandleStream ty
conn 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 :: forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
sendHTTP_notify HandleStream ty
conn Request ty
rq 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 :: forall ty.
HStream ty =>
HandleStream ty -> IO (Result (Request ty))
receiveHTTP HandleStream ty
conn = HandleStream ty -> IO (Result (Request ty))
forall ty.
HStream ty =>
HandleStream ty -> IO (Result (Request ty))
S.receiveHTTP HandleStream ty
conn
respondHTTP :: HStream ty => HandleStream ty -> Response ty -> IO ()
respondHTTP :: forall ty. HStream ty => HandleStream ty -> Response ty -> IO ()
respondHTTP HandleStream ty
conn 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 String
urlString =
case String -> Maybe URI
parseURI String
urlString of
Maybe URI
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error (String
"getRequest: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just 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 String
urlString =
case String -> Maybe URI
parseURI String
urlString of
Maybe URI
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error (String
"headRequest: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just 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 String
urlString =
case String -> Maybe URI
parseURI String
urlString of
Maybe URI
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error (String
"postRequest: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just 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 String
urlString String
typ String
body =
case String -> Maybe URI
parseURI String
urlString of
Maybe URI
Nothing -> String -> Request_String
forall a. HasCallStack => String -> a
error (String
"postRequestWithBody: Not a valid URL - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlString)
Just 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 :: forall ty. Result (Response ty) -> IO ty
getResponseBody (Left ConnError
err) = String -> IO ty
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ConnError -> String
forall a. Show a => a -> String
show ConnError
err)
getResponseBody (Right Response ty
r) = ty -> IO ty
forall a. a -> IO a
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 :: forall ty. Result (Response ty) -> IO ResponseCode
getResponseCode (Left ConnError
err) = String -> IO ResponseCode
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ConnError -> String
forall a. Show a => a -> String
show ConnError
err)
getResponseCode (Right Response ty
r) = ResponseCode -> IO ResponseCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ty -> ResponseCode
forall a. Response a -> ResponseCode
rspCode Response ty
r)