@@ -1,132 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−-- | In-memory TLS session manager.
4−--
5−-- * Limitation: you can set the maximum size of the session data database.
6−-- * Automatic pruning: old session data over their lifetime are pruned automatically.
7−-- * Energy saving: no dedicate pruning thread is running when the size of session data database is zero.
8−-- * (Replay resistance: each session data is used at most once to prevent replay attacks against 0RTT early data of TLS 1.3.)
9−
10−module Network.TLS.SessionManager (
11− Config(..)
12− , defaultConfig
13− , newSessionManager
14− ) where
15−
16−import Control.Exception (assert)
17−import Control.Reaper
18−import Data.IORef
19−import Data.OrdPSQ (OrdPSQ)
20−import qualified Data.OrdPSQ as Q
21−import Network.TLS (SessionID, SessionData, SessionManager(..))
22−import qualified System.Clock as C
23−
24−import Network.TLS.Imports
25−
26−----------------------------------------------------------------
27−
28−-- | Configuration for session managers.
29−data Config = Config {
30− -- | Ticket lifetime in seconds.
31− ticketLifetime :: !Int
32− -- | Pruning delay in seconds. This is set to 'reaperDelay'.
33− , pruningDelay :: !Int
34− -- | The limit size of session data entries.
35− , dbMaxSize :: !Int
36− }
37−
38−-- | Lifetime: 1 day , delay: 10 minutes, limit: 10,000 entries.
39−defaultConfig :: Config
40−defaultConfig = Config {
41− ticketLifetime = 86400
42− , pruningDelay = 6000
43− , dbMaxSize = 10000
44− }
45−
46−----------------------------------------------------------------
47−
48−type Sec = Int64
49−type Value = (SessionData, IORef Availability)
50−type DB = OrdPSQ SessionID Sec Value
51−type Item = (SessionID, Sec, Value, Operation)
52−
53−data Operation = Add | Del
54−data Use = SingleUse | MultipleUse
55−data Availability = Fresh | Used
56−
57−----------------------------------------------------------------
58−
59−-- | Creating an in-memory session manager.
60−newSessionManager :: Config -> IO SessionManager
61−newSessionManager conf = do
62− let lifetime = fromIntegral $ ticketLifetime conf
63− maxsiz = dbMaxSize conf
64− reaper <- mkReaper defaultReaperSettings {
65− reaperEmpty = Q.empty
66− , reaperCons = cons maxsiz
67− , reaperAction = clean
68− , reaperNull = Q.null
69− , reaperDelay = pruningDelay conf * 1000000
70− }
71− return SessionManager {
72− sessionResume = resume reaper MultipleUse
73− , sessionEstablish = establish reaper lifetime
74− , sessionInvalidate = invalidate reaper
75− }
76−
77−cons :: Int -> Item -> DB -> DB
78−cons lim (k,t,v,Add) db
79− | lim <= 0 = Q.empty
80− | Q.size db == lim = case Q.minView db of
81− Nothing -> assert False $ Q.insert k t v Q.empty
82− Just (_,_,_,db') -> Q.insert k t v db'
83− | otherwise = Q.insert k t v db
84−cons _ (k,_,_,Del) db = Q.delete k db
85−
86−clean :: DB -> IO (DB -> DB)
87−clean olddb = do
88− currentTime <- C.sec <$> C.getTime C.Monotonic
89− let !pruned = snd $ Q.atMostView currentTime olddb
90− return $ merge pruned
91− where
92− ins db (k,p,v) = Q.insert k p v db
93− -- There is not 'merge' API.
94− -- We hope that newdb is smaller than pruned.
95− merge pruned newdb = foldl' ins pruned entries
96− where
97− entries = Q.toList newdb
98−
99−----------------------------------------------------------------
100−
101−establish :: Reaper DB Item -> Sec
102− -> SessionID -> SessionData -> IO ()
103−establish reaper lifetime k sd = do
104− ref <- newIORef Fresh
105− !p <- ((+ lifetime) . C.sec) <$> C.getTime C.Monotonic
106− let !v = (sd,ref)
107− reaperAdd reaper (k,p,v,Add)
108−
109−resume :: Reaper DB Item -> Use
110− -> SessionID -> IO (Maybe SessionData)
111−resume reaper use k = do
112− db <- reaperRead reaper
113− case Q.lookup k db of
114− Nothing -> return Nothing
115− Just (p,v@(sd,ref)) -> do
116− case use of
117− SingleUse -> do
118− available <- atomicModifyIORef' ref check
119− reaperAdd reaper (k,p,v,Del)
120− return $ if available then Just sd else Nothing
121− MultipleUse -> return $ Just sd
122− where
123− check Fresh = (Used,True)
124− check Used = (Used,False)
125−
126−invalidate :: Reaper DB Item
127− -> SessionID -> IO ()
128−invalidate reaper k = do
129− db <- reaperRead reaper
130− case Q.lookup k db of
131− Nothing -> return ()
132− Just (p,v) -> reaperAdd reaper (k,p,v,Del)