X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=fecb81543083babe065501dc03d4d52a529cee94;hp=df5e2302d21b16da302ce833bd849a2d1a068766;hb=8cd9d79234344199a1644f661684bde3ed5e440b;hpb=51eda5b02d4528e2e240cbfc228de02b1c83799a diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs index df5e230..fecb815 100644 --- a/Network/HTTP/Lucu/Interaction.hs +++ b/Network/HTTP/Lucu/Interaction.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - DeriveDataTypeable + CPP + , DeriveDataTypeable , ExistentialQuantification , OverloadedStrings , RecordWildCards @@ -23,7 +24,6 @@ module Network.HTTP.Lucu.Interaction , InteractionQueue , mkInteractionQueue - , setResponseStatus , getCurrentDate ) where @@ -44,7 +44,9 @@ import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.Preprocess import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Response +#if defined(HAVE_SSL) import OpenSSL.X509 +#endif class Typeable i ⇒ Interaction i where toInteraction ∷ i → SomeInteraction @@ -132,7 +134,9 @@ data NormalInteraction = NI { niConfig ∷ !Config , niRemoteAddr ∷ !SockAddr +#if defined(HAVE_SSL) , niRemoteCert ∷ !(Maybe X509) +#endif , niRequest ∷ !Request , niResourcePath ∷ ![Strict.ByteString] , niExpectedContinue ∷ !Bool @@ -147,6 +151,7 @@ data NormalInteraction , niWillDiscardBody ∷ !(TVar Bool) , niWillClose ∷ !(TVar Bool) , niResponseHasCType ∷ !(TVar Bool) + -- FIXME: use TBChan Builder (in stm-chans package) , niBodyToSend ∷ !(TMVar Builder) , niState ∷ !(TVar InteractionState) @@ -171,11 +176,17 @@ data InteractionState mkNormalInteraction ∷ Config → SockAddr +#if defined(HAVE_SSL) → Maybe X509 +#endif → AugmentedRequest → [Strict.ByteString] → IO NormalInteraction +#if defined(HAVE_SSL) mkNormalInteraction config remoteAddr remoteCert (AugmentedRequest {..}) rsrcPath +#else +mkNormalInteraction config remoteAddr (AugmentedRequest {..}) rsrcPath +#endif = do receiveBodyReq ← newEmptyTMVarIO receivedBody ← newEmptyTMVarIO @@ -191,7 +202,9 @@ mkNormalInteraction config remoteAddr remoteCert (AugmentedRequest {..}) rsrcPat return NI { niConfig = config , niRemoteAddr = remoteAddr +#if defined(HAVE_SSL) , niRemoteCert = remoteCert +#endif , niRequest = arRequest , niResourcePath = rsrcPath , niExpectedContinue = arExpectedContinue @@ -216,13 +229,5 @@ type InteractionQueue = TVar (Seq SomeInteraction) mkInteractionQueue ∷ IO InteractionQueue mkInteractionQueue = newTVarIO (∅) -setResponseStatus ∷ StatusCode sc ⇒ NormalInteraction → sc → STM () -setResponseStatus (NI {..}) sc - = do res ← readTVar niResponse - let res' = res { - resStatus = fromStatusCode sc - } - writeTVar niResponse res' - getCurrentDate ∷ IO Ascii getCurrentDate = HTTP.toAscii <$> getCurrentTime