import Control.Concurrent.STM
import Data.Ascii (Ascii)
import Data.ByteString (ByteString)
+import Data.Convertible.Base
import Data.Monoid.Unicode
+import Data.Proxy
import Data.Sequence (Seq)
import Data.Time
-import qualified Data.Time.HTTP as HTTP
+import Data.Time.Format.HTTP
import Data.Typeable
import Network.Socket
import Network.HTTP.Lucu.Config
#if defined(HAVE_SSL)
import OpenSSL.X509
#endif
+import Prelude.Unicode
class Typeable i ⇒ Interaction i where
toInteraction ∷ i → SomeInteraction
mkSyntacticallyInvalidInteraction ∷ Config
→ IO SyntacticallyInvalidInteraction
-mkSyntacticallyInvalidInteraction config@(Config {..})
+mkSyntacticallyInvalidInteraction conf@(Config {..})
= do date ← getCurrentDate
let res = setHeader "Server" cnfServerSoftware $
setHeader "Date" date $
setHeader "Content-Type" defaultPageContentType $
emptyResponse BadRequest
- body = getDefaultPage config Nothing res
+ body = defaultPageForResponse conf Nothing res
return SYI {
syiResponse = res
, syiBodyToSend = body
let res = setHeader "Server" cnfServerSoftware $
setHeader "Date" date $
setHeader "Content-Type" defaultPageContentType $
+ ( if arWillChunkBody
+ then setHeader "Transfer-Encoding" "chunked"
+ else id
+ ) $
+ ( if arWillClose
+ then setHeader "Connection" "close"
+ else id
+ ) $
emptyResponse arInitialStatus
- body = getDefaultPage config (Just arRequest) res
+ body = defaultPageForResponse config (Just arRequest) res
return SEI {
seiRequest = arRequest
, seiExpectedContinue = arExpectedContinue
, niRemoteCert ∷ !(Maybe X509)
#endif
, niRequest ∷ !Request
- , niResourcePath ∷ !PathSegments
+ , niResourcePath ∷ !Path
, niExpectedContinue ∷ !Bool
, niReqBodyLength ∷ !(Maybe RequestBodyLength)
→ Maybe X509
#endif
→ AugmentedRequest
- → PathSegments
+ → Path
→ IO NormalInteraction
#if defined(HAVE_SSL)
mkNormalInteraction config remoteAddr remoteCert (AugmentedRequest {..}) rsrcPath
type InteractionQueue = TVar (Seq SomeInteraction)
mkInteractionQueue ∷ IO InteractionQueue
+{-# INLINE mkInteractionQueue #-}
mkInteractionQueue = newTVarIO (∅)
getCurrentDate ∷ IO Ascii
-getCurrentDate = HTTP.toAscii <$> getCurrentTime
+{-# INLINE getCurrentDate #-}
+getCurrentDate = flip proxy http ∘ cs <$> getCurrentTime