diff options
Diffstat (limited to 'src/Network/Tox/Crypto')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index b8e99d2d..ac3d1ef0 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs | |||
@@ -94,9 +94,9 @@ freshCryptoSession sessions | |||
94 | ncState0 <- atomically $ newTVar Accepted | 94 | ncState0 <- atomically $ newTVar Accepted |
95 | ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce | 95 | ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce |
96 | n24 <- atomically $ transportNewNonce crypto | 96 | n24 <- atomically $ transportNewNonce crypto |
97 | state <- lookupSharedSecret crypto key remoteDhtPublicKey n24 | ||
97 | let myhandshakeData = newHandShakeData crypto hp | 98 | let myhandshakeData = newHandShakeData crypto hp |
98 | plain = encodePlain myhandshakeData | 99 | plain = encodePlain myhandshakeData |
99 | state = computeSharedSecret key remoteDhtPublicKey n24 | ||
100 | encrypted = encrypt state plain | 100 | encrypted = encrypt state plain |
101 | myhandshake = Handshake { handshakeCookie = otherCookie | 101 | myhandshake = Handshake { handshakeCookie = otherCookie |
102 | , handshakeNonce = n24 | 102 | , handshakeNonce = n24 |
@@ -150,14 +150,19 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non | |||
150 | -- Handle Handshake Message | 150 | -- Handle Handshake Message |
151 | let crypto = transportCrypto sessions | 151 | let crypto = transportCrypto sessions |
152 | allsessions = netCryptoSessions sessions | 152 | allsessions = netCryptoSessions sessions |
153 | anyRight xs f = foldr1 (<|>) $ map f xs | 153 | anyRight [] f = return $ Left "missing key" |
154 | anyRight (x:xs) f = f x >>= either (const $ anyRight xs f) (return . Right) | ||
154 | seckeys <- map fst <$> atomically (readTVar (userKeys crypto)) | 155 | seckeys <- map fst <$> atomically (readTVar (userKeys crypto)) |
155 | symkey <- atomically $ transportSymmetric crypto | 156 | symkey <- atomically $ transportSymmetric crypto |
156 | now <- getPOSIXTime | 157 | now <- getPOSIXTime |
157 | let lr = do -- Either Monad | 158 | lr <- fmap join . sequence $ do -- Either Monad |
158 | (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie) | 159 | (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie) |
159 | (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) | 160 | Right $ do -- IO Monad |
160 | <- anyRight seckeys $ \key -> (key,) <$> (decodePlain =<< decrypt (computeSharedSecret key remotePubkey nonce24) encrypted) | 161 | decrypted <- anyRight seckeys $ \key -> do |
162 | secret <- lookupSharedSecret crypto key remotePubkey nonce24 | ||
163 | return $ (key,) <$> (decodePlain =<< decrypt secret encrypted) | ||
164 | return $ do -- Either Monad | ||
165 | (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) <- decrypted | ||
161 | -- check cookie time < 15 seconds ago | 166 | -- check cookie time < 15 seconds ago |
162 | guard (now - fromIntegral cookieTime < 15) | 167 | guard (now - fromIntegral cookieTime < 15) |
163 | -- cookie hash is valid? sha512 of ecookie | 168 | -- cookie hash is valid? sha512 of ecookie |
@@ -208,9 +213,11 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do | |||
208 | let diff :: Word16 | 213 | let diff :: Word16 |
209 | diff = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16 | 214 | diff = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16 |
210 | tempNonce <- addtoNonce24 theirBaseNonce (fromIntegral diff) -- expanding to Word | 215 | tempNonce <- addtoNonce24 theirBaseNonce (fromIntegral diff) -- expanding to Word |
211 | let lr = do -- Either Monad -- | 216 | lr <- fmap join $ sequence $ do -- Either Monad -- |
212 | pubkey <- maybeToEither ncTheirSessionPublic | 217 | pubkey <- maybeToEither ncTheirSessionPublic |
213 | decodePlain =<< decrypt (computeSharedSecret ncSessionSecret pubkey tempNonce) encrypted | 218 | Right $ do -- IO Monad |
219 | secret <- lookupSharedSecret crypto ncSessionSecret pubkey tempNonce | ||
220 | return $ decodePlain =<< decrypt secret encrypted | ||
214 | case lr of | 221 | case lr of |
215 | Left _ -> return Nothing -- decryption failed, ignore packet | 222 | Left _ -> return Nothing -- decryption failed, ignore packet |
216 | Right cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) -> do -- decryption succeeded, | 223 | Right cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) -> do -- decryption succeeded, |