From 2327c7e929b729cb8f74104e8711429163305bc0 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Thu, 29 Jun 2017 12:46:37 +0900
Subject: [PATCH 1/9] adding in-memory TLS session manager.

---
 tls-session-manager/LICENSE                   |  29 ++++
 .../Network/TLS/SessionManager.hs             | 127 ++++++++++++++++++
 tls-session-manager/Setup.hs                  |   2 +
 tls-session-manager/tls-session-manager.cabal |  29 ++++
 4 files changed, 187 insertions(+)
 create mode 100644 tls-session-manager/LICENSE
 create mode 100644 tls-session-manager/Network/TLS/SessionManager.hs
 create mode 100644 tls-session-manager/Setup.hs
 create mode 100644 tls-session-manager/tls-session-manager.cabal

diff --git a/tls-session-manager/LICENSE b/tls-session-manager/LICENSE
new file mode 100644
index 000000000..7ca821155
--- /dev/null
+++ b/tls-session-manager/LICENSE
@@ -0,0 +1,29 @@
+Copyright (c) 2017, IIJ Innovation Institute Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+  * Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+  * Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution.
+  * Neither the name of the copyright holders nor the names of its
+    contributors may be used to endorse or promote products derived
+    from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
new file mode 100644
index 000000000..784acb221
--- /dev/null
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- | In-memory TLS 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.
+-- * Replay resistance: each session data is used at most once to prevent replay attacks.
+-- * Energy saving: no dedicate pruning thread is running when the size of session database is zero.
+
+module Network.TLS.SessionManager (
+    Config(..)
+  , defaultConfig
+  , newSessionManager
+  ) where
+
+import Control.Reaper
+import Data.IORef
+import Data.List (foldl')
+import Data.OrdPSQ (OrdPSQ)
+import qualified Data.OrdPSQ as Q
+import Data.Time (UTCTime, NominalDiffTime, getCurrentTime, addUTCTime)
+import Network.TLS (SessionID, SessionData, SessionManager(..))
+
+----------------------------------------------------------------
+
+-- | 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
+    }
+
+-- | Lifetime: 1 day , delay: 10 minutes, limit: 10,000 entries.
+defaultConfig :: Config
+defaultConfig = Config {
+      ticketLifetime = 86400
+    , pruningDelay   = 6000
+    , dbMaxSize      = 10000
+    }
+
+----------------------------------------------------------------
+
+type Value = (SessionData, IORef Availability)
+type DB = OrdPSQ SessionID UTCTime Value
+type Item = (SessionID, UTCTime, Value, Operation)
+
+data Operation = Add | Del
+data Availability = Fresh | Used
+
+----------------------------------------------------------------
+
+-- | Creating a 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
+        }
+    return SessionManager {
+        sessionResume     = resume reaper
+      , sessionEstablish  = establish reaper lifetime
+      , sessionInvalidate = invalidate reaper
+      }
+
+cons :: Int -> Item -> DB -> DB
+cons lim (k,t,v,Add) db
+  | Q.size db == lim    = case Q.minView db of
+      Nothing          -> Q.insert k t v Q.empty -- not happens, just in case
+      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 <- getCurrentTime
+    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 -> NominalDiffTime
+          -> SessionID -> SessionData -> IO ()
+establish reaper lifetime k sd = do
+    ref <- newIORef Fresh
+    !p <- addUTCTime lifetime <$> getCurrentTime
+    let !v = (sd,ref)
+    reaperAdd reaper (k,p,v,Add)
+
+resume :: Reaper DB Item
+       -> SessionID -> IO (Maybe SessionData)
+resume reaper k = do
+    db <- reaperRead reaper
+    case Q.lookup k db of
+      Nothing             -> return Nothing
+      Just (p,v@(sd,ref)) -> do
+          available <- atomicModifyIORef' ref check
+          reaperAdd reaper (k,p,v,Del)
+          return $ if available then Just sd else Nothing
+  where
+    check Fresh = (Used,True)
+    check Used  = (Used,False)
+
+invalidate :: Reaper DB Item
+           -> SessionID -> IO ()
+invalidate reaper k = do
+    -- repaerDelete does not exist
+    -- So, let's set the entry used and hope that it will be
+    -- cleaned in the future.
+    db <- reaperRead reaper
+    case Q.lookup k db of
+      Nothing          -> return ()
+      Just (_,(_,ref)) -> atomicModifyIORef' ref $ \_ -> (Used, ())
diff --git a/tls-session-manager/Setup.hs b/tls-session-manager/Setup.hs
new file mode 100644
index 000000000..9a994af67
--- /dev/null
+++ b/tls-session-manager/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/tls-session-manager/tls-session-manager.cabal b/tls-session-manager/tls-session-manager.cabal
new file mode 100644
index 000000000..5fd849469
--- /dev/null
+++ b/tls-session-manager/tls-session-manager.cabal
@@ -0,0 +1,29 @@
+-- Initial tls-session-manager.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                tls-session-manager
+version:             0.0.0.0
+synopsis:            In-memory TLS session manager
+description:         TLS session manager with limitation, automatic pruning, replay resistance and energy saving
+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
+
+library
+  exposed-modules:     Network.TLS.SessionManager
+  -- other-modules:
+  -- other-extensions:
+  build-depends:       base >= 4.9 && < 5
+                     , auto-update
+                     , time
+                     , tls
+                     , psqueues
+  -- hs-source-dirs:
+  default-language:    Haskell2010
+  ghc-options:       -Wall

