summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Crypto/Handlers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Crypto/Handlers.hs')
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs116
1 files changed, 77 insertions, 39 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 34d2d87e..e8cdfcdd 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -64,7 +64,7 @@ newSessionsState crypto unrechook hooks = do
64 , defaultUnrecognizedHook = unrechook 64 , defaultUnrecognizedHook = unrechook
65 } 65 }
66 66
67data HandshakeParams 67data HandshakeParams
68 = HParam 68 = HParam
69 { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own 69 { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own
70 , hpOtherCookie :: Maybe Cookie 70 , hpOtherCookie :: Maybe Cookie
@@ -76,6 +76,74 @@ data HandshakeParams
76newHandShakeData :: TransportCrypto -> HandshakeParams -> HandshakeData 76newHandShakeData :: TransportCrypto -> HandshakeParams -> HandshakeData
77newHandShakeData = error "todo" 77newHandShakeData = error "todo"
78 78
79-- | called when we recieve a crypto handshake with valid cookie
80freshCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> IO ()
81freshCryptoSession sessions
82 addr
83 hp@(HParam
84 { hpTheirBaseNonce = Just theirBaseNonce
85 , hpOtherCookie = Just otherCookie
86 , hpTheirSessionKeyPublic = theirSessionKey
87 , hpMySecretKey = key
88 , hpCookieRemotePubkey = remotePublicKey
89 , hpCookieRemoteDhtkey = remoteDhtPublicKey
90 }) -> do
91 let crypto = transportCrypto sessions
92 allsessions = netCryptoSessions sessions
93 ncState0 <- atomically $ newTVar Accepted
94 ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce
95 n24 <- atomically $ transportNewNonce crypto
96 let myhandshakeData = newHandShakeData crypto hp
97 plain = encodePlain myhandshakeData
98 state = computeSharedSecret key remoteDhtPublicKey n24
99 encrypted = encrypt state plain
100 myhandshake = Handshake { handshakeCookie = otherCookie
101 , handshakeNonce = n24
102 , handshakeData = encrypted
103 }
104 ncMyPacketNonce0 <- atomically $ newTVar (baseNonce myhandshakeData)
105 ncHandShake0 <- atomically $ newTVar (Just myhandshake)
106 cookie0 <- atomically $ newTVar (Just otherCookie)
107 newsession <- generateSecretKey
108 ncHooks0 <- atomically $ newTVar (defaultHooks sessions)
109 ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions)
110 ncGroups0 <- atomically $ newTVar (Map.empty)
111 let netCryptoSession =
112 NCrypto { ncState = ncState0
113 , ncTheirBaseNonce= ncTheirBaseNonce0
114 , ncMyPacketNonce = ncMyPacketNonce0
115 , ncHandShake = ncHandShake0
116 , ncCookie = cookie0
117 , ncTheirSessionPublic = Just theirSessionKey
118 , ncSessionSecret = newsession
119 , ncSockAddr = addr
120 , ncHooks = ncHooks0
121 , ncUnrecognizedHook = ncUnrecognizedHook0
122 , ncAllSessions = sessions
123 , ncGroups = ncGroups0
124 }
125 atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession)
126
127-- | Called when we get a handshake, but there's already a session entry.
128updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCryptoSession -> IO ()
129updateCryptoSession sessions addr hp session = do
130 ncState0 <- atomically $ readTVar (ncState session)
131 ncTheirBaseNonce0 <- atomically $ readTVar (ncTheirBaseNonce session)
132 (Cookie _ _ presentCookieDHTKey )<- atomically $ readTVar (ncCookie session)
133 if (ncState0 >= Accepted)
134 -- If the nonce in the handshake and the dht key are both the same as
135 -- the ones we have saved, assume we already handled this and this is a
136 -- duplicate handshake packet, otherwise disregard everything, and
137 -- refresh all state.
138 --
139 then when ( ncTheirBaseNonce0 /= hpTheirBaseNonce hp
140 || presentCookieDHTKey /= hpCookieRemoteDhtkey hp
141 ) $ freshCryptoSession sessions addr hp
142 else if ( ncTheirBaseNonce0 /= hpTheirBaseNonce)
143 then freshCryptoSession sessions addr hp -- basenonce mismatch, trigger refresh
144 else atomically $ modifyTVar (ncState session) Accepted
145
146
79cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto)) 147cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto))
80cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do 148cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do
81 -- Handle Handshake Message 149 -- Handle Handshake Message
@@ -99,7 +167,7 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
99 guard (cookieHash == digest) 167 guard (cookieHash == digest)
100 -- known friend? 168 -- known friend?
101 -- todo 169 -- todo
102 return 170 return
103 HParam 171 HParam
104 { hpTheirBaseNonce = Just baseNonce 172 { hpTheirBaseNonce = Just baseNonce
105 , hpOtherCookie = Just otherCookie 173 , hpOtherCookie = Just otherCookie
@@ -119,43 +187,13 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
119 , hpCookieRemoteDhtkey = remoteDhtPublicKey 187 , hpCookieRemoteDhtkey = remoteDhtPublicKey
120 }) -> do 188 }) -> do
121 sessionsmap <- atomically $ readTVar allsessions 189 sessionsmap <- atomically $ readTVar allsessions
122 -- Do a lookup, in case we decide to handle the update case differently 190 -- Do a lookup, so we can handle the update case differently
123 case Map.lookup addr sessionsmap of 191 case Map.lookup addr sessionsmap of
124 _ -> do -- create new session 192 Nothing -> freshCryptoSession sessions addr hp -- create new session
125 ncState0 <- atomically $ newTVar Accepted 193 Just session -> updateCryptoSession sessions addr hp session -- update existing session
126 ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce 194 return Nothing
127 n24 <- atomically $ transportNewNonce crypto 195
128 let myhandshakeData = newHandShakeData crypto hp 196
129 plain = encodePlain myhandshakeData
130 state = computeSharedSecret key remoteDhtPublicKey n24
131 encrypted = encrypt state plain
132 myhandshake = Handshake { handshakeCookie = otherCookie
133 , handshakeNonce = n24
134 , handshakeData = encrypted
135 }
136 ncMyPacketNonce0 <- atomically $ newTVar (baseNonce myhandshakeData)
137 ncHandShake0 <- atomically $ newTVar (Just myhandshake)
138 cookie0 <- atomically $ newTVar (Just otherCookie)
139 newsession <- generateSecretKey
140 ncHooks0 <- atomically $ newTVar (defaultHooks sessions)
141 ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions)
142 ncGroups0 <- atomically $ newTVar (Map.empty)
143 let netCryptoSession =
144 NCrypto { ncState = ncState0
145 , ncTheirBaseNonce= ncTheirBaseNonce0
146 , ncMyPacketNonce = ncMyPacketNonce0
147 , ncHandShake = ncHandShake0
148 , ncCookie = cookie0
149 , ncTheirSessionPublic = Just theirSessionKey
150 , ncSessionSecret = newsession
151 , ncSockAddr = addr
152 , ncHooks = ncHooks0
153 , ncUnrecognizedHook = ncUnrecognizedHook0
154 , ncAllSessions = sessions
155 , ncGroups = ncGroups0
156 }
157 atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession)
158 return Nothing
159cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do 197cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
160 let crypto = transportCrypto sessions 198 let crypto = transportCrypto sessions
161 allsessions = netCryptoSessions sessions 199 allsessions = netCryptoSessions sessions
@@ -221,7 +259,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
221 last2Bytes (Nonce24 bs) = case S.decode (B.drop 22 bs) of 259 last2Bytes (Nonce24 bs) = case S.decode (B.drop 22 bs) of
222 Right n -> n 260 Right n -> n
223 _ -> error "unreachable-last2Bytes" 261 _ -> error "unreachable-last2Bytes"
224 dATA_NUM_THRESHOLD = 21845 -- = 65535 / 3 262 dATA_NUM_THRESHOLD = 21845 -- = 65535 / 3
225 263
226-- | handles nothing 264-- | handles nothing
227defaultCryptoDataHooks :: Map.Map MessageType [NetCryptoHook] 265defaultCryptoDataHooks :: Map.Map MessageType [NetCryptoHook]