-----------------------------------------------------------------------------
-- |
-- Module      :  Network.HTTP
-- Copyright   :  See LICENSE file
-- License     :  BSD
--
-- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
-- Stability   :  experimental
-- Portability :  non-portable (not tested)
--
-- The 'Network.HTTP' module provides a simple interface for sending and
-- receiving content over HTTP in Haskell. Here's how to fetch a document from
-- a URL and return it as a String:
--
-- >
-- >    simpleHTTP (getRequest "http://www.haskell.org/") >>= fmap (take 100) . getResponseBody
-- >        -- fetch document and return it (as a 'String'.)
--
-- Other functions let you control the submission and transfer of HTTP
-- 'Request's and 'Response's more carefully, letting you integrate the use
-- of 'Network.HTTP' functionality into your application.
--
-- The module also exports the main types of the package, 'Request' and 'Response',
-- along with 'Header' and functions for working with these.
--
-- The actual functionality is implemented by modules in the @Network.HTTP.*@
-- namespace, letting you either use the default implementation here
-- by importing @Network.HTTP@ or, for more specific uses, selectively
-- import the modules in @Network.HTTP.*@. To wit, more than one kind of
-- representation of the bulk data that flows across a HTTP connection is
-- supported. (see "Network.HTTP.HandleStream".)
--
-- /NOTE:/ The 'Request' send actions will normalize the @Request@ prior to transmission.
-- Normalization such as having the request path be in the expected form and, possibly,
-- introduce a default @Host:@ header if one isn't already present.
-- Normalization also takes the @"user:pass\@"@ portion out of the the URI,
-- if it was supplied, and converts it into @Authorization: Basic$ header.
-- If you do not
-- want the requests tampered with, but sent as-is, please import and use the
-- the "Network.HTTP.HandleStream" or "Network.HTTP.Stream" modules instead. They
-- export the same functions, but leaves construction and any normalization of
-- @Request@s to the user.
--
-- /NOTE:/ This package only supports HTTP; it does not support HTTPS.
-- Attempts to use HTTPS result in an error.
-----------------------------------------------------------------------------
module Network.HTTP
       ( module Network.HTTP.Base
       , module Network.HTTP.Headers

         {- the functionality that the implementation modules,
            Network.HTTP.HandleStream and Network.HTTP.Stream,
            exposes:
         -}
       , simpleHTTP      -- :: Request -> IO (Result Response)
       , simpleHTTP_     -- :: Stream s => s -> Request -> IO (Result Response)
       , sendHTTP        -- :: Stream s => s -> Request -> IO (Result Response)
       , sendHTTP_notify -- :: Stream s => s -> Request -> IO () -> IO (Result Response)
       , receiveHTTP     -- :: Stream s => s -> IO (Result Request)
       , respondHTTP     -- :: Stream s => s -> Response -> IO ()

       , module Network.TCP

       , getRequest      -- :: String -> Request_String
       , headRequest     -- :: String -> Request_String
       , postRequest     -- :: String -> Request_String
       , postRequestWithBody -- :: String -> String -> String -> Request_String

       , getResponseBody -- :: Result (Request ty) -> IO ty
       , getResponseCode -- :: Result (Request ty) -> IO ResponseCode
       ) where

-----------------------------------------------------------------
------------------ Imports --------------------------------------
-----------------------------------------------------------------

import Network.HTTP.Headers
import Network.HTTP.Base
import qualified Network.HTTP.HandleStream as S
-- old implementation: import Network.HTTP.Stream
import Network.TCP
import Network.Stream ( Result )
import Network.URI    ( parseURI )

import Data.Maybe ( fromMaybe )

{-
 Note: if you switch over/back to using Network.HTTP.Stream here, you'll
 have to wrap the results from 'openStream' as Connections via 'hstreamToConnection'
 prior to delegating to the Network.HTTP.Stream functions.
-}

-- | @simpleHTTP req@ transmits the 'Request' @req@ by opening a /direct/, non-persistent
-- connection to the HTTP server that @req@ is destined for, followed by transmitting
-- it and gathering up the response as a 'Result'. Prior to sending the request,
-- it is normalized (via 'normalizeRequest'). If you have to mediate the request
-- via an HTTP proxy, you will have to normalize the request yourself. Or switch to
-- using 'Network.Browser' instead.
--
-- Examples:
--
-- > simpleHTTP (getRequest "http://hackage.haskell.org/")
-- > simpleHTTP (getRequest "http://hackage.haskell.org:8012/")

simpleHTTP :: (HStream ty) => Request ty -> IO (Result (Response ty))
simpleHTTP :: 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 :: 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