From 4bbdf93f21c3970294dccae25ab432fe320fd9ae Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Fri, 30 Jun 2017 14:53:11 +0900
Subject: [PATCH 2/9] enabling both single-use and multiple-use.

---
 .../Network/TLS/SessionManager.hs                | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
index 784acb221..7c6e4842a 100644
--- a/tls-session-manager/Network/TLS/SessionManager.hs
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -48,6 +48,7 @@ type DB = OrdPSQ SessionID UTCTime Value
 type Item = (SessionID, UTCTime, Value, Operation)
 
 data Operation = Add | Del
+data Use = SingleUse | MultipleUse
 data Availability = Fresh | Used
 
 ----------------------------------------------------------------
@@ -65,7 +66,7 @@ newSessionManager conf = do
         , reaperDelay  = pruningDelay conf * 1000000
         }
     return SessionManager {
-        sessionResume     = resume reaper
+        sessionResume     = resume reaper MultipleUse
       , sessionEstablish  = establish reaper lifetime
       , sessionInvalidate = invalidate reaper
       }
@@ -101,16 +102,19 @@ establish reaper lifetime k sd = do
     let !v = (sd,ref)
     reaperAdd reaper (k,p,v,Add)
 
-resume :: Reaper DB Item
+resume :: Reaper DB Item -> Use
        -> SessionID -> IO (Maybe SessionData)
-resume reaper k = do
+resume reaper use k = do
     db <- reaperRead reaper
     case Q.lookup k db of
       Nothing             -> return Nothing
       Just (p,v@(sd,ref)) -> do
-          available <- atomicModifyIORef' ref check
-          reaperAdd reaper (k,p,v,Del)
-          return $ if available then Just sd else Nothing
+           case use of
+               SingleUse -> do
+                   available <- atomicModifyIORef' ref check
+                   reaperAdd reaper (k,p,v,Del)
+                   return $ if available then Just sd else Nothing
+               MultipleUse -> return $ Just sd
   where
     check Fresh = (Used,True)
     check Used  = (Used,False)

From 4d01793e7de6ad5f0d88f8b8ec4c01c1411cab08 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Fri, 30 Jun 2017 14:56:04 +0900
Subject: [PATCH 3/9] 'invlidate' removes the entry directly.

---
 tls-session-manager/Network/TLS/SessionManager.hs | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
