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.hs21
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,