, mkInteractionQueue
, getCurrentDate
+ , formatUTCTime
)
where
import Blaze.ByteString.Builder (Builder)
import Control.Concurrent.STM
import Data.Ascii (Ascii)
import Data.ByteString (ByteString)
+import Data.Convertible.Base
import Data.Monoid.Unicode
import Data.Sequence (Seq)
+import Data.Tagged
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
import Network.HTTP.Lucu.Preprocess
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
import Network.HTTP.Lucu.Utils
#if defined(HAVE_SSL)
import OpenSSL.X509
#endif
+import Prelude.Unicode
class Typeable i ⇒ Interaction i where
toInteraction ∷ i → SomeInteraction
, seiResponse ∷ !Response
, seiWillChunkBody ∷ !Bool
- , seiWillDiscardBody ∷ !Bool
, seiWillClose ∷ !Bool
, seiBodyToSend ∷ !Builder
}
, seiResponse = res
, seiWillChunkBody = arWillChunkBody
- , seiWillDiscardBody = arWillDiscardBody
, seiWillClose = arWillClose
, seiBodyToSend = body
}
, niResponse ∷ !(TVar Response)
, niSendContinue ∷ !(TMVar Bool)
, niWillChunkBody ∷ !Bool
- , niWillDiscardBody ∷ !(TVar Bool)
, niWillClose ∷ !(TVar Bool)
, niResponseHasCType ∷ !(TVar Bool)
-- FIXME: use TBChan Builder (in stm-chans package)
response ← newTVarIO $ emptyResponse arInitialStatus
sendContinue ← newEmptyTMVarIO
- willDiscardBody ← newTVarIO arWillDiscardBody
willClose ← newTVarIO arWillClose
responseHasCType ← newTVarIO False
bodyToSend ← newEmptyTMVarIO
, niResponse = response
, niSendContinue = sendContinue
, niWillChunkBody = arWillChunkBody
- , niWillDiscardBody = willDiscardBody
, niWillClose = willClose
, niResponseHasCType = responseHasCType
, niBodyToSend = bodyToSend
type InteractionQueue = TVar (Seq SomeInteraction)
mkInteractionQueue ∷ IO InteractionQueue
+{-# INLINE mkInteractionQueue #-}
mkInteractionQueue = newTVarIO (∅)
getCurrentDate ∷ IO Ascii
-getCurrentDate = HTTP.toAscii <$> getCurrentTime
+{-# INLINE getCurrentDate #-}
+getCurrentDate = formatUTCTime <$> getCurrentTime
+
+formatUTCTime ∷ UTCTime → Ascii
+{-# INLINE formatUTCTime #-}
+formatUTCTime = cs' ∘ Tagged
+ where
+ cs' ∷ Tagged HTTP UTCTime → Ascii
+ cs' = cs