1-----------------------------------------------------------------------------
2-- |
3-- Module      :  Network.HTTP
4-- Copyright   :  See LICENSE file
5-- License     :  BSD
6--
7-- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
8-- Stability   :  experimental
9-- Portability :  non-portable (not tested)
10--
11-- The 'Network.HTTP' module provides a simple interface for sending and
12-- receiving content over HTTP in Haskell. Here's how to fetch a document from
13-- a URL and return it as a String:
14--
15-- >
16-- >    simpleHTTP (getRequest "http://www.haskell.org/") >>= fmap (take 100) . getResponseBody
17-- >        -- fetch document and return it (as a 'String'.)
18--
19-- Other functions let you control the submission and transfer of HTTP
20-- 'Request's and 'Response's more carefully, letting you integrate the use
21-- of 'Network.HTTP' functionality into your application.
22--
23-- The module also exports the main types of the package, 'Request' and 'Response',
24-- along with 'Header' and functions for working with these.
25--
26-- The actual functionality is implemented by modules in the @Network.HTTP.*@
27-- namespace, letting you either use the default implementation here
28-- by importing @Network.HTTP@ or, for more specific uses, selectively
29-- import the modules in @Network.HTTP.*@. To wit, more than one kind of
30-- representation of the bulk data that flows across a HTTP connection is
31-- supported. (see "Network.HTTP.HandleStream".)
32--
33-- /NOTE:/ The 'Request' send actions will normalize the @Request@ prior to transmission.
34-- Normalization such as having the request path be in the expected form and, possibly,
35-- introduce a default @Host:@ header if one isn't already present.
36-- Normalization also takes the @"user:pass\@"@ portion out of the the URI,
37-- if it was supplied, and converts it into @Authorization: Basic$ header.
38-- If you do not
39-- want the requests tampered with, but sent as-is, please import and use the
40-- the "Network.HTTP.HandleStream" or "Network.HTTP.Stream" modules instead. They
41-- export the same functions, but leaves construction and any normalization of
42-- @Request@s to the user.
43--
44-- /NOTE:/ This package only supports HTTP; it does not support HTTPS.
45-- Attempts to use HTTPS result in an error.
46-----------------------------------------------------------------------------
47module Network.HTTP
48       ( module Network.HTTP.Base
49       , module Network.HTTP.Headers
50
51         {- the functionality that the implementation modules,
52	    Network.HTTP.HandleStream and Network.HTTP.Stream,
53	    exposes:
54	 -}
55       , simpleHTTP      -- :: Request -> IO (Result Response)
56       , simpleHTTP_     -- :: Stream s => s -> Request -> IO (Result Response)
57       , sendHTTP        -- :: Stream s => s -> Request -> IO (Result Response)
58       , sendHTTP_notify -- :: Stream s => s -> Request -> IO () -> IO (Result Response)
59       , receiveHTTP     -- :: Stream s => s -> IO (Result Request)
60       , respondHTTP     -- :: Stream s => s -> Response -> IO ()
61
62       , module Network.TCP
63
64       , getRequest      -- :: String -> Request_String
65       , headRequest     -- :: String -> Request_String
66       , postRequest     -- :: String -> Request_String
67       , postRequestWithBody -- :: String -> String -> String -> Request_String
68
69       , getResponseBody -- :: Result (Request ty) -> IO ty
70       , getResponseCode -- :: Result (Request ty) -> IO ResponseCode
71       ) where
72
73-----------------------------------------------------------------
74------------------ Imports --------------------------------------
75-----------------------------------------------------------------
76
77import Network.HTTP.Headers
78import Network.HTTP.Base
79import qualified Network.HTTP.HandleStream as S
80-- old implementation: import Network.HTTP.Stream
81import Network.TCP
82import Network.Stream ( Result )
83import Network.URI    ( parseURI )
84
85import Data.Maybe ( fromMaybe )
86
87{-
88 Note: if you switch over/back to using Network.HTTP.Stream here, you'll
89 have to wrap the results from 'openStream' as Connections via 'hstreamToConnection'
90 prior to delegating to the Network.HTTP.Stream functions.
91-}
92
93-- | @simpleHTTP req@ transmits the 'Request' @req@ by opening a /direct/, non-persistent
94-- connection to the HTTP server that @req@ is destined for, followed by transmitting
95-- it and gathering up the response as a 'Result'. Prior to sending the request,
96-- it is normalized (via 'normalizeRequest'). If you have to mediate the request
97-- via an HTTP proxy, you will have to normalize the request yourself. Or switch to
98-- using 'Network.Browser' instead.
99--
100-- Examples:
101--
102-- > simpleHTTP (getRequest "http://hackage.haskell.org/")
103-- > simpleHTTP (getRequest "http://hackage.haskell.org:8012/")
104
105simpleHTTP :: (HStream ty) => Request ty -> IO (Result (Response ty))
106simpleHTTP r = do
107  auth <- getAuth r
108  failHTTPS (rqURI r)
109  c <- openStream (host auth) (fromMaybe 80 (port auth))
110  let norm_r = normalizeRequest defaultNormalizeRequestOptions{normDoClose=True} r
111  simpleHTTP_ c norm_r
112
113-- | Identical to 'simpleHTTP', but acting on an already opened stream.
114simpleHTTP_ :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
115simpleHTTP_ s r = do
116  let norm_r = normalizeRequest defaultNormalizeRequestOptions{normDoClose=True} r
117  S.sendHTTP s norm_r
118
119-- | @sendHTTP hStream httpRequest@ transmits @httpRequest@ (after normalization) over
120-- @hStream@, but does not alter the status of the connection, nor request it to be
121-- closed upon receiving the response.
122sendHTTP :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
123sendHTTP conn rq = do
124  let norm_r = normalizeRequest defaultNormalizeRequestOptions rq
125  S.sendHTTP conn norm_r
126
127-- | @sendHTTP_notify hStream httpRequest action@ behaves like 'sendHTTP', but
128-- lets you supply an IO @action@ to execute once the request has been successfully
129-- transmitted over the connection. Useful when you want to set up tracing of
130-- request transmission and its performance.
131sendHTTP_notify :: HStream ty
132                => HandleStream ty
133                -> Request ty
134                -> IO ()
135                -> IO (Result (Response ty))
136sendHTTP_notify conn rq onSendComplete = do
137  let norm_r = normalizeRequest defaultNormalizeRequestOptions rq
138  S.sendHTTP_notify conn norm_r onSendComplete
139
140-- | @receiveHTTP hStream@ reads a 'Request' from the 'HandleStream' @hStream@
141receiveHTTP :: HStream ty => HandleStream ty -> IO (Result (Request ty))
142receiveHTTP conn = S.receiveHTTP conn
143
144-- | @respondHTTP hStream httpResponse@ transmits an HTTP 'Response' over
145-- the 'HandleStream' @hStream@. It could be used to implement simple web
146-- server interactions, performing the dual role to 'sendHTTP'.
147respondHTTP :: HStream ty => HandleStream ty -> Response ty -> IO ()
148respondHTTP conn rsp = S.respondHTTP conn rsp
149
150
151-- | A convenience constructor for a GET 'Request'.
152--
153-- If the URL isn\'t syntactically valid, the function raises an error.
154getRequest
155    :: String             -- ^URL to fetch
156    -> Request_String     -- ^The constructed request
157getRequest urlString =
158  case parseURI urlString of
159    Nothing -> error ("getRequest: Not a valid URL - " ++ urlString)
160    Just u  -> mkRequest GET u
161
162-- | A convenience constructor for a HEAD 'Request'.
163--
164-- If the URL isn\'t syntactically valid, the function raises an error.
165headRequest
166    :: String             -- ^URL to fetch
167    -> Request_String     -- ^The constructed request
168headRequest urlString =
169  case parseURI urlString of
170    Nothing -> error ("headRequest: Not a valid URL - " ++ urlString)
171    Just u  -> mkRequest HEAD u
172
173-- | A convenience constructor for a POST 'Request'.
174--
175-- If the URL isn\'t syntactically valid, the function raises an error.
176postRequest
177    :: String                   -- ^URL to POST to
178    -> Request_String           -- ^The constructed request
179postRequest urlString =
180  case parseURI urlString of
181    Nothing -> error ("postRequest: Not a valid URL - " ++ urlString)
182    Just u  -> mkRequest POST u
183
184-- | A convenience constructor for a POST 'Request'.
185--
186-- It constructs a request and sets the body as well as
187-- the Content-Type and Content-Length headers. The contents of the body
188-- are forced to calculate the value for the Content-Length header.
189--
190-- If the URL isn\'t syntactically valid, the function raises an error.
191postRequestWithBody
192    :: String                      -- ^URL to POST to
193    -> String                      -- ^Content-Type of body
194    -> String                      -- ^The body of the request
195    -> Request_String              -- ^The constructed request
196postRequestWithBody urlString typ body =
197  case parseURI urlString of
198    Nothing -> error ("postRequestWithBody: Not a valid URL - " ++ urlString)
199    Just u  -> setRequestBody (mkRequest POST u) (typ, body)
200
201-- | @getResponseBody response@ takes the response of a HTTP requesting action and
202-- tries to extricate the body of the 'Response' @response@. If the request action
203-- returned an error, an IO exception is raised.
204getResponseBody :: Result (Response ty) -> IO ty
205getResponseBody (Left err) = fail (show err)
206getResponseBody (Right r)  = return (rspBody r)
207
208-- | @getResponseCode response@ takes the response of a HTTP requesting action and
209-- tries to extricate the status code of the 'Response' @response@. If the request action
210-- returned an error, an IO exception is raised.
211getResponseCode :: Result (Response ty) -> IO ResponseCode
212getResponseCode (Left err) = fail (show err)
213getResponseCode (Right r)  = return (rspCode r)
214
215
216--
217-- * TODO
218--     - request pipelining
219--     - https upgrade (includes full TLS, i.e. SSL, implementation)
220--         - use of Stream classes will pay off
221--         - consider C implementation of encryption\/decryption
222--     - comm timeouts
223--     - MIME & entity stuff (happening in separate module)
224--     - support \"*\" uri-request-string for OPTIONS request method
225--
226--
227-- * Header notes:
228--
229--     [@Host@]
230--                  Required by HTTP\/1.1, if not supplied as part
231--                  of a request a default Host value is extracted
232--                  from the request-uri.
233--
234--     [@Connection@]
235--                  If this header is present in any request or
236--                  response, and it's value is "close", then
237--                  the current request\/response is the last
238--                  to be allowed on that connection.
239--
240--     [@Expect@]
241--                  Should a request contain a body, an Expect
242--                  header will be added to the request.  The added
243--                  header has the value \"100-continue\".  After
244--                  a 417 \"Expectation Failed\" response the request
245--                  is attempted again without this added Expect
246--                  header.
247--
248--     [@TransferEncoding,ContentLength,...@]
249--                  if request is inconsistent with any of these
250--                  header values then you may not receive any response
251--                  or will generate an error response (probably 4xx).
252--
253--
254-- * Response code notes
255-- Some response codes induce special behaviour:
256--
257--   [@1xx@]   \"100 Continue\" will cause any unsent request body to be sent.
258--             \"101 Upgrade\" will be returned.
259--             Other 1xx responses are ignored.
260--
261--   [@417@]   The reason for this code is \"Expectation failed\", indicating
262--             that the server did not like the Expect \"100-continue\" header
263--             added to a request.  Receipt of 417 will induce another
264--             request attempt (without Expect header), unless no Expect header
265--             had been added (in which case 417 response is returned).
266