@@ -13,14 +13,15 @@ module Network.TLS.SessionManager (
1313 , newSessionManager
1414 ) where
1515
16+import Control.Exception (assert)
1617import Control.Reaper
1718import Data.IORef
19+import Data.Int (Int64)
1820import Data.List (foldl')
1921import Data.OrdPSQ (OrdPSQ)
2022import qualified Data.OrdPSQ as Q
21−import Data.Time (UTCTime, NominalDiffTime, getCurrentTime, addUTCTime)
2223import Network.TLS (SessionID, SessionData, SessionManager(..))
23−import Control.Exception (assert)
24+import qualified System.Clock as C
2425
2526----------------------------------------------------------------
2627
@@ -44,9 +45,10 @@ defaultConfig = Config {
4445
4546----------------------------------------------------------------
4647
48+type Sec = Int64
4749type Value = (SessionData, IORef Availability)
48−type DB = OrdPSQ SessionID UTCTime Value
49−type Item = (SessionID, UTCTime, Value, Operation)
50+type DB = OrdPSQ SessionID Sec Value
51+type Item = (SessionID, Sec, Value, Operation)
5052
5153data Operation = Add | Del
5254data Use = SingleUse | MultipleUse
@@ -83,7 +85,7 @@ cons _ (k,_,_,Del) db = Q.delete k db
8385
8486clean :: DB -> IO (DB -> DB)
8587clean olddb = do
86− currentTime <- getCurrentTime
88+ currentTime <- C.sec <$> C.getTime C.Monotonic
8789 let !pruned = snd $ Q.atMostView currentTime olddb
8890 return $ merge pruned
8991 where
@@ -96,11 +98,11 @@ clean olddb = do
9698
9799----------------------------------------------------------------
98100
99−establish :: Reaper DB Item -> NominalDiffTime
101+establish :: Reaper DB Item -> Sec
100102 -> SessionID -> SessionData -> IO ()
101103establish reaper lifetime k sd = do
102104 ref <- newIORef Fresh
103− !p <- addUTCTime lifetime <$> getCurrentTime
105+ !p <- ((+ lifetime) . C.sec) <$> C.getTime C.Monotonic
104106 let !v = (sd,ref)
105107 reaperAdd reaper (k,p,v,Add)
106108