-- GhttpHS: Haskell binding to the Gnome HTTP library -*-haskell-*- -- -- Author : Manuel M. T. Chakravarty -- Created: 5 August 99 -- -- Copyright (c) [1999..2000] Manuel M. T. Chakravarty -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Library General Public -- License as published by the Free Software Foundation; either -- version 2 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Library General Public License for more details. -- --- DESCRIPTION --------------------------------------------------------------- -- -- The C library `libghttp' provides a set of common http functions needed at -- the client and the server end of an http connection. The Haskell binding -- is generated with the help of the C->Haskell tool - always modify the -- original .chs file, _not_ the generated .hs file. -- -- This library is fully compliant with HTTP 1.1 as defined in the draft 5 -- update of RFC 2068. -- --- DOCU ---------------------------------------------------------------------- -- -- language: Haskell 98 & C->HS binding hooks (v0.7.5) -- -- ** Stylistic warning: In the definition of `CurrentStatus', the field -- labels do not contain the name of the data type to which they belong. -- This is _not_ good practice in larger interfaces, because in Haskell -- such field labels pollute the global name space. -- --- TODO ---------------------------------------------------------------------- -- -- * When and by whom is the memory area passed to `ghttp_set_body' be freed; -- how about the string returned from `ghttp_get_body'? -- -- * Conversion of `time_t' misses for `parseDate'. -- module Ghttp (Request, URI, Type(..), SyncMode(..), Status(..), Proc(..), CurrentStatus(..), requestNew, requestDestroy, uriValidate, setURI, setProxy, setType, setBody, setSync, prepare, setChunksize, setHeader, process, getStatus, getHeader, close, clean, getSocket, getBody, getError, {-parseDate,-} setAuthinfo, setProxyAuthinfo) where -- C->HS marshalling library -- import C2HS import Monad (liftM, when) import IOExts (unsafePerformIO) {#context lib="libghttp" prefix="ghttp"#} -- data structures -- --------------- -- abstract handle for a http request object (EXPORTED ABSTRACTLY) -- newtype Request = Request Addr -- Uniform Resource Indicators (EXPORTED) -- type URI = String -- body type (EXPORTED) -- {#enum ghttp_type as Type {underscoreToCase}#} -- synchronous/asynchronous mode (EXPORTED) -- {#enum sync_mode as SyncMode {underscoreToCase}#} -- request status (EXPORTED) -- {#enum status as Status {underscoreToCase}#} -- describes the activity of a request (EXPORTED) -- {#enum proc as Proc {underscoreToCase}#} -- status descriptor (EXPORTED) -- data CurrentStatus = CurrentStatus { proc :: Proc, -- What's it doing? bytesRead :: Int, -- How many bytes have been read? bytesTotal :: Int -- How many bytes total? } -- error types -- invalidURI, illegalRequest :: String invalidURI = "Ghttp: The Uniform Resource Indicator is invalid." illegalRequest = "Ghttp: The request is illegal or unsupported." -- functions -- --------- -- create a new request object (EXPORTED) -- requestNew :: IO Request requestNew = liftM Request {#call unsafe request_new#} -- delete a current request object (EXPORTED) -- requestDestroy :: Request -> IO () requestDestroy (Request reqa) = {#call unsafe request_destroy#} reqa -- validate a uri (EXPORTED) -- uriValidate :: URI -> Bool uriValidate uri = let res = unsafePerformIO $ {#call unsafe uri_validate#} `marsh1_` (stdAddr uri :> free) in res == -1 -- set a uri in a request (EXPORTED) -- -- * raise an exception if the URI is not valid -- setURI :: Request -> URI -> IO () setURI (Request reqa) uri = {#call unsafe set_uri#} reqa `marsh1_` (stdAddr uri :> free) `ifNegRaise_` invalidURI -- set a proxy for a request (EXPORTED) -- -- * raise an exception if the request is not valid -- setProxy :: Request -> URI -> IO () setProxy (Request reqa) uri = {#call unsafe set_proxy#} reqa `marsh1_` (stdAddr uri :> free) `ifNegRaise_` illegalRequest -- set a request type (EXPORTED) -- -- * raise an exception if the request is not valid -- setType :: Request -> Type -> IO () setType (Request reqa) rtype = {#call unsafe set_type#} reqa (cFromEnum rtype) `ifNegRaise_` illegalRequest -- set the body (EXPORTED) -- -- * raise an exception if the request is not valid -- setBody :: Request -> String -> IO () setBody (Request reqa) body = do (box, len) <- listToAddrWithLen body {#call unsafe set_body#} reqa box (cFromInt len) `ifNegRaise_` illegalRequest -- set whether or not you want to use sync or async mode (EXPORTED) -- -- * raise an exception if the request is not valid -- setSync :: Request -> SyncMode -> IO () setSync (Request reqa) smode = {#call unsafe set_sync#} reqa (cFromEnum smode) `ifNegRaise_` illegalRequest -- Prepare a request; call this before trying to process a request or if you -- change the uri (EXPORTED) -- -- * raise an exception if the request is not valid -- prepare :: Request -> IO () prepare (Request reqa) = {#call unsafe prepare#} reqa `ifNegRaise_` illegalRequest -- set the chunk size; you might want to do this to optimize for different -- connection speeds (EXPORTED) -- setChunksize :: Request -> Int -> IO () setChunksize (Request reqa) size = {#call unsafe set_chunksize#} reqa (cFromInt size) -- set a random request header (EXPORTED) -- setHeader :: Request -> String -> String -> IO () setHeader (Request reqa) hdr val = {#call unsafe set_header#} reqa `marsh2_` (stdAddr hdr :> free) $ (stdAddr val :> free) -- process a request (EXPORTED) -- process :: Request -> IO Status process (Request reqa) = liftM cToEnum $ {#call unsafe process#} reqa -- get the status of a request (EXPORTED) -- getStatus :: Request -> IO CurrentStatus getStatus (Request reqa) = {#call unsafe ghttpHS_get_status #} reqa >>= cFromCurrentStatus -- get the value of a random response header (EXPORTED) -- getHeader :: Request -> String -> IO String getHeader (Request reqa) hdr = {#call unsafe get_header#} reqa `marsh1_` (stdAddr hdr :> free) >>= addrStd -- abort a currently running request (EXPORTED) -- -- * raise an exception if the request is not valid -- close :: Request -> IO () close (Request reqa) = {#call unsafe close#} reqa `ifNegRaise_` illegalRequest -- clean a request (EXPORTED) -- clean :: Request -> IO () clean (Request reqa) = {#call unsafe clean#} reqa -- get the socket associated with a particular connection (EXPORTED) -- -- * raise an exception if the request is not valid -- getSocket :: Request -> IO Int getSocket (Request reqa) = {#call unsafe get_socket#} reqa `ifNegRaise` illegalRequest -- get the return entity body (EXPORTED) -- -- * this includes getting the length with `ghttp_get_body_len', as the string -- is not necessarily \0 terminated -- getBody :: Request -> IO String getBody (Request reqa) = do bodyAddr <- {#call unsafe get_body#} reqa `ifNullRaise` illegalRequest bodyLen <- {#call unsafe get_body_len#} reqa addrWithLenToList bodyAddr (cToInt bodyLen) -- get an error message for a request that has failed (EXPORTED) -- getError :: Request -> IO String getError (Request reqa) = {#call unsafe get_error#} reqa >>= addrStd -- parse a date string that is one of the standard date formats (EXPORTED) -- {-parseDate :: String -> CalendarTime parseDate str = do time_t <- {#call unsafe parse_date#} `fromString` str time <- toCalendarTime -} -- return the status code (EXPORTED) -- statusCode :: Request -> IO Int statusCode (Request reqa) = liftM cToInt $ {#call unsafe status_code#} reqa -- return the reason phrase (EXPORTED) -- -- * raise an exception if the request is not valid -- reasonPhrase :: Request -> IO String reasonPhrase (Request reqa) = ({#call unsafe reason_phrase#} reqa `ifNullRaise` illegalRequest ) >>= addrStd -- set your username/password pair (EXPORTED) -- -- * raise an exception if the request is not valid -- setAuthinfo :: Request -> String -> String -> IO () setAuthinfo (Request reqa) user pass = ({#call unsafe set_authinfo#} reqa `marsh2_` (stdAddr user :> free) $ (stdAddr pass :> free) ) `ifNegRaise_` illegalRequest -- set your username/password pair for proxy (EXPORTED) -- -- * raise an exception if the request is not valid -- setProxyAuthinfo :: Request -> String -> String -> IO () setProxyAuthinfo (Request reqa) user pass = ({#call unsafe set_proxy_authinfo#} reqa `marsh2_` (stdAddr user :> free) $ (stdAddr pass :> free) ) `ifNegRaise_` illegalRequest -- auxilliary marshalling function -- ------------------------------- -- marshal the elements of a `ghttp_current_status' struct to Haskell land -- -- * frees the C struct -- cFromCurrentStatus :: Addr -> IO CurrentStatus cFromCurrentStatus csPtr = do proc <- liftM cToEnum$ {#get current_status.proc#} csPtr read <- liftM cToInt $ {#get current_status.bytes_read#} csPtr total<- liftM cToInt $ {#get current_status.bytes_total#} csPtr free csPtr return $ CurrentStatus { proc = proc, bytesRead = read, bytesTotal = total }