1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-# 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
, CT.threadName = "TLS ticket manager"
}
sessionTicketManager :: CT.TokenManager -> SessionManager
sessionTicketManager ctmgr =
noSessionManager
{ 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
|