index 7c6e4842a..bc947d6ef 100644
--- a/tls-session-manager/Network/TLS/SessionManager.hs
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -122,10 +122,7 @@ resume reaper use k = do
 invalidate :: Reaper DB Item
            -> SessionID -> IO ()
 invalidate reaper k = do
-    -- repaerDelete does not exist
-    -- So, let's set the entry used and hope that it will be
-    -- cleaned in the future.
     db <- reaperRead reaper
     case Q.lookup k db of
-      Nothing          -> return ()
-      Just (_,(_,ref)) -> atomicModifyIORef' ref $ \_ -> (Used, ())
+      Nothing    -> return ()
+      Just (p,v) -> reaperAdd reaper (k,p,v,Del)

From b07ffa7c629a67a6b5a2cbb978e478e16ec7b4f2 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Fri, 30 Jun 2017 18:48:41 +0900
Subject: [PATCH 4/9] updating doc.

---
 tls-session-manager/Network/TLS/SessionManager.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
index bc947d6ef..c8c0f9e34 100644
--- a/tls-session-manager/Network/TLS/SessionManager.hs
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -4,8 +4,8 @@
 --
 -- * Limitation: you can set the maximum size of the session data database.
 -- * Automatic pruning: old session data over their lifetime are pruned automatically.
