diohsc-0.1.17: ClientSessionManager.hs

-- This file is part of Diohsc
-- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of version 3 of the GNU General Public License as
-- published by the Free Software Foundation, or any later version.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see http://www.gnu.org/licenses/.

module ClientSessionManager
    ( clientSessionManager
    , ClientSessions
    , newClientSessions
    , lookupClientSession
    ) where

import           Control.Concurrent
import           Data.Map           (fromAscList, toAscList)
import           Network.TLS

import           Data.Hourglass     (timeAdd)
import           Time.System        (timeCurrent)
import           Time.Types         (Elapsed (..), Seconds (..))

import qualified Data.Map           as Map

import           Fingerprint
import           Request

type ClientSessions = MVar (Map.Map (Host, Maybe Fingerprint) (Elapsed, (SessionID, SessionData)))

newClientSessions :: IO ClientSessions
newClientSessions = newMVar Map.empty

clientSessionManager :: Int -> ClientSessions -> Host -> Maybe Fingerprint -> SessionManager
clientSessionManager lifetime sess host fp = noSessionManager { sessionEstablish = insert }
    where
    insert sid sd | Just (hostName host) == sessionClientSNI sd = do
        now <- timeCurrent
        let expire = now `timeAdd` Seconds (fromIntegral lifetime)
        modifyMVar_ sess $ return .
            Map.insert (host, fp) (expire,(sid,sd)) .
            fromAscList . filter (\(_,(t,(_,_))) -> t >= now) . toAscList
        return Nothing
    insert _ _ = return Nothing

lookupClientSession :: Host -> Maybe Fingerprint -> ClientSessions -> IO (Maybe (SessionID, SessionData))
lookupClientSession host fp sess = (snd <$>) . Map.lookup (host,fp) <$> readMVar sess