diff options
Diffstat (limited to 'src/Network/Tox/Session.hs')
-rw-r--r-- | src/Network/Tox/Session.hs | 36 |
1 files changed, 28 insertions, 8 deletions
diff --git a/src/Network/Tox/Session.hs b/src/Network/Tox/Session.hs index a52e9478..88221b11 100644 --- a/src/Network/Tox/Session.hs +++ b/src/Network/Tox/Session.hs | |||
@@ -10,6 +10,7 @@ import Network.Socket | |||
10 | import Crypto.Tox | 10 | import Crypto.Tox |
11 | import Data.PacketBuffer (PacketInboundEvent (..)) | 11 | import Data.PacketBuffer (PacketInboundEvent (..)) |
12 | import Data.Tox.Message | 12 | import Data.Tox.Message |
13 | import DPut | ||
13 | import Network.Lossless | 14 | import Network.Lossless |
14 | import Network.QueryResponse | 15 | import Network.QueryResponse |
15 | import Network.SessionTransports | 16 | import Network.SessionTransports |
@@ -43,6 +44,7 @@ data Session = Session | |||
43 | -- convenience, a lower bound for the numbers in the list is also | 44 | -- convenience, a lower bound for the numbers in the list is also |
44 | -- returned. Suggested polling interval: a few seconds. | 45 | -- returned. Suggested polling interval: a few seconds. |
45 | , sTransport :: Transport String () CryptoMessage | 46 | , sTransport :: Transport String () CryptoMessage |
47 | , sSessionID :: Int | ||
46 | } | 48 | } |
47 | 49 | ||
48 | handshakeH :: SessionParams | 50 | handshakeH :: SessionParams |
@@ -63,7 +65,11 @@ plainHandshakeH :: SessionParams | |||
63 | -> IO () | 65 | -> IO () |
64 | plainHandshakeH sp saddr skey handshake = do | 66 | plainHandshakeH sp saddr skey handshake = do |
65 | let hd = runIdentity $ handshakeData handshake | 67 | let hd = runIdentity $ handshakeData handshake |
68 | prelude = show saddr ++ " --> " | ||
69 | dput XNetCrypto $ prelude ++ "handshake: " ++ show (otherCookie hd, baseNonce hd) | ||
66 | sent <- spGetSentHandshake sp skey saddr (handshakeCookie handshake) (otherCookie hd) | 70 | sent <- spGetSentHandshake sp skey saddr (handshakeCookie handshake) (otherCookie hd) |
71 | -- TODO: this is always returning sent = Nothing | ||
72 | dput XNetCrypto $ prelude ++ "plainHandshakeH: cached outgoing: " ++ show (fmap (baseNonce . snd) sent) | ||
67 | forM_ sent $ \(hd_skey,hd_sent) -> do | 73 | forM_ sent $ \(hd_skey,hd_sent) -> do |
68 | sk <- SessionKeys (spCrypto sp) | 74 | sk <- SessionKeys (spCrypto sp) |
69 | hd_skey | 75 | hd_skey |
@@ -71,7 +77,8 @@ plainHandshakeH sp saddr skey handshake = do | |||
71 | <$> atomically (newTVar $ baseNonce hd) | 77 | <$> atomically (newTVar $ baseNonce hd) |
72 | <*> atomically (newTVar $ baseNonce hd_sent) | 78 | <*> atomically (newTVar $ baseNonce hd_sent) |
73 | m <- newSession (spSessions sp) (\() p -> return p) (decryptPacket sk) saddr | 79 | m <- newSession (spSessions sp) (\() p -> return p) (decryptPacket sk) saddr |
74 | forM_ m $ \t -> do | 80 | dput XNetCrypto $ prelude ++ "plainHandshakeH: session " ++ maybe "Nothing" (const "Just") m |
81 | forM_ m $ \(sid, t) -> do | ||
75 | (t2,resend,getMissing) | 82 | (t2,resend,getMissing) |
76 | <- lossless (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp) | 83 | <- lossless (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp) |
77 | (\seqno p _ -> encryptPacket sk $ bookKeeping seqno p) | 84 | (\seqno p _ -> encryptPacket sk $ bookKeeping seqno p) |
@@ -79,6 +86,7 @@ plainHandshakeH sp saddr skey handshake = do | |||
79 | t | 86 | t |
80 | let _ = t :: TransportA String () (CryptoPacket Identity) (CryptoPacket Encrypted) | 87 | let _ = t :: TransportA String () (CryptoPacket Identity) (CryptoPacket Encrypted) |
81 | _ = t2 :: Transport String () CryptoMessage | 88 | _ = t2 :: Transport String () CryptoMessage |
89 | sendMessage t2 () $ OneByte ONLINE | ||
82 | spOnNewSession sp Session | 90 | spOnNewSession sp Session |
83 | { sOurKey = skey | 91 | { sOurKey = skey |
84 | , sTheirAddr = saddr | 92 | , sTheirAddr = saddr |
@@ -87,6 +95,7 @@ plainHandshakeH sp saddr skey handshake = do | |||
87 | , sResendPackets = resend | 95 | , sResendPackets = resend |
88 | , sMissingInbound = getMissing | 96 | , sMissingInbound = getMissing |
89 | , sTransport = t2 | 97 | , sTransport = t2 |
98 | , sSessionID = sid | ||
90 | } | 99 | } |
91 | return () | 100 | return () |
92 | 101 | ||
@@ -122,17 +131,28 @@ data SessionKeys = SessionKeys | |||
122 | , skNonceOutgoing :: TVar Nonce24 -- +1 on every packet | 131 | , skNonceOutgoing :: TVar Nonce24 -- +1 on every packet |
123 | } | 132 | } |
124 | 133 | ||
134 | |||
135 | -- From spec.md: | ||
136 | -- | ||
137 | -- Data in the encrypted packets: | ||
138 | -- | ||
139 | -- [our recvbuffers buffer_start, (highest packet number handled + 1), (big endian)] | ||
140 | -- [uint32_t packet number if lossless, sendbuffer buffer_end if lossy, (big endian)] | ||
141 | -- [data] | ||
142 | |||
143 | |||
125 | bookKeeping :: SequenceInfo -> CryptoMessage -> CryptoData | 144 | bookKeeping :: SequenceInfo -> CryptoMessage -> CryptoData |
126 | bookKeeping (SequenceInfo seqno ack) m = CryptoData | 145 | bookKeeping (SequenceInfo seqno ack) m = CryptoData |
127 | { bufferStart = seqno :: Word32 | 146 | { bufferStart = ack :: Word32 |
128 | , bufferEnd = ack :: Word32 | 147 | , bufferEnd = seqno :: Word32 |
129 | , bufferData = m | 148 | , bufferData = m |
130 | } | 149 | } |
131 | 150 | ||
132 | checkLossless :: CryptoData -> PacketInboundEvent CryptoMessage | 151 | checkLossless :: CryptoData -> PacketInboundEvent CryptoMessage |
133 | checkLossless CryptoData{ bufferStart = ack | 152 | checkLossless cd@CryptoData{ bufferStart = ack |
134 | , bufferEnd = no | 153 | , bufferEnd = no |
135 | , bufferData = x } = tag no x ack | 154 | , bufferData = x } = tag no x' ack |
136 | where | 155 | where |
137 | tag = case lossyness (msgID x) of Lossy -> PacketReceivedLossy | 156 | x' = decodeRawCryptoMsg cd |
138 | _ -> PacketReceived | 157 | tag = case lossyness (msgID x') of Lossy -> PacketReceivedLossy |
158 | _ -> PacketReceived | ||