tls-session-manager 0.1.0 → 0.1.1

raw patch · 7 files changed

+320/−173 lines, 7 filesdep +hspecdep +tls-session-managerdep ~psqueuesdep ~tlsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hspec, tls-session-manager

Dependency ranges changed: psqueues, tls

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• Network/TLS/SessionManager.hs +2/−168
• Network/TLS/SessionManager/Internal.hs +187/−0
• Network/TLS/SessionTicket.hs +6/−2
• test/SessionManagerSpec.hs +92/−0
• test/Spec.hs +1/−0
• tls-session-manager.cabal +19/−3

@@ -1,5 +1,18 @@ # ChangeLog for tls-session-manager +## 0.1.1++* Keep a TLS 1.3 session no longer than the lifetime of its ticket.+  [#604](https://github.com/haskell-tls/hs-tls/pull/604)+* Do not resume an expired session before it is pruned.+  [#604](https://github.com/haskell-tls/hs-tls/pull/604)+* Keep deletions and the size limit across pruning.+  [#604](https://github.com/haskell-tls/hs-tls/pull/604)+* Do not drop another session when a key is added again at the limit.+  [#604](https://github.com/haskell-tls/hs-tls/pull/604)+* Expose `Network.TLS.SessionManager.Internal` for testing.+  [#604](https://github.com/haskell-tls/hs-tls/pull/604)+ ## 0.1.0  * Using "ram" instead of "memory"

