-- GhttpHS: Haskell binding to the Gnome HTTP library -*-haskell-*-
--
-- Author : Manuel M. T. Chakravarty
-- Created: 5 August 99
--
-- Version $Revision: 1.7 $ from $Date: 2000/03/02 07:22:10 $
--
-- 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
}
