tls-session-manager 0.0.4 → 0.0.5
raw patch · 5 files changed
+220/−158 lines, 5 filesdep +crypto-tokendep +serialisedep ~auto-updatedep ~basementdep ~bytestringsetup-changed
Dependencies added: crypto-token, serialise
Dependency ranges changed: auto-update, basement, bytestring, clock, memory, psqueues, tls
Files
- Network/TLS/Imports.hs +8/−8
- Network/TLS/SessionManager.hs +101/−121
- Network/TLS/SessionTicket.hs +77/−0
- Setup.hs +1/−0
- tls-session-manager.cabal +33/−29
Network/TLS/Imports.hs view
@@ -1,12 +1,12 @@ module Network.TLS.Imports (- module Control.Applicative- , module Control.Monad- , module Data.Int- , module Data.List- , module Data.Maybe- , module Data.Monoid- , module Data.Word- ) where+ module Control.Applicative,+ module Control.Monad,+ module Data.Int,+ module Data.List,+ module Data.Maybe,+ module Data.Monoid,+ module Data.Word,+) where import Control.Applicative import Control.Monad
Network/TLS/SessionManager.hs view
@@ -1,31 +1,27 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}---- | In-memory TLS session manager.+-- | In-memory TLS 1.2/1.3 session manager. -- -- * 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: each session data is used at most once to prevent replay attacks against 0RTT early data of TLS 1.3. module Network.TLS.SessionManager (- Config(..)- , defaultConfig- , newSessionManager- ) where+ newSessionManager,+ Config,+ defaultConfig,+ ticketLifetime,+ pruningDelay,+ dbMaxSize,+) where import Basement.Block (Block)-import Data.ByteArray (convert) import Control.Exception (assert) import Control.Reaper+import Data.ByteArray (convert) import Data.ByteString (ByteString) import Data.IORef import Data.OrdPSQ (OrdPSQ) import qualified Data.OrdPSQ as Q import Network.TLS-#if !MIN_VERSION_tls(1,5,0)-import Network.TLS.Compression-#endif import qualified System.Clock as C import Network.TLS.Imports@@ -33,22 +29,23 @@ ---------------------------------------------------------------- -- | Configuration for session managers.-data Config = Config {- -- | Ticket lifetime in seconds.- ticketLifetime :: !Int- -- | Pruning delay in seconds. This is set to 'reaperDelay'.- , pruningDelay :: !Int- -- | The limit size of session data entries.- , dbMaxSize :: !Int+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. } --- | Lifetime: 1 day , delay: 10 minutes, max size: 1000 entries.+-- | ticketLifetime: 2 hours (7200 seconds), pruningDelay: 10 minutes (600 seconds), dbMaxSize: 1000 entries. defaultConfig :: Config-defaultConfig = Config {- ticketLifetime = 86400- , pruningDelay = 6000- , dbMaxSize = 1000- }+defaultConfig =+ Config+ { ticketLifetime = 7200+ , pruningDelay = 600+ , dbMaxSize = 1000+ } ---------------------------------------------------------------- @@ -56,62 +53,35 @@ toKey = convert toValue :: SessionData -> SessionDataCopy-#if MIN_VERSION_tls(1,5,0)-#if MIN_VERSION_tls(1,5,3) toValue (SessionData v cid comp msni sec mg mti malpn siz flg) = SessionDataCopy v cid comp msni sec' mg mti malpn' siz flg-#else-toValue (SessionData v cid comp msni sec mg mti malpn siz) =- SessionDataCopy v cid comp msni sec' mg mti malpn' siz-#endif where- !sec' = convert sec- !malpn' = convert <$> malpn-#else-toValue (SessionData v cid comp msni sec) =- SessionDataCopy v cid comp msni sec'- where- !sec' = convert sec-#endif+ sec' = convert sec+ malpn' = convert <$> malpn fromValue :: SessionDataCopy -> SessionData-#if MIN_VERSION_tls(1,5,0)-#if MIN_VERSION_tls(1,5,3) fromValue (SessionDataCopy v cid comp msni sec' mg mti malpn' siz flg) = SessionData v cid comp msni sec mg mti malpn siz flg-#else-fromValue (SessionDataCopy v cid comp msni sec' mg mti malpn' siz) =- SessionData v cid comp msni sec mg mti malpn siz-#endif where- !sec = convert sec'- !malpn = convert <$> malpn'-#else-fromValue (SessionDataCopy v cid comp msni sec') =- SessionData v cid comp msni sec- where- !sec = convert sec'-#endif+ sec = convert sec'+ malpn = convert <$> malpn' ---------------------------------------------------------------- type SessionIDCopy = Block Word8-data SessionDataCopy = SessionDataCopy- {- ssVersion -} !Version- {- ssCipher -} !CipherID- {- ssCompression -} !CompressionID- {- ssClientSNI -} !(Maybe HostName)- {- ssSecret -} (Block Word8)-#if MIN_VERSION_tls(1,5,0)- {- ssGroup -} !(Maybe Group)- {- ssTicketInfo -} !(Maybe TLS13TicketInfo)- {- ssALPN -} !(Maybe (Block Word8))- {- ssMaxEarlyDataSize -} Int-#endif-#if MIN_VERSION_tls(1,5,3)- {- ssFlags -} [SessionFlag]-#endif- deriving (Show,Eq)+data SessionDataCopy+ = SessionDataCopy+ {- ssVersion -} Version+ {- ssCipher -} CipherID+ {- ssCompression -} CompressionID+ {- ssClientSNI -} (Maybe HostName)+ {- ssSecret -} (Block Word8)+ {- ssGroup -} (Maybe Group)+ {- ssTicketInfo -} (Maybe TLS13TicketInfo)+ {- ssALPN -} (Maybe (Block Word8))+ {- ssMaxEarlyDataSize -} Int+ {- ssFlags -} [SessionFlag]+ deriving (Show, Eq) type Sec = Int64 type Value = (SessionDataCopy, IORef Availability)@@ -129,39 +99,40 @@ 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- }- return SessionManager {- sessionResume = resume reaper MultipleUse-#if MIN_VERSION_tls(1,5,0)- , sessionResumeOnlyOnce = resume reaper SingleUse-#endif- , sessionEstablish = establish reaper lifetime- , sessionInvalidate = invalidate reaper-- }+ reaper <-+ mkReaper+ defaultReaperSettings+ { reaperEmpty = Q.empty+ , reaperCons = cons maxsiz+ , reaperAction = clean+ , reaperNull = Q.null+ , reaperDelay = pruningDelay conf * 1000000+ }+ return+ SessionManager+ { 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+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+ let pruned = snd $ Q.atMostView currentTime olddb return $ merge pruned where- ins db (k,p,v) = Q.insert k p v db+ 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@@ -170,41 +141,50 @@ ---------------------------------------------------------------- -establish :: Reaper DB Item -> Sec- -> SessionID -> SessionData -> IO ()+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)+ 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+ k' = toKey k+ sd' = toValue sd -resume :: Reaper DB Item -> Use- -> SessionID -> IO (Maybe SessionData)+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)+ 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+ check Fresh = (Used, True)+ check Used = (Used, False)+ k' = toKey k -invalidate :: Reaper DB Item- -> SessionID -> IO ()+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)+ Nothing -> return ()+ Just (p, v) -> reaperAdd reaper (k', p, v, Del) where- !k' = toKey k+ k' = toKey k
+ Network/TLS/SessionTicket.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE RecordWildCards #-}++-- | A manager for TLS 1.2/1.3 session ticket.+--+-- Tracking client hello is not implemented yet.+-- So, if this is used for TLS 1.3 0-RTT,+-- replay attack is possible.+-- If your application data in 0-RTT changes the status of server side,+-- use 'Network.TLS.SessionManager' instead.+--+-- A dedicated thread is running repeatedly to replece+-- secret keys. So, energy saving is not achieved.+module Network.TLS.SessionTicket (+ newSessionTicketManager,+ Config,+ defaultConfig,+ ticketLifetime,+ secretKeyInterval,+) where++import Codec.Serialise+import qualified Crypto.Token as CT+import qualified Data.ByteString.Lazy as L+import Network.TLS+import Network.TLS.Internal++-- | Configuration for session tickets.+data Config = Config+ { ticketLifetime :: Int+ -- ^ Ticket lifetime in seconds.+ , secretKeyInterval :: Int+ }++-- | ticketLifetime: 2 hours (7200 seconds), secretKeyInterval: 30 minutes (1800 seconds)+defaultConfig :: Config+defaultConfig =+ Config+ { ticketLifetime = 7200 -- 2 hours+ , secretKeyInterval = 1800 -- 30 minites+ }++-- | Creating a session ticket manager.+newSessionTicketManager :: Config -> IO SessionManager+newSessionTicketManager Config{..} =+ sessionTicketManager <$> CT.spawnTokenManager conf+ where+ conf =+ CT.defaultConfig+ { CT.interval = secretKeyInterval+ , CT.tokenLifetime = ticketLifetime+ }++sessionTicketManager :: CT.TokenManager -> SessionManager+sessionTicketManager ctmgr =+ SessionManager+ { sessionResume = resume ctmgr+ , sessionResumeOnlyOnce = resume ctmgr+ , sessionEstablish = establish ctmgr+ , sessionInvalidate = \_ -> return ()+ , sessionUseTicket = True+ }++establish :: CT.TokenManager -> SessionID -> SessionData -> IO (Maybe Ticket)+establish ctmgr _ sd = Just <$> CT.encryptToken ctmgr b+ where+ b = L.toStrict $ serialise sd++resume :: CT.TokenManager -> Ticket -> IO (Maybe SessionData)+resume ctmgr ticket+ | isTicket ticket = do+ msdb <- CT.decryptToken ctmgr ticket+ case msdb of+ Nothing -> return Nothing+ Just sdb -> case deserialiseOrFail $ L.fromStrict sdb of+ Left _ -> return Nothing+ Right sd -> return $ Just sd+ | otherwise = return Nothing
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
tls-session-manager.cabal view
@@ -1,31 +1,35 @@-name: tls-session-manager-version: 0.0.4-synopsis: In-memory TLS session manager-description: TLS session manager with limitation, automatic pruning, energy saving and replay resistance-license: BSD3-license-file: LICENSE-author: Kazu Yamamoto-maintainer: kazu@iij.ad.jp--- copyright:-category: Web-build-type: Simple-extra-source-files: ChangeLog.md-cabal-version: >= 1.10+cabal-version: >=1.10+name: tls-session-manager+version: 0.0.5+license: BSD3+license-file: LICENSE+maintainer: kazu@iij.ad.jp+author: Kazu Yamamoto+synopsis: In-memory TLS session DB and session ticket+description:+ TLS session manager with limitation, automatic pruning, energy saving and replay resistance and session ticket manager +category: Web+build-type: Simple+extra-source-files: ChangeLog.md+ library- exposed-modules: Network.TLS.SessionManager- other-modules: Network.TLS.Imports- -- other-extensions:- build-depends: base >= 4.7 && < 5- , auto-update- , basement- , bytestring- , clock- , memory- , psqueues >= 0.2.3- , tls- -- hs-source-dirs:- default-language: Haskell2010- ghc-options: -Wall- if impl(ghc >= 8)- default-extensions: Strict StrictData+ exposed-modules: Network.TLS.SessionManager+ Network.TLS.SessionTicket+ other-modules: Network.TLS.Imports+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5,+ auto-update >= 0.1 && < 0.2,+ basement >= 0.0.16 && < 0.1,+ bytestring >= 0.10 && < 0.12,+ clock >= 0.8 && < 0.9,+ crypto-token >= 0.1.1 && < 0.2,+ memory >= 0.18.0 && < 0.19,+ psqueues >= 0.2 && < 0.3,+ serialise >= 0.2 && < 0.3,+ tls >= 2.0 && < 2.1++ if impl(ghc >=8)+ default-extensions: Strict StrictData