-- ------------------------------------------------------------------------------- Copyright 2002, Simon Marlow.-- Copyright 2006, Bjorn Bringert.-- Copyright 2009, Henning Thielemann.-- All rights reserved.---- Redistribution and use in source and binary forms, with or without-- modification, are permitted provided that the following conditions are-- met:---- * Redistributions of source code must retain the above copyright notice,-- this list of conditions and the following disclaimer.---- * Redistributions in binary form must reproduce the above copyright-- notice, this list of conditions and the following disclaimer in the-- documentation and/or other materials provided with the distribution.---- * Neither the name of the copyright holder(s) nor the names of-- contributors may be used to endorse or promote products derived from-- this software without specific prior written permission.---- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-- -----------------------------------------------------------------------------moduleNetwork.MoHWS.Logger.Access(Handle,Request(..),start,stop,mkRequest,log,)whereimportqualifiedNetwork.MoHWS.LoggerasLoggerimportqualifiedNetwork.MoHWS.HTTP.HeaderasHeaderimportqualifiedNetwork.MoHWS.HTTP.ResponseasResponseimportqualifiedNetwork.MoHWS.Server.RequestasServerRequestimportNetwork.MoHWS.Utility(formatTimeSensibly,)importNetwork.BSD(HostEntry,hostName,)importqualifiedNetwork.SocketasSocketimportSystem.Time(ClockTime,toUTCTime,getClockTime,TimeDiff,timeDiffToString,)importControl.Monad(liftM,liftM2,)importPreludehiding(log,)typeHandle=Logger.HandleRequest{-
FIXME:
Instead of using body type ()
we should have data structures for the Response and Request headers
without the body,
like ResponseData and RequestData that are internally used in Network.HTTP.
-}dataRequest=Request{request::ServerRequest.T(),response::Response.T(),serverHost::HostEntry,time::ClockTime,delay::TimeDiff}start::String->FilePath->IOHandlestartformatfile=Logger.start(mkLineformat)file{-
Instead of the class we could just use IO monad,
but I like to make explicit,
what are the functions that force us to do IO.
-}classMonadm=>Helpmwhereinet_ntoa::Socket.HostAddress->mStringinstanceHelpIOwhereinet_ntoa=Socket.inet_ntoainfixr5+^+,^:(+^+)::Monadm=>m[a]->m[a]->m[a](+^+)=liftM2(++)(^:)::Monadm=>a->m[a]->m[a](^:)x=liftM(x:)mkLine::Helpm=>String->Request->mStringmkLine""_=return""mkLine('%':'{':rest)r=casespan(/='}')restof(str,'}':c:rest1)->expand(Juststr)cr+^+mkLinerest1r_->'%'^:'{'^:mkLinerestrmkLine('%':c:rest)r=expandNothingcr+^+mkLinerestrmkLine(c:rest)r=c^:mkLinerestrexpand::Helpm=>MaybeString->Char->Request->mStringexpandargcinfo=letresp=responseinfosreq=requestinforeq=ServerRequest.clientRequestsreq-- host = clientName (log_request info)header_Nothing=""headerx(Justn)=unwords(Header.lookupMany(Header.makeNamen)x)addr=inet_ntoa(ServerRequest.clientAddresssreq)incasecof'b'->return$maybe"unknown"show$Response.size(Response.bodyresp)'f'->return$ServerRequest.serverFilenamesreq-- %h is the hostname if hostnameLookups is on, otherwise the-- IP address.'h'->maybeaddr(return.hostName)(ServerRequest.clientNamesreq)'a'->addr'l'->return"-"-- FIXME: does anyone use identd these days?'r'->return$showreq-- ToDo: 'p' -> canonical port number of server's'->return$show(Response.coderesp)'t'->return$formatTimeSensibly(toUTCTime(timeinfo))'T'->return$timeDiffToString(delayinfo)'v'->return$hostName(serverHostinfo)'u'->return"-"-- FIXME: implement HTTP auth'i'->return$headerreqarg'o'->return$headerresparg-- ToDo: other stuff_->return['%',c]stop::Handle->IO()stopl=Logger.stoplmkRequest::ServerRequest.Tbody->Response.Tbody->HostEntry->TimeDiff->IORequestmkRequestreqresphostdelay0=dotime0<-getClockTimereturn$Request{request=fmap(const())req,response=fmap(const())resp,serverHost=host,time=time0,delay=delay0}log::Handle->Request->IO()loglr=Logger.loglr