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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{-# LANGUAGE TupleSections #-}
module Network.Tox.Session where
import Control.Concurrent.STM
import Control.Monad
import Data.Functor.Identity
import Data.Word
import Network.Socket
import Crypto.Tox
import Data.PacketBuffer (PacketInboundEvent (..))
import Data.Tox.Message
import Network.Lossless
import Network.QueryResponse
import Network.SessionTransports
import Network.Tox.Crypto.Transport
import Network.Tox.DHT.Transport (Cookie)
import Network.Tox.Handshake
type SessionKey = SecretKey
data SessionParams = SessionParams
{ spCrypto :: TransportCrypto
, spSessions :: Sessions (CryptoPacket Encrypted)
, spGetSentHandshake :: SecretKey -> SockAddr
-> Cookie Identity
-> Cookie Encrypted
-> IO (Maybe (SessionKey, HandshakeData))
, spOnNewSession :: Session -> IO ()
}
data Session = Session
{ sOurKey :: SecretKey
, sTheirAddr :: SockAddr
, sSentHandshake :: HandshakeData
, sReceivedHandshake :: Handshake Identity
, sResendPackets :: [Word32] -> IO ()
-- ^ If they request that we re-send certain packets, this method is how
-- that is accomplished.
, sMissingInbound :: IO ([Word32],Word32)
-- ^ This list of sequence numbers should be periodically polled and if
-- it is not empty, we should request they re-send these packets. For
-- convenience, a lower bound for the numbers in the list is also
-- returned. Suggested polling interval: a few seconds.
, sTransport :: Transport String () CryptoMessage
}
handshakeH :: SessionParams
-> SockAddr
-> Handshake Encrypted
-> IO (Maybe a)
handshakeH sp saddr handshake = do
decryptHandshake (spCrypto sp) handshake
>>= either (\err -> return ())
(uncurry $ plainHandshakeH sp saddr)
return Nothing
plainHandshakeH :: SessionParams
-> SockAddr
-> SecretKey
-> Handshake Identity
-> IO ()
plainHandshakeH sp saddr skey handshake = do
let hd = runIdentity $ handshakeData handshake
sent <- spGetSentHandshake sp skey saddr (handshakeCookie handshake) (otherCookie hd)
forM_ sent $ \(hd_skey,hd_sent) -> do
sk <- SessionKeys (spCrypto sp)
hd_skey
(sessionKey hd)
<$> atomically (newTVar $ baseNonce hd)
<*> atomically (newTVar $ baseNonce hd_sent)
m <- newSession (spSessions sp) (\() p -> return p) (decryptPacket sk) saddr
forM_ m $ \t -> do
(t2,resend,getMissing)
<- lossless (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp)
(\seqno p _ -> encryptPacket sk $ bookKeeping seqno p)
()
t
let _ = t :: TransportA String () (CryptoPacket Identity) (CryptoPacket Encrypted)
_ = t2 :: Transport String () CryptoMessage
spOnNewSession sp Session
{ sOurKey = skey
, sTheirAddr = saddr
, sSentHandshake = hd_sent
, sReceivedHandshake = handshake
, sResendPackets = resend
, sMissingInbound = getMissing
, sTransport = t2
}
return ()
decryptPacket :: SessionKeys -> SockAddr -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ()))
decryptPacket sk saddr (CryptoPacket n16 ciphered) = do
(n,δ) <- atomically $ do
n <- readTVar (skNonceIncoming sk)
let δ = n16 - nonce24ToWord16 n
return ( n `addtoNonce24` fromIntegral δ, δ )
secret <- lookupSharedSecret (skCrypto sk) (skMe sk) (skThem sk) n
case decodePlain =<< decrypt secret ciphered of
Left e -> return Nothing
Right x -> do
when ( δ > 43690 )
$ atomically $ writeTVar (skNonceIncoming sk) (n `addtoNonce24` 21845)
return $ Just ( CryptoPacket n16 (pure x), () )
encryptPacket :: SessionKeys -> CryptoData -> IO (CryptoPacket Encrypted)
encryptPacket sk plain = do
n24 <- atomically $ do
n24 <- readTVar (skNonceOutgoing sk)
modifyTVar' (skNonceOutgoing sk) incrementNonce24
return n24
secret <- lookupSharedSecret (skCrypto sk) (skMe sk) (skThem sk) n24
let ciphered = encrypt secret $ encodePlain $ plain
return $ CryptoPacket (nonce24ToWord16 n24) ciphered
data SessionKeys = SessionKeys
{ skCrypto :: TransportCrypto
, skMe :: SecretKey
, skThem :: PublicKey
, skNonceIncoming :: TVar Nonce24 -- +21845 when a threshold is reached.
, skNonceOutgoing :: TVar Nonce24 -- +1 on every packet
}
bookKeeping :: SequenceInfo -> CryptoMessage -> CryptoData
bookKeeping (SequenceInfo seqno ack) m = CryptoData
{ bufferStart = seqno :: Word32
, bufferEnd = ack :: Word32
, bufferData = m
}
checkLossless :: CryptoData -> PacketInboundEvent CryptoMessage
checkLossless CryptoData{ bufferStart = ack
, bufferEnd = no
, bufferData = x } = tag no x ack
where
tag = case lossyness (msgID x) of Lossy -> PacketReceivedLossy
_ -> PacketReceived
|
