------------------------------------------------------------------------------- |-- Module : Network.CGI.Cookie-- Copyright : (c) Bjorn Bringert 2004-2005-- (c) Ian Lynagh 2005-- License : BSD-style---- Maintainer : Anders Kaseorg <andersk@mit.edu>-- Stability : experimental-- Portability : portable---- General server side HTTP cookie library.-- Based on <http://wp.netscape.com/newsref/std/cookie_spec.html>---- TODO---- * Add client side stuff (basically parsing Set-Cookie: value)---- * Update for RFC2109 <http://www.ietf.org/rfc/rfc2109.txt>-------------------------------------------------------------------------------moduleNetwork.CGI.Cookie(Cookie(..),newCookie,findCookie,deleteCookie,showCookie,readCookies)whereimportData.Char(isSpace)importData.List(intersperse)importData.Maybe(catMaybes)importSystem.Locale(defaultTimeLocale,rfc822DateFormat)importSystem.Time(CalendarTime(..),Month(..),Day(..),formatCalendarTime)---- * Types---- | Contains all information about a cookie set by the server.dataCookie=Cookie{-- | Name of the cookie.cookieName::String,-- | Value of the cookie.cookieValue::String,-- | Expiry date of the cookie. If 'Nothing', the-- cookie expires when the browser sessions ends.-- If the date is in the past, the client should-- delete the cookie immediately.cookieExpires::MaybeCalendarTime,-- | The domain suffix to which this cookie will be sent.cookieDomain::MaybeString,-- | The path to which this cookie will be sent.cookiePath::MaybeString,-- | 'True' if this cookie should only be sent using-- secure means.cookieSecure::Bool}deriving(Show,Read,Eq,Ord)---- * Constructing cookies---- | Construct a cookie with only name and value set.-- This client will expire when the browser sessions ends,-- will only be sent to the server and path which set it-- and may be sent using any means.newCookie::String-- ^ Name->String-- ^ Value->Cookie-- ^ CookienewCookienamevalue=Cookie{cookieName=name,cookieValue=value,cookieExpires=Nothing,cookieDomain=Nothing,cookiePath=Nothing,cookieSecure=False}---- * Getting and setting cookies---- | Get the value of a cookie from a string on the form-- @\"cookieName1=cookieValue1;...;cookieName2=cookieValue2\"@.-- This is the format of the @Cookie@ HTTP header.findCookie::String-- ^ Cookie name->String-- ^ Semicolon separated list of name-value pairs->MaybeString-- ^ Cookie value, if foundfindCookienames=maybeLast[cv|(cn,cv)<-readCookiess,cn==name]-- | Delete a cookie from the client by setting the cookie expiry date-- to a date in the past.deleteCookie::Cookie-- ^ Cookie to delete. The only fields that matter-- are 'cookieName', 'cookieDomain' and 'cookiePath'->CookiedeleteCookiec=c{cookieExpires=Justepoch}whereepoch=CalendarTime{ctYear=1970,ctMonth=January,ctDay=1,ctHour=0,ctMin=0,ctSec=0,ctPicosec=0,ctWDay=Thursday,ctYDay=1,ctTZName="GMT",ctTZ=0,ctIsDST=False}---- * Reading and showing cookies---- | Show a cookie on the format used as the value of the Set-Cookie header.showCookie::Cookie->StringshowCookiec=concat$intersperse"; "$showPair(cookieNamec)(cookieValuec):catMaybes[expires,path,domain,secure]whereexpires=fmap(showPair"expires".dateFmt)(cookieExpiresc)domain=fmap(showPair"domain")(cookieDomainc)path=fmap(showPair"path")(cookiePathc)secure=ifcookieSecurecthenJust"secure"elseNothingdateFmt=formatCalendarTimedefaultTimeLocalerfc822DateFormat-- | Show a name-value pair. FIXME: if the name or value-- contains semicolons, this breaks. The problem-- is that the original cookie spec does not mention-- how to do escaping or quoting. showPair::String-- ^ name->String-- ^ value->StringshowPairnamevalue=name++"="++value-- | Gets all the cookies from a Cookie: header valuereadCookies::String-- ^ String to parse->[(String,String)]-- ^ Cookie name - cookie value pairsreadCookiess=let(xs,ys)=break(=='=')(dropWhileisSpaces)(zs,ws)=break(==';')(dropWhileisSpace(drop1ys))inifnullxsthen[]else(xs,zs):readCookies(drop1ws)---- Utilities---- | Return 'Nothing' is the list is empty, otherwise return-- the last element of the list.maybeLast::[a]->MaybeamaybeLast[]=NothingmaybeLastxs=Just(lastxs)