{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}

-- | 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.
-- * 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(..)
  , defaultConfig
  , newSessionManager
  ) where

import Basement.Block (Block)
import Data.ByteArray (convert)
import Control.Exception (assert)
import Control.Reaper
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

----------------------------------------------------------------

-- | Configuration for session managers.
data Config = Config {
    -- | Ticket lifetime in seconds.
      Config -> Int
ticketLifetime :: !Int
    -- | Pruning delay in seconds. This is set to 'reaperDelay'.
    , Config -> Int
pruningDelay   :: !Int
    -- | The limit size of session data entries.
    , Config -> Int
dbMaxSize      :: !Int
    }

-- | Lifetime: 1 day , delay: 10 minutes, max size: 1000 entries.
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Int -> Int -> Int -> Config
Config {
      ticketLifetime :: Int
ticketLifetime = Int
86400
    , pruningDelay :: Int
pruningDelay   = Int
6000
    , dbMaxSize :: Int
dbMaxSize      = Int
1000
    }

----------------------------------------------------------------

toKey :: ByteString -> Block Word8
toKey :: ByteString -> Block Word8
toKey = ByteString -> Block Word8
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

toValue :: SessionData -> SessionDataCopy
#if MIN_VERSION_tls(1,5,0)
#if MIN_VERSION_tls(1,5,3)
toValue :: SessionData -> SessionDataCopy
toValue (SessionData Version
v CipherID
cid Word8
comp Maybe HostName
msni ByteString
sec Maybe Group
mg Maybe TLS13TicketInfo
mti Maybe ByteString
malpn Int
siz [SessionFlag]
flg) =
    Version
-> CipherID
-> Word8
-> Maybe HostName
-> Block Word8
-> Maybe Group
-> Maybe TLS13TicketInfo
-> Maybe (Block Word8)
-> Int
-> [SessionFlag]
-> SessionDataCopy
SessionDataCopy Version
v CipherID
cid Word8
comp Maybe HostName
msni Block Word8
sec' Maybe Group
mg Maybe TLS13TicketInfo
mti Maybe (Block Word8)
malpn' Int
siz [SessionFlag]
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' :: Block Word8
sec' = ByteString -> Block Word8
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
sec
    !malpn' :: Maybe (Block Word8)
malpn' = ByteString -> Block Word8
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> Block Word8)
-> Maybe ByteString -> Maybe (Block Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
malpn
#else
toValue (SessionData v cid comp msni sec) =
    SessionDataCopy v cid comp msni sec'
  where
    !sec' = convert sec
#endif

fromValue :: SessionDataCopy -> SessionData
#if MIN_VERSION_tls(1,5,0)
#if MIN_VERSION_tls(1,5,3)
fromValue :: SessionDataCopy -> SessionData
fromValue (SessionDataCopy Version
v CipherID
cid Word8
comp Maybe HostName
msni Block Word8
sec' Maybe Group
mg Maybe TLS13TicketInfo
mti Maybe (Block Word8)
malpn' Int
siz [SessionFlag]
flg) =
    Version
-> CipherID
-> Word8
-> Maybe HostName
-> ByteString
-> Maybe Group
-> Maybe TLS13TicketInfo
-> Maybe ByteString
-> Int
-> [SessionFlag]
-> SessionData
SessionData Version
v CipherID
cid Word8
comp Maybe HostName
msni ByteString
sec Maybe Group
mg Maybe TLS13TicketInfo
mti Maybe ByteString
malpn Int
siz [SessionFlag]
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 :: ByteString
sec = Block Word8 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Block Word8
sec'
    !malpn :: Maybe ByteString
malpn = Block Word8 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Block Word8 -> ByteString)
-> Maybe (Block Word8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Block Word8)
malpn'
#else
fromValue (SessionDataCopy v cid comp msni sec') =
    SessionData v cid comp msni sec
  where
    !sec = convert sec'
#endif

----------------------------------------------------------------

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 (Int -> SessionDataCopy -> ShowS
[SessionDataCopy] -> ShowS
SessionDataCopy -> HostName
(Int -> SessionDataCopy -> ShowS)
-> (SessionDataCopy -> HostName)
-> ([SessionDataCopy] -> ShowS)
-> Show SessionDataCopy
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SessionDataCopy] -> ShowS
$cshowList :: [SessionDataCopy] -> ShowS
show :: SessionDataCopy -> HostName
$cshow :: SessionDataCopy -> HostName
showsPrec :: Int -> SessionDataCopy -> ShowS
$cshowsPrec :: Int -> SessionDataCopy -> ShowS
Show,SessionDataCopy -> SessionDataCopy -> Bool
(SessionDataCopy -> SessionDataCopy -> Bool)
-> (SessionDataCopy -> SessionDataCopy -> Bool)
-> Eq SessionDataCopy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionDataCopy -> SessionDataCopy -> Bool
$c/= :: SessionDataCopy -> SessionDataCopy -> Bool
== :: SessionDataCopy -> SessionDataCopy -> Bool
$c== :: SessionDataCopy -> SessionDataCopy -> Bool
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 :: Config -> IO SessionManager
newSessionManager Config
conf = do
    let lifetime :: Sec
lifetime = Int -> Sec
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Sec) -> Int -> Sec
forall a b. (a -> b) -> a -> b
$ Config -> Int
ticketLifetime Config
conf
        maxsiz :: Int
maxsiz = Config -> Int
dbMaxSize Config
conf
    Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper <- ReaperSettings
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> IO
     (Reaper
        (OrdPSQ (Block Word8) Sec Value)
        (Block Word8, Sec, Value, Operation))
forall workload item.
ReaperSettings workload item -> IO (Reaper workload item)
mkReaper ReaperSettings [Any] Any
forall item. ReaperSettings [item] item
defaultReaperSettings {
          reaperEmpty :: OrdPSQ (Block Word8) Sec Value
reaperEmpty  = OrdPSQ (Block Word8) Sec Value
forall k p v. OrdPSQ k p v
Q.empty
        , reaperCons :: (Block Word8, Sec, Value, Operation)
-> OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value
reaperCons   = Int
-> (Block Word8, Sec, Value, Operation)
-> OrdPSQ (Block Word8) Sec Value
-> OrdPSQ (Block Word8) Sec Value
cons Int
maxsiz
        , reaperAction :: OrdPSQ (Block Word8) Sec Value
-> IO
     (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
reaperAction = OrdPSQ (Block Word8) Sec Value
-> IO
     (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
clean
        , reaperNull :: OrdPSQ (Block Word8) Sec Value -> Bool
reaperNull   = OrdPSQ (Block Word8) Sec Value -> Bool
forall k p v. OrdPSQ k p v -> Bool
Q.null
        , reaperDelay :: Int
reaperDelay  = Config -> Int
pruningDelay Config
conf Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
        }
    SessionManager -> IO SessionManager
forall (m :: * -> *) a. Monad m => a -> m a
return SessionManager :: (ByteString -> IO (Maybe SessionData))
-> (ByteString -> IO (Maybe SessionData))
-> (ByteString -> SessionData -> IO ())
-> (ByteString -> IO ())
-> SessionManager
SessionManager {
        sessionResume :: ByteString -> IO (Maybe SessionData)
sessionResume         = Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> Use -> ByteString -> IO (Maybe SessionData)
resume Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper Use
MultipleUse
#if MIN_VERSION_tls(1,5,0)
      , sessionResumeOnlyOnce :: ByteString -> IO (Maybe SessionData)
sessionResumeOnlyOnce = Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> Use -> ByteString -> IO (Maybe SessionData)
resume Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper Use
SingleUse
#endif
      , sessionEstablish :: ByteString -> SessionData -> IO ()
sessionEstablish      = Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> Sec -> ByteString -> SessionData -> IO ()
establish Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper Sec
lifetime
      , sessionInvalidate :: ByteString -> IO ()
sessionInvalidate     = Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> ByteString -> IO ()
invalidate Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper

      }

cons :: Int -> Item -> DB -> DB
cons :: Int
-> (Block Word8, Sec, Value, Operation)
-> OrdPSQ (Block Word8) Sec Value
-> OrdPSQ (Block Word8) Sec Value
cons Int
lim (Block Word8
k,Sec
t,Value
v,Operation
Add) OrdPSQ (Block Word8) Sec Value
db
  | Int
lim Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0            = OrdPSQ (Block Word8) Sec Value
forall k p v. OrdPSQ k p v
Q.empty
  | OrdPSQ (Block Word8) Sec Value -> Int
forall k p v. OrdPSQ k p v -> Int
Q.size OrdPSQ (Block Word8) Sec Value
db Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lim    = case OrdPSQ (Block Word8) Sec Value
-> Maybe (Block Word8, Sec, Value, OrdPSQ (Block Word8) Sec Value)
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
Q.minView OrdPSQ (Block Word8) Sec Value
db of
      Maybe (Block Word8, Sec, Value, OrdPSQ (Block Word8) Sec Value)
Nothing          -> Bool
-> OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
-> OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value
forall a b. (a -> b) -> a -> b
$ Block Word8
-> Sec
-> Value
-> OrdPSQ (Block Word8) Sec Value
-> OrdPSQ (Block Word8) Sec Value
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
Q.insert Block Word8
k Sec
t Value
v OrdPSQ (Block Word8) Sec Value
forall k p v. OrdPSQ k p v
Q.empty
      Just (Block Word8
_,Sec
_,Value
_,OrdPSQ (Block Word8) Sec Value
db') -> Block Word8
-> Sec
-> Value
-> OrdPSQ (Block Word8) Sec Value
-> OrdPSQ (Block Word8) Sec Value
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
Q.insert Block Word8
k Sec
t Value
v OrdPSQ (Block Word8) Sec Value
db'
  | Bool
otherwise           = Block Word8
-> Sec
-> Value
-> OrdPSQ (Block Word8) Sec Value
-> OrdPSQ (Block Word8) Sec Value
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
Q.insert Block Word8
k Sec
t Value
v OrdPSQ (Block Word8) Sec Value
db
cons Int
_   (Block Word8
k,Sec
_,Value
_,Operation
Del) OrdPSQ (Block Word8) Sec Value
db = Block Word8
-> OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
Q.delete Block Word8
k OrdPSQ (Block Word8) Sec Value
db

clean :: DB -> IO (DB -> DB)
clean :: OrdPSQ (Block Word8) Sec Value
-> IO
     (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
clean OrdPSQ (Block Word8) Sec Value
olddb = do
    Sec
currentTime <- TimeSpec -> Sec
C.sec (TimeSpec -> Sec) -> IO TimeSpec -> IO Sec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
C.getTime Clock
C.Monotonic
    let !pruned :: OrdPSQ (Block Word8) Sec Value
pruned = ([(Block Word8, Sec, Value)], OrdPSQ (Block Word8) Sec Value)
-> OrdPSQ (Block Word8) Sec Value
forall a b. (a, b) -> b
snd (([(Block Word8, Sec, Value)], OrdPSQ (Block Word8) Sec Value)
 -> OrdPSQ (Block Word8) Sec Value)
-> ([(Block Word8, Sec, Value)], OrdPSQ (Block Word8) Sec Value)
-> OrdPSQ (Block Word8) Sec Value
forall a b. (a -> b) -> a -> b
$ Sec
-> OrdPSQ (Block Word8) Sec Value
-> ([(Block Word8, Sec, Value)], OrdPSQ (Block Word8) Sec Value)
forall k p v.
(Ord k, Ord p) =>
p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
Q.atMostView Sec
currentTime OrdPSQ (Block Word8) Sec Value
olddb
    (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
-> IO
     (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
forall (m :: * -> *) a. Monad m => a -> m a
return ((OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
 -> IO
      (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value))
-> (OrdPSQ (Block Word8) Sec Value
    -> OrdPSQ (Block Word8) Sec Value)
-> IO
     (OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value)
forall a b. (a -> b) -> a -> b
$ OrdPSQ (Block Word8) Sec Value
-> OrdPSQ (Block Word8) Sec Value -> OrdPSQ (Block Word8) Sec Value
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
merge OrdPSQ (Block Word8) Sec Value
pruned
  where
    ins :: OrdPSQ k p v -> (k, p, v) -> OrdPSQ k p v
ins OrdPSQ k p v
db (k
k,p
p,v
v) = k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
Q.insert k
k p
p v
v OrdPSQ k p v
db
    -- There is not 'merge' API.
    -- We hope that newdb is smaller than pruned.
    merge :: OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
merge OrdPSQ k p v
pruned OrdPSQ k p v
newdb = (OrdPSQ k p v -> (k, p, v) -> OrdPSQ k p v)
-> OrdPSQ k p v -> [(k, p, v)] -> OrdPSQ k p v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OrdPSQ k p v -> (k, p, v) -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> (k, p, v) -> OrdPSQ k p v
ins OrdPSQ k p v
pruned [(k, p, v)]
entries
      where
        entries :: [(k, p, v)]
entries = OrdPSQ k p v -> [(k, p, v)]
forall k p v. OrdPSQ k p v -> [(k, p, v)]
Q.toList OrdPSQ k p v
newdb

----------------------------------------------------------------

establish :: Reaper DB Item -> Sec
          -> SessionID -> SessionData -> IO ()
establish :: Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> Sec -> ByteString -> SessionData -> IO ()
establish Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper Sec
lifetime ByteString
k SessionData
sd = do
    IORef Availability
ref <- Availability -> IO (IORef Availability)
forall a. a -> IO (IORef a)
newIORef Availability
Fresh
    !Sec
p <- (Sec -> Sec -> Sec
forall a. Num a => a -> a -> a
+ Sec
lifetime) (Sec -> Sec) -> (TimeSpec -> Sec) -> TimeSpec -> Sec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Sec
C.sec (TimeSpec -> Sec) -> IO TimeSpec -> IO Sec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
C.getTime Clock
C.Monotonic
    let !v :: Value
v = (SessionDataCopy
sd',IORef Availability
ref)
    Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> (Block Word8, Sec, Value, Operation) -> IO ()
forall workload item. Reaper workload item -> item -> IO ()
reaperAdd Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper (Block Word8
k',Sec
p,Value
v,Operation
Add)
  where
    !k' :: Block Word8
k' = ByteString -> Block Word8
toKey ByteString
k
    !sd' :: SessionDataCopy
sd' = SessionData -> SessionDataCopy
toValue SessionData
sd

resume :: Reaper DB Item -> Use
       -> SessionID -> IO (Maybe SessionData)
resume :: Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> Use -> ByteString -> IO (Maybe SessionData)
resume Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper Use
use ByteString
k = do
    OrdPSQ (Block Word8) Sec Value
db <- Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> IO (OrdPSQ (Block Word8) Sec Value)
forall workload item. Reaper workload item -> IO workload
reaperRead Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper
    case Block Word8 -> OrdPSQ (Block Word8) Sec Value -> Maybe (Sec, Value)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
Q.lookup Block Word8
k' OrdPSQ (Block Word8) Sec Value
db of
      Maybe (Sec, Value)
Nothing             -> Maybe SessionData -> IO (Maybe SessionData)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing
      Just (Sec
p,v :: Value
v@(SessionDataCopy
sd,IORef Availability
ref)) ->
           case Use
use of
               Use
SingleUse -> do
                   Bool
available <- IORef Availability
-> (Availability -> (Availability, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Availability
ref Availability -> (Availability, Bool)
check
                   Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> (Block Word8, Sec, Value, Operation) -> IO ()
forall workload item. Reaper workload item -> item -> IO ()
reaperAdd Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper (Block Word8
k',Sec
p,Value
v,Operation
Del)
                   Maybe SessionData -> IO (Maybe SessionData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SessionData -> IO (Maybe SessionData))
-> Maybe SessionData -> IO (Maybe SessionData)
forall a b. (a -> b) -> a -> b
$ if Bool
available then SessionData -> Maybe SessionData
forall a. a -> Maybe a
Just (SessionDataCopy -> SessionData
fromValue SessionDataCopy
sd) else Maybe SessionData
forall a. Maybe a
Nothing
               Use
MultipleUse -> Maybe SessionData -> IO (Maybe SessionData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SessionData -> IO (Maybe SessionData))
-> Maybe SessionData -> IO (Maybe SessionData)
forall a b. (a -> b) -> a -> b
$ SessionData -> Maybe SessionData
forall a. a -> Maybe a
Just (SessionDataCopy -> SessionData
fromValue SessionDataCopy
sd)
  where
    check :: Availability -> (Availability, Bool)
check Availability
Fresh = (Availability
Used,Bool
True)
    check Availability
Used  = (Availability
Used,Bool
False)
    !k' :: Block Word8
k' = ByteString -> Block Word8
toKey ByteString
k

invalidate :: Reaper DB Item
           -> SessionID -> IO ()
invalidate :: Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> ByteString -> IO ()
invalidate Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper ByteString
k = do
    OrdPSQ (Block Word8) Sec Value
db <- Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> IO (OrdPSQ (Block Word8) Sec Value)
forall workload item. Reaper workload item -> IO workload
reaperRead Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper
    case Block Word8 -> OrdPSQ (Block Word8) Sec Value -> Maybe (Sec, Value)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
Q.lookup Block Word8
k' OrdPSQ (Block Word8) Sec Value
db of
      Maybe (Sec, Value)
Nothing    -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (Sec
p,Value
v) -> Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
-> (Block Word8, Sec, Value, Operation) -> IO ()
forall workload item. Reaper workload item -> item -> IO ()
reaperAdd Reaper
  (OrdPSQ (Block Word8) Sec Value)
  (Block Word8, Sec, Value, Operation)
reaper (Block Word8
k',Sec
p,Value
v,Operation
Del)
  where
    !k' :: Block Word8
k' = ByteString -> Block Word8
toKey ByteString
k