Use base64-bytestring instead of dataenc

[Lucu.git] / Network / HTTP / Lucu / Interaction.hs

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 6b5cdae11a708ddf3c36b26e81bfd581fa572064..638d1b05bafc472f364cfb7626930f6f00a86423 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.Interaction
     ( Interaction(..)
     , InteractionState(..)
@@ -31,6 +35,7 @@ import           OpenSSL.X509
 
 data Interaction = Interaction {
       itrConfig       :: !Config
+    , itrLocalPort    :: !PortNumber
     , itrRemoteAddr   :: !SockAddr
     , itrRemoteCert   :: !(Maybe X509)
     , itrResourcePath :: !(Maybe [String])
@@ -82,10 +87,10 @@ defaultPageContentType :: Strict.ByteString
 defaultPageContentType = C8.pack "application/xhtml+xml"
 
 
-newInteraction :: Config -> SockAddr -> Maybe X509 -> Maybe Request -> IO Interaction
-newInteraction !conf !addr !cert !req
-    = do request  <- newTVarIO $ req
-         responce <- newTVarIO $ Response {
+newInteraction :: Config -> PortNumber -> SockAddr -> Maybe X509 -> Maybe Request -> IO Interaction
+newInteraction !conf !port !addr !cert !req
+    = do request  <- newTVarIO req
+         responce <- newTVarIO Response {
                        resVersion = HttpVersion 1 1
                      , resStatus  = Ok
                      , resHeaders = toHeaders [(C8.pack "Content-Type", defaultPageContentType)]
@@ -115,8 +120,9 @@ newInteraction !conf !addr !cert !req
          wroteContinue <- newTVarIO False
          wroteHeader   <- newTVarIO False
 
-         return $ Interaction {
+         return Interaction {
                       itrConfig       = conf
+                    , itrLocalPort    = port
                     , itrRemoteAddr   = addr
                     , itrRemoteCert   = cert
                     , itrResourcePath = Nothing
@@ -150,33 +156,28 @@ newInteraction !conf !addr !cert !req
 
 
 writeItr :: Interaction -> (Interaction -> TVar a) -> a -> STM ()
-writeItr itr accessor value
-    = itr `seq` accessor `seq` value `seq`
-      writeTVar (accessor itr) value
+writeItr !itr !accessor !value
+    = writeTVar (accessor itr) value
 
 
 readItr :: Interaction -> (Interaction -> TVar a) -> (a -> b) -> STM b
-readItr itr accessor reader
-    = itr `seq` accessor `seq` reader `seq`
-      readTVar (accessor itr) >>= return . reader
+readItr !itr !accessor !reader
+    = fmap reader $ readTVar (accessor itr)
 
 
 readItrF :: Functor f => Interaction -> (Interaction -> TVar (f a)) -> (a -> b) -> STM (f b)
-readItrF itr accessor reader
-    = itr `seq` accessor `seq` reader `seq`
-      readItr itr accessor (fmap reader)
+readItrF !itr !accessor !reader
+    = readItr itr accessor (fmap reader)
 {-# SPECIALIZE readItrF :: Interaction -> (Interaction -> TVar (Maybe a)) -> (a -> b) -> STM (Maybe b) #-}
 
 
 updateItr :: Interaction -> (Interaction -> TVar a) -> (a -> a) -> STM ()
-updateItr itr accessor updator
-    = itr `seq` accessor `seq` updator `seq`
-      do old <- readItr itr accessor id
+updateItr !itr !accessor !updator
+    = do old <- readItr itr accessor id
          writeItr itr accessor (updator old)
 
 
 updateItrF :: Functor f => Interaction -> (Interaction -> TVar (f a)) -> (a -> a) -> STM ()
-updateItrF itr accessor updator
-    = itr `seq` accessor `seq` updator `seq`
-      updateItr itr accessor (fmap updator)
+updateItrF !itr !accessor !updator
+    = updateItr itr accessor (fmap updator)
 {-# SPECIALIZE updateItrF :: Interaction -> (Interaction -> TVar (Maybe a)) -> (a -> a) -> STM () #-}
\ No newline at end of file