-- | Identical to 'simpleHTTP', but acting on an already opened stream.
simpleHTTP_ :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
simpleHTTP_ :: 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 :: 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 httpRequest@ transmits @httpRequest@ (after normalization) over
-- @hStream@, but does not alter the status of the connection, nor request it to be
-- closed upon receiving the response.
sendHTTP :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
sendHTTP :: 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 httpRequest action@ behaves like 'sendHTTP', but
-- lets you supply an IO @action@ to execute once the request has been successfully
-- transmitted over the connection. Useful when you want to set up tracing of
-- request transmission and its performance.
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 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@ reads a 'Request' from the 'HandleStream' @hStream@
receiveHTTP :: HStream ty => HandleStream ty -> IO (Result (Request ty))
receiveHTTP :: HandleStream ty -> IO (Result (Request ty))
receiveHTTP 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 httpResponse@ transmits an HTTP 'Response' over
-- the 'HandleStream' @hStream@. It could be used to implement simple web
-- server interactions, performing the dual role to 'sendHTTP'.
respondHTTP :: HStream ty => HandleStream ty -> Response ty -> IO ()
respondHTTP :: 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


-- | A convenience constructor for a GET 'Request'.
--
-- If the URL isn\'t syntactically valid, the function raises an error.
getRequest
    :: String             -- ^URL to fetch
    -> Request_String     -- ^The constructed request
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

-- | A convenience constructor for a HEAD 'Request'.
--
-- If the URL isn\'t syntactically valid, the function raises an error.
headRequest
    :: String             -- ^URL to fetch
    -> Request_String     -- ^The constructed request
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

-- | A convenience constructor for a POST 'Request'.
--
-- If the URL isn\'t syntactically valid, the function raises an error.
postRequest
    :: String                   -- ^URL to POST to
    -> Request_String           -- ^The constructed request
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

-- | A convenience constructor for a POST 'Request'.
--
-- It constructs a request and sets the body as well as
-- the Content-Type and Content-Length headers. The contents of the body
-- are forced to calculate the value for the Content-Length header.
--
-- If the URL isn\'t syntactically valid, the function raises an error.
postRequestWithBody
    :: String                      -- ^URL to POST to
    -> String                      -- ^Content-Type of body
    -> String                      -- ^The body of the request
    -> Request_String              -- ^The constructed request
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 response@ takes the response of a HTTP requesting action and
-- tries to extricate the body of the 'Response' @response@. If the request action
-- returned an error, an IO exception is raised.
getResponseBody :: Result (Response ty) -> IO ty
getResponseBody :: Result (Response ty) -> IO ty
getResponseBody (Left 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 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 response@ takes the response of a HTTP requesting action and
-- tries to extricate the status code of the 'Response' @response@. If the request action
-- returned an error, an IO exception is raised.
getResponseCode :: Result (Response ty) -> IO ResponseCode
getResponseCode :: Result (Response ty) -> IO ResponseCode
getResponseCode (Left 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 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)


--
-- * TODO
--     - request pipelining
--     - https upgrade (includes full TLS, i.e. SSL, implementation)
--         - use of Stream classes will pay off
--         - consider C implementation of encryption\/decryption
--     - comm timeouts
--     - MIME & entity stuff (happening in separate module)
--     - support \"*\" uri-request-string for OPTIONS request method
--
--
-- * Header notes:
--
--     [@Host@]
--                  Required by HTTP\/1.1, if not supplied as part
--                  of a request a default Host value is extracted
--                  from the request-uri.
--
--     [@Connection@]
--                  If this header is present in any request or
--                  response, and it's value is "close", then
--                  the current request\/response is the last
--                  to be allowed on that connection.
--
--     [@Expect@]
--                  Should a request contain a body, an Expect
--                  header will be added to the request.  The added
--                  header has the value \"100-continue\".  After
--                  a 417 \"Expectation Failed\" response the request
--                  is attempted again without this added Expect
--                  header.
--
--     [@TransferEncoding,ContentLength,...@]
--                  if request is inconsistent with any of these
--                  header values then you may not receive any response
--                  or will generate an error response (probably 4xx).
--
--
-- * Response code notes
-- Some response codes induce special behaviour:
--
--   [@1xx@]   \"100 Continue\" will cause any unsent request body to be sent.
--             \"101 Upgrade\" will be returned.
--             Other 1xx responses are ignored.
--
--   [@417@]   The reason for this code is \"Expectation failed\", indicating
--             that the server did not like the Expect \"100-continue\" header
--             added to a request.  Receipt of 417 will induce another
--             request attempt (without Expect header), unless no Expect header
--             had been added (in which case 417 response is returned).