-- This file is part of Diohsc -- Copyright (C) 2020 Martin Bays -- -- 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 type ClientSessions = MVar (Map.Map (HostName, Maybe Fingerprint) (Elapsed, (SessionID, SessionData))) newClientSessions :: IO ClientSessions newClientSessions = newMVar Map.empty clientSessionManager :: Int -> ClientSessions -> Maybe Fingerprint -> SessionManager clientSessionManager lifetime sess fp = SessionManager (\_ -> return Nothing) (\_ -> return Nothing) insert delete where insert sid sd@SessionData{ sessionClientSNI = Just sni } = do now <- timeCurrent let expire = now `timeAdd` Seconds (fromIntegral lifetime) modifyMVar_ sess $ return . Map.insert (sni, fp) (expire,(sid,sd)) . fromAscList . filter (\(_,(t,(_,_))) -> t >= now) . toAscList insert _ _ = return () delete sid = modifyMVar_ sess $ return . fromAscList . filter (\(_,(_,(sid',_))) -> sid /= sid') . toAscList lookupClientSession :: HostName -> Maybe Fingerprint -> ClientSessions -> IO (Maybe (SessionID, SessionData)) lookupClientSession sni fp sess = (snd <$>) . Map.lookup (sni,fp) <$> readMVar sess