{-# LANGUAGE FlexibleInstances #-}moduleHappstack.Server.Internal.MessageWrap(moduleHappstack.Server.Internal.MessageWrap,defaultInputIter)whereimportControl.Concurrent.MVar(tryTakeMVar,tryPutMVar,putMVar)importControl.Monad.Trans(MonadIO(liftIO))importqualifiedData.ByteString.Char8asPimportqualifiedData.ByteString.Lazy.Char8asLimportData.MaybeimportData.Int(Int64)importHappstack.Server.Internal.TypesasHimportHappstack.Server.Internal.MultipartimportHappstack.Server.Internal.RFC822Headers(parseContentType)importHappstack.Server.SURIasSURIqueryInput::SURI->[(String,Input)]queryInputuri=formDecode(caseSURI.queryuriof'?':r->rxs->xs)-- | see 'defaultBodyPolicy'dataBodyPolicy=BodyPolicy{inputWorker::Int64->Int64->Int64->InputWorker,maxDisk::Int64-- ^ maximum bytes for files uploaded in this 'Request',maxRAM::Int64-- ^ maximum bytes for all non-file values in the 'Request' body,maxHeader::Int64-- ^ maximum bytes of overhead for headers in @multipart/form-data@}-- | create a 'BodyPolicy' for use with decodeBodydefaultBodyPolicy::FilePath-- ^ temporary directory for file uploads->Int64-- ^ maximum bytes for files uploaded in this 'Request'->Int64-- ^ maximum bytes for all non-file values in the 'Request' body->Int64-- ^ maximum bytes of overhead for headers in @multipart/form-data@->BodyPolicydefaultBodyPolicytmpDirmdmrmh=BodyPolicy{inputWorker=defaultInputIterdefaultFileSavertmpDir000,maxDisk=md,maxRAM=mr,maxHeader=mh}bodyInput::(MonadIOm)=>BodyPolicy->Request->m([(String,Input)],MaybeString)bodyInput_req|((rqMethodreq/=POST)&&(rqMethodreq/=PUT))||(not(isDecodablectype))=do_<-liftIO$tryPutMVar(rqInputsBodyreq)[]return([],Nothing)wherectype::MaybeContentTypectype=parseContentType.P.unpack=<<getHeader"content-type"reqisDecodable::MaybeContentType->BoolisDecodableNothing=True-- assume it is application/x-www-form-urlencodedisDecodable(Just(ContentType"application""x-www-form-urlencoded"_))=TrueisDecodable(Just(ContentType"multipart""form-data"ps))=TrueisDecodable(Just_)=FalsebodyInputbodyPolicyreq=liftIO$doletgetBS(Bodybs)=bsctype=parseContentType.P.unpack=<<getHeader"content-type"reqmbi<-tryTakeMVar(rqInputsBodyreq)casembiof(Justbi)->doputMVar(rqInputsBodyreq)bireturn(bi,Nothing)Nothing->dorqBody<-takeRequestBodyreqcaserqBodyofNothing->return([],Just$"bodyInput: Request body was already consumed.")(Just(Bodybs))->dor@(inputs,err)<-decodeBodybodyPolicyctypebsputMVar(rqInputsBodyreq)inputsreturnr-- | Decodes application\/x-www-form-urlencoded inputs. -- TODO: should any of the [] be error conditions?formDecode::String->[(String,Input)]formDecode[]=[]formDecodeqString=ifnullpairStringthenrestelse(SURI.unEscapename,simpleInput$SURI.unEscapeval):restwhere(pairString,qString')=split(=='&')qString(name,val)=split(=='=')pairStringrest=ifnullqString'then[]elseformDecodeqString'-- FIXME: no size limits on application/x-www-form-urlencoded yet-- FIXME: is usend L.unpack really the right thing to dodecodeBody::BodyPolicy->MaybeContentType->L.ByteString->IO([(String,Input)],MaybeString)decodeBodybpctypeinp=casectypeofJust(ContentType"application""x-www-form-urlencoded"_)->return(formDecode(L.unpack(L.take(maxRAMbp)inp)),Nothing)Just(ContentType"multipart""form-data"ps)->multipartDecode((inputWorkerbp)(maxDiskbp)(maxRAMbp)(maxHeaderbp))psinpJustct->return([],Just$"decodeBody: unsupported content-type: "++showct)-- unknown content-type, the user will have to-- deal with it by looking at the raw content-- No content-type given, assume x-www-form-urlencodedNothing->return(formDecode(L.unpack(L.take(maxRAMbp)inp)),Nothing)-- | Decodes multipart\/form-data input.multipartDecode::InputWorker->[(String,String)]-- ^ Content-type parameters->L.ByteString-- ^ Request body->IO([(String,Input)],MaybeString)-- ^ Input variables and values.multipartDecodeinputWorkerpsinp=caselookup"boundary"psofJustb->multipartBodyinputWorker(L.packb)inpNothing->return([],Just$"boundary not found in parameters: "++showps)-- | Get the path components from a String.pathEls::String->[String]pathEls=(drop1).mapSURI.unEscape.splitList'/'-- | Repeadly splits a list by the provided separator and collects the resultssplitList::Eqa=>a->[a]->[[a]]splitList_[]=[]splitListseplist=h:splitListseptwhere(h,t)=split(==sep)list-- | Repeatedly splits a list and collects the resultssplitListBy::(a->Bool)->[a]->[[a]]splitListBy_[]=[]splitListByflist=h:splitListByftwhere(h,t)=splitflist-- | Split is like break, but the matching element is dropped.split::(a->Bool)->[a]->([a],[a])splitfs=(left,right)where(left,right')=breakfsright=ifnullright'then[]elsetailright'