@@ -3,7 +3,7 @@ -- * Limitation: you can set the maximum size of the session data database. -- * Automatic pruning: old session data over their lifetime are pruned automatically. -- * Energy saving: no dedicate pruning thread is running when the size of session data database is zero.--- * Replay resistance: each session data is used at most once to prevent replay attacks against 0RTT early data of TLS 1.3.+-- * Replay resistance: for 0-RTT early data of TLS 1.3, each session data is used at most once ('sessionResumeOnlyOnce').  Other resumptions may use it again. module Network.TLS.SessionManager (     newSessionManager,     Config,@@ -13,170 +13,4 @@     dbMaxSize, ) where -import Control.Exception (assert)-import Control.Reaper-import Data.ByteArray (convert)-import Data.ByteString (ByteString)-import Data.ByteString.Short (ShortByteString)-import qualified Data.ByteString.Short as SBS-import Data.IORef-import Data.OrdPSQ (OrdPSQ)-import qualified Data.OrdPSQ as Q-import Network.TLS-import qualified System.Clock as C--import Network.TLS.Imports---------------------------------------------------------------------- | Configuration for session managers.-data Config = Config-    { ticketLifetime :: Int-    -- ^ Ticket lifetime in seconds.-    , pruningDelay :: Int-    -- ^ Pruning delay in seconds. This is set to 'reaperDelay'.-    , dbMaxSize :: Int-    -- ^ The limit size of session data entries.-    }---- | ticketLifetime: 2 hours (7200 seconds), pruningDelay: 10 minutes (600 seconds), dbMaxSize: 1000 entries.-defaultConfig :: Config-defaultConfig =-    Config-        { ticketLifetime = 7200-        , pruningDelay = 600-        , dbMaxSize = 1000-        }--------------------------------------------------------------------toKey :: ByteString -> SessionIDCopy-toKey = SBS.toShort--toValue :: SessionData -> SessionDataCopy-toValue sd =-    SessionDataCopy $-        sd-            { sessionSecret = convert $ sessionSecret sd-            , sessionALPN = convert <$> sessionALPN sd-            }--fromValue :: SessionDataCopy -> SessionData-fromValue (SessionDataCopy sd) =-    sd-        { sessionSecret = convert $ sessionSecret sd-        , sessionALPN = convert <$> sessionALPN sd-        }--------------------------------------------------------------------type SessionIDCopy = ShortByteString-newtype SessionDataCopy = SessionDataCopy SessionData-    deriving (Show, Eq)--type Sec = Int64-type Value = (SessionDataCopy, IORef Availability)-type DB = OrdPSQ SessionIDCopy Sec Value-type Item = (SessionIDCopy, Sec, Value, Operation)--data Operation = Add | Del-data Use = SingleUse | MultipleUse-data Availability = Fresh | Used---------------------------------------------------------------------- | Creating an in-memory session manager.-newSessionManager :: Config -> IO SessionManager-newSessionManager conf = do-    let lifetime = fromIntegral $ ticketLifetime conf-        maxsiz = dbMaxSize conf-    reaper <--        mkReaper-            defaultReaperSettings-                { reaperEmpty = Q.empty-                , reaperCons = cons maxsiz-                , reaperAction = clean-                , reaperNull = Q.null-                , reaperDelay = pruningDelay conf * 1000000-                , reaperThreadName = "TLS session manager"-                }-    return $-        noSessionManager-            { sessionResume = resume reaper MultipleUse-            , sessionResumeOnlyOnce = resume reaper SingleUse-            , sessionEstablish = \x y -> establish reaper lifetime x y >> return Nothing-            , sessionInvalidate = invalidate reaper-            , sessionUseTicket = False-            }--cons :: Int -> Item -> DB -> DB-cons lim (k, t, v, Add) db-    | lim <= 0 = Q.empty-    | Q.size db == lim = case Q.minView db of-        Nothing -> assert False $ Q.insert k t v Q.empty-        Just (_, _, _, db') -> Q.insert k t v db'-    | otherwise = Q.insert k t v db-cons _ (k, _, _, Del) db = Q.delete k db--clean :: DB -> IO (DB -> DB)-clean olddb = do-    currentTime <- C.sec <$> C.getTime C.Monotonic-    let pruned = snd $ Q.atMostView currentTime olddb-    return $ merge pruned-  where-    ins db (k, p, v) = Q.insert k p v db-    -- There is not 'merge' API.-    -- We hope that newdb is smaller than pruned.-    merge pruned newdb = foldl' ins pruned entries-      where-        entries = Q.toList newdb--------------------------------------------------------------------establish-    :: Reaper DB Item-    -> Sec-    -> SessionID-    -> SessionData-    -> IO ()-establish reaper lifetime k sd = do-    ref <- newIORef Fresh-    p <- (+ lifetime) . C.sec <$> C.getTime C.Monotonic-    let v = (sd', ref)-    reaperAdd reaper (k', p, v, Add)-  where-    k' = toKey k-    sd' = toValue sd--resume-    :: Reaper DB Item-    -> Use-    -> SessionID-    -> IO (Maybe SessionData)-resume reaper use k = do-    db <- reaperRead reaper-    case Q.lookup k' db of-        Nothing -> return Nothing-        Just (p, v@(sd, ref)) ->-            case use of-                SingleUse -> do-                    available <- atomicModifyIORef' ref check-                    reaperAdd reaper (k', p, v, Del)-                    return $ if available then Just (fromValue sd) else Nothing-                MultipleUse -> return $ Just (fromValue sd)-  where-    check Fresh = (Used, True)-    check Used = (Used, False)-    k' = toKey k--invalidate-    :: Reaper DB Item-    -> SessionID-    -> IO ()-invalidate reaper k = do-    db <- reaperRead reaper-    case Q.lookup k' db of-        Nothing -> return ()-        Just (p, v) -> reaperAdd reaper (k', p, v, Del)-  where-    k' = toKey k+import Network.TLS.SessionManager.Internal

@@ -0,0 +1,187 @@+-- | The implementation of "Network.TLS.SessionManager", exposed for+-- testing.  This module may change without notice.+module Network.TLS.SessionManager.Internal where++import Control.Exception (assert)+import Control.Reaper+import Data.ByteArray (convert)+import Data.ByteString (ByteString)+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as SBS+import Data.IORef+import Data.OrdPSQ (OrdPSQ)+import qualified Data.OrdPSQ as Q+import Network.TLS+import qualified Network.TLS.Internal as I+import qualified System.Clock as C++import Network.TLS.Imports++----------------------------------------------------------------++-- | Configuration for session managers.+data Config = Config+    { ticketLifetime :: Int+    -- ^ Ticket lifetime in seconds.  It should match 'serverTicketLifetime'+    -- on a server.  A TLS 1.3 session is kept no longer than the lifetime of+    -- its ticket.+    , pruningDelay :: Int+    -- ^ Pruning delay in seconds. This is set to 'reaperDelay'.+    , dbMaxSize :: Int+    -- ^ The limit size of session data entries.+    }++-- | ticketLifetime: 2 hours (7200 seconds), pruningDelay: 10 minutes (600 seconds), dbMaxSize: 1000 entries.+defaultConfig :: Config+defaultConfig =+    Config+        { ticketLifetime = 7200+        , pruningDelay = 600+        , dbMaxSize = 1000+        }++----------------------------------------------------------------++toKey :: ByteString -> SessionIDCopy+toKey = SBS.toShort++toValue :: SessionData -> SessionDataCopy+toValue sd =+    SessionDataCopy $+        sd+            { sessionSecret = convert $ sessionSecret sd+            , sessionALPN = convert <$> sessionALPN sd+            }++fromValue :: SessionDataCopy -> SessionData+fromValue (SessionDataCopy sd) =+    sd+        { sessionSecret = convert $ sessionSecret sd+        , sessionALPN = convert <$> sessionALPN sd+        }++----------------------------------------------------------------++type SessionIDCopy = ShortByteString+newtype SessionDataCopy = SessionDataCopy SessionData+    deriving (Show, Eq)++type Sec = Int64+type Value = (SessionDataCopy, IORef Availability)+type Sessions = OrdPSQ SessionIDCopy Sec Value++-- | The sessions, and the keys deleted since the reaper last took them away+-- to prune.  While it prunes, the workload left in their place is empty, so+-- a deletion there is kept to be applied to the pruned sessions too.+data DB = DB Sessions [SessionIDCopy]++data Item = Add SessionIDCopy Sec Value | Del SessionIDCopy++data Use = SingleUse | MultipleUse+data Availability = Fresh | Used++----------------------------------------------------------------++-- | Creating an in-memory session manager.+newSessionManager :: Config -> IO SessionManager+newSessionManager conf = do+    let lifetime = fromIntegral $ ticketLifetime conf+        maxsiz = dbMaxSize conf+    reaper <-+        mkReaper+            defaultReaperSettings+                { reaperEmpty = DB Q.empty []+                , reaperCons = cons maxsiz+                , reaperAction = clean maxsiz+                , reaperNull = \(DB q _) -> Q.null q+                , reaperDelay = pruningDelay conf * 1000000+                , reaperThreadName = "TLS session manager"+                }+    return $+        noSessionManager+            { sessionResume = resume reaper MultipleUse+            , sessionResumeOnlyOnce = resume reaper SingleUse+            , sessionEstablish = \x y -> establish reaper lifetime x y >> return Nothing+            , sessionInvalidate = invalidate reaper+            , sessionUseTicket = False+            }++cons :: Int -> Item -> DB -> DB+cons lim (Add k t v) (DB q ds)+    | lim <= 0 = DB Q.empty ds+    -- Replacing a session makes no room for it.+    | Q.size q == lim && not (Q.member k q) = case Q.minView q of+        Nothing -> assert False $ DB (Q.insert k t v Q.empty) ds+        Just (_, _, _, q') -> DB (Q.insert k t v q') ds+    | otherwise = DB (Q.insert k t v q) ds+-- At most as many keys as there can be sessions are kept.+cons lim (Del k) (DB q ds) = DB (Q.delete k q) (take lim (k : ds))++clean :: Int -> DB -> IO (DB -> DB)+clean lim (DB oldq _) = do+    currentTime <- C.sec <$> C.getTime C.Monotonic+    let pruned = snd $ Q.atMostView currentTime oldq+    return $ merge pruned+  where+    ins q (k, p, v) = Q.insert k p v q+    -- There is not 'merge' API.+    -- We hope that the new sessions are fewer than the pruned ones.+    merge pruned (DB newq ds) = DB (limit $ foldl' ins (foldr Q.delete pruned ds) entries) []+      where+        entries = Q.toList newq+    -- The size was checked against the new sessions alone.+    limit q+        | lim <= 0 = Q.empty+        | Q.size q > lim = maybe q (\(_, _, _, q') -> limit q') $ Q.minView q+        | otherwise = q++----------------------------------------------------------------++establish+    :: Reaper DB Item+    -> Sec+    -> SessionID+    -> SessionData+    -> IO ()+establish reaper lifetime k sd = do+    ref <- newIORef Fresh+    p <- (+ lifetime') . C.sec <$> C.getTime C.Monotonic+    let v = (sd', ref)+    reaperAdd reaper (Add k' p v)+  where+    k' = toKey k+    sd' = toValue sd+    -- A TLS 1.3 ticket is not kept past the lifetime the server gave it.+    lifetime' = case sessionTicketInfo sd of+        Just tinfo -> min lifetime (fromIntegral (I.lifetime tinfo))+        Nothing -> lifetime++resume+    :: Reaper DB Item+    -> Use+    -> SessionID+    -> IO (Maybe SessionData)+resume reaper use k = do+    DB q _ <- reaperRead reaper+    now <- C.sec <$> C.getTime C.Monotonic+    case Q.lookup k' q of+        -- An expired session stays until the next pruning; it is not used.+        Just (p, (sd, ref))+            | p > now -> case use of+                SingleUse -> do+                    available <- atomicModifyIORef' ref check+                    reaperAdd reaper (Del k')+                    return $ if available then Just (fromValue sd) else Nothing+                MultipleUse -> return $ Just (fromValue sd)+        _ -> return Nothing+  where+    check Fresh = (Used, True)+    check Used = (Used, False)+    k' = toKey k++invalidate+    :: Reaper DB Item+    -> SessionID+    -> IO ()+-- Not looked up first: while the reaper prunes, the session is not seen.+invalidate reaper k = reaperAdd reaper (Del (toKey k))

@@ -28,8 +28,12 @@ -- | Configuration for session tickets. data Config = Config     { ticketLifetime :: Int-    -- ^ Ticket lifetime in seconds.+    -- ^ Ticket lifetime in seconds.  It should match the lifetime the+    -- server announces, 'serverTicketLifetime'.  As the secret keys are+    -- replaced every 'secretKeyInterval', a ticket is accepted for up to+    -- one interval less.     , secretKeyInterval :: Int+    -- ^ The interval to replace the secret key in seconds.     }  -- | ticketLifetime: 2 hours (7200 seconds), secretKeyInterval: 30 minutes (1800 seconds)@@ -37,7 +41,7 @@ defaultConfig =     Config         { ticketLifetime = 7200 -- 2 hours-        , secretKeyInterval = 1800 -- 30 minites+        , secretKeyInterval = 1800 -- 30 minutes         }  -- | Creating a session ticket manager.

@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module SessionManagerSpec where++import Control.Concurrent (threadDelay)+import Data.IORef+import Data.Maybe (isJust, isNothing)+import qualified Data.OrdPSQ as Q+import Network.TLS+import Network.TLS.Internal (Second, SessionData (..), TLS13TicketInfo (..))+import Network.TLS.SessionManager+import Network.TLS.SessionManager.Internal (+    Availability (..),+    DB (..),+    Item (..),+    clean,+    cons,+    toValue,+ )+import Test.Hspec++spec :: Spec+spec = do+    describe "newSessionManager" $ do+        it "keeps a TLS 1.3 session no longer than its ticket lifetime" $ do+            mgr <- newSessionManager defaultConfig+            _ <- sessionEstablish mgr "short" $ sessionData (Just 1)+            _ <- sessionEstablish mgr "none" $ sessionData Nothing+            threadDelay 2000000+            sessionResume mgr "short" >>= (`shouldSatisfy` isNothing)+            sessionResume mgr "none" >>= (`shouldSatisfy` isJust)+        it "does not resume an expired session before it is pruned" $ do+            mgr <- newSessionManager defaultConfig{ticketLifetime = 1}+            _ <- sessionEstablish mgr "expired" $ sessionData Nothing+            threadDelay 2000000+            sessionResume mgr "expired" >>= (`shouldSatisfy` isNothing)+        it "keeps the other session when a key is added again at the limit" $ do+            mgr <- newSessionManager defaultConfig{dbMaxSize = 2}+            -- "a" comes first both by expiry and by key, so it would be the+            -- one dropped for room+            _ <- sessionEstablish mgr "a" $ sessionData (Just 1800)+            _ <- sessionEstablish mgr "b" $ sessionData (Just 3600)+            _ <- sessionEstablish mgr "b" $ sessionData (Just 3600)+            sessionResume mgr "a" >>= (`shouldSatisfy` isJust)+        it "does not resume an invalidated session" $ do+            mgr <- newSessionManager defaultConfig+            _ <- sessionEstablish mgr "a" $ sessionData Nothing+            sessionInvalidate mgr "a"+            sessionResume mgr "a" >>= (`shouldSatisfy` isNothing)+        it "resumes a session only once for 0-RTT" $ do+            mgr <- newSessionManager defaultConfig+            _ <- sessionEstablish mgr "a" $ sessionData Nothing+            sessionResumeOnlyOnce mgr "a" >>= (`shouldSatisfy` isJust)+            sessionResumeOnlyOnce mgr "a" >>= (`shouldSatisfy` isNothing)+    -- While the reaper prunes, the sessions are taken away and an empty+    -- workload is left in their place; the pruned ones are merged back.+    describe "pruning" $ do+        it "keeps a deletion made while pruning" $ do+            v <- value+            merge <- clean 2 $ foldr (cons 2) (DB Q.empty []) [Add "a" far v, Add "b" far v]+            let DB q _ = merge $ cons 2 (Del "a") (DB Q.empty [])+            Q.member "a" q `shouldBe` False+            Q.member "b" q `shouldBe` True+        it "keeps the size limit when merging" $ do+            v <- value+            merge <- clean 2 $ foldr (cons 2) (DB Q.empty []) [Add "a" far v, Add "b" far v]+            let DB q _ = merge $ cons 2 (Add "c" far v) (DB Q.empty [])+            Q.size q `shouldBe` 2+  where+    far = maxBound `div` 2+    value = do+        ref <- newIORef Fresh+        return (toValue (sessionData Nothing), ref)++-- | Session data with a TLS 1.3 ticket of the given lifetime, if any.+sessionData :: Maybe Second -> SessionData+sessionData life =+    SessionData+        { sessionVersion = TLS13+        , sessionCipher = 0x1301+        , sessionCompression = 0+        , sessionClientSNI = Nothing+        , sessionSecret = "secret"+        , sessionGroup = Nothing+        , sessionTicketInfo = ticketInfo <$> life+        , sessionALPN = Nothing+        , sessionMaxEarlyDataSize = 0+        , sessionFlags = []+        }+  where+    ticketInfo l =+        TLS13TicketInfo{lifetime = l, ageAdd = 0, txrxTime = 0, estimatedRTT = Nothing}

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -1,6 +1,6 @@-cabal-version:      >=1.10+cabal-version:      2.0 name:               tls-session-manager-version:            0.1.0+version:            0.1.1 license:            BSD3 license-file:       LICENSE maintainer:         kazu@iij.ad.jp@@ -15,6 +15,7 @@  library     exposed-modules:  Network.TLS.SessionManager+                      Network.TLS.SessionManager.Internal                       Network.TLS.SessionTicket     other-modules:    Network.TLS.Imports     default-language: Haskell2010@@ -28,7 +29,22 @@         psqueues >= 0.2 && < 0.3,         ram,         serialise >= 0.2 && < 0.3,-        tls >= 2.3 && < 2.4+        tls >= 2.3 && < 2.6      if impl(ghc >=8)         default-extensions: Strict StrictData++test-suite spec+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    hs-source-dirs:     test+    other-modules:      SessionManagerSpec+    default-language:   Haskell2010+    ghc-options:        -Wall -threaded+    build-tool-depends: hspec-discover:hspec-discover+    build-depends:+        base >=4.7 && <5,+        hspec,+        psqueues,+        tls,+        tls-session-manager