--- * Replay resistance: each session data is used at most once to prevent replay attacks.
--- * Energy saving: no dedicate pruning thread is running when the size of session database is zero.
+-- * 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.)
 
 module Network.TLS.SessionManager (
     Config(..)

From 411da8c879afdb48e9531ca732eb4b263893ca63 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 3 Jul 2017 16:14:28 +0900
Subject: [PATCH 5/9] fixing a typo

---
 tls-session-manager/Network/TLS/SessionManager.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
index c8c0f9e34..0492a447b 100644
--- a/tls-session-manager/Network/TLS/SessionManager.hs
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -53,7 +53,7 @@ data Availability = Fresh | Used
 
 ----------------------------------------------------------------
 
--- | Creating a in-memory session manager.
+-- | Creating an in-memory session manager.
 newSessionManager :: Config -> IO SessionManager
 newSessionManager conf = do
     let lifetime = fromIntegral $ ticketLifetime conf

From 0a4540810fd823d87aecff7cd7014da4c6ab49d5 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 3 Jul 2017 16:43:20 +0900
Subject: [PATCH 6/9] making 'cons' more robust.

---
 tls-session-manager/Network/TLS/SessionManager.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
index 0492a447b..fa4c759bf 100644
--- a/tls-session-manager/Network/TLS/SessionManager.hs
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -20,6 +20,7 @@ import Data.OrdPSQ (OrdPSQ)
 import qualified Data.OrdPSQ as Q
 import Data.Time (UTCTime, NominalDiffTime, getCurrentTime, addUTCTime)
 import Network.TLS (SessionID, SessionData, SessionManager(..))
+import Control.Exception (assert)
 
 ----------------------------------------------------------------
 
@@ -73,8 +74,9 @@ newSessionManager conf = do
 
 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          -> Q.insert k t v Q.empty -- not happens, just in case
+      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

From 4c045d6f658efb460f2530ee9d3d6e4ab3383e83 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 3 Jul 2017 16:47:33 +0900
Subject: [PATCH 7/9] making `cons` more robust again.

---
 tls-session-manager/Network/TLS/SessionManager.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
index fa4c759bf..cb58c411c 100644
--- a/tls-session-manager/Network/TLS/SessionManager.hs
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -74,7 +74,7 @@ newSessionManager conf = do
 
 cons :: Int -> Item -> DB -> DB
 cons lim (k,t,v,Add) db
-  | lim == 0            = Q.empty
+  | 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'

From d449273ed75a8ea52ca2a4cc757e0a704219990f Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Tue, 4 Jul 2017 09:46:36 +0900
Subject: [PATCH 8/9] Using psqueus which provides 'atMost'.

---
 tls-session-manager/tls-session-manager.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tls-session-manager/tls-session-manager.cabal b/tls-session-manager/tls-session-manager.cabal
index 5fd849469..39bf217bf 100644
--- a/tls-session-manager/tls-session-manager.cabal
+++ b/tls-session-manager/tls-session-manager.cabal
@@ -23,7 +23,7 @@ library
                      , auto-update
                      , time
                      , tls
-                     , psqueues
+                     , psqueues >= 0.2.3
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:       -Wall

From f68fe5346e95318f15bf31ca80759e287015220a Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Tue, 4 Jul 2017 10:15:35 +0900
Subject: [PATCH 9/9] using the clock package.

---
 .../Network/TLS/SessionManager.hs                | 16 +++++++++-------
 tls-session-manager/tls-session-manager.cabal    |  3 ++-
 2 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/tls-session-manager/Network/TLS/SessionManager.hs b/tls-session-manager/Network/TLS/SessionManager.hs
index cb58c411c..7a524f2aa 100644
--- a/tls-session-manager/Network/TLS/SessionManager.hs
+++ b/tls-session-manager/Network/TLS/SessionManager.hs
@@ -13,14 +13,15 @@ module Network.TLS.SessionManager (
   , newSessionManager
   ) where
 
+import Control.Exception (assert)
 import Control.Reaper
 import Data.IORef
+import Data.Int (Int64)
 import Data.List (foldl')
 import Data.OrdPSQ (OrdPSQ)
 import qualified Data.OrdPSQ as Q
-import Data.Time (UTCTime, NominalDiffTime, getCurrentTime, addUTCTime)
 import Network.TLS (SessionID, SessionData, SessionManager(..))
-import Control.Exception (assert)
+import qualified System.Clock as C
 
 ----------------------------------------------------------------
 
@@ -44,9 +45,10 @@ defaultConfig = Config {
 
 ----------------------------------------------------------------
 
+type Sec = Int64
 type Value = (SessionData, IORef Availability)
-type DB = OrdPSQ SessionID UTCTime Value
-type Item = (SessionID, UTCTime, Value, Operation)
+type DB = OrdPSQ SessionID Sec Value
+type Item = (SessionID, Sec, Value, Operation)
 
 data Operation = Add | Del
 data Use = SingleUse | MultipleUse
@@ -83,7 +85,7 @@ cons _   (k,_,_,Del) db = Q.delete k db
 
 clean :: DB -> IO (DB -> DB)
 clean olddb = do
-    currentTime <- getCurrentTime
+    currentTime <- C.sec <$> C.getTime C.Monotonic
     let !pruned = snd $ Q.atMostView currentTime olddb
     return $ merge pruned
   where
@@ -96,11 +98,11 @@ clean olddb = do
 
 ----------------------------------------------------------------
 
-establish :: Reaper DB Item -> NominalDiffTime
+establish :: Reaper DB Item -> Sec
           -> SessionID -> SessionData -> IO ()
 establish reaper lifetime k sd = do
     ref <- newIORef Fresh
-    !p <- addUTCTime lifetime <$> getCurrentTime
+    !p <- ((+ lifetime) . C.sec) <$> C.getTime C.Monotonic
     let !v = (sd,ref)
     reaperAdd reaper (k,p,v,Add)
 
diff --git a/tls-session-manager/tls-session-manager.cabal b/tls-session-manager/tls-session-manager.cabal
index 39bf217bf..51b4cc1e6 100644
--- a/tls-session-manager/tls-session-manager.cabal
+++ b/tls-session-manager/tls-session-manager.cabal
@@ -21,9 +21,10 @@ library
   -- other-extensions:
   build-depends:       base >= 4.9 && < 5
                      , auto-update
+                     , clock
+                     , psqueues >= 0.2.3
                      , time
                      , tls
-                     , psqueues >= 0.2.3
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:       -Wall