From 343eba08320d9c09350e71c1fd0e8776c3688875 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Tue, 31 Oct 2017 04:06:51 +0000 Subject: missing Network.Tox.Crypto.Handlers --- src/Network/Tox/Crypto/Handlers.hs | 125 +++++++++++++++++++++++++++++++++++++ 1 file changed, 125 insertions(+) create mode 100644 src/Network/Tox/Crypto/Handlers.hs diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs new file mode 100644 index 00000000..f2c792cd --- /dev/null +++ b/src/Network/Tox/Crypto/Handlers.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TupleSections #-} +module Network.Tox.Crypto.Handlers where + +import Network.Tox.Crypto.Transport +import Network.Tox.DHT.Transport (Cookie(..),CookieData(..)) +import Crypto.Tox +import Control.Concurrent.STM +import Network.Address +import qualified Data.Map.Strict as Map +import Crypto.Hash +import Control.Applicative +import Control.Monad +import Data.Time.Clock.POSIX + +data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed + deriving (Eq,Ord,Show,Enum) + + +data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus + , ncTheirPacketNonce:: TVar Nonce24 -- base nonce + packet number + , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number + , ncHandShake :: TVar (Maybe (Handshake Encrypted)) + , ncCookie :: TVar (Maybe Cookie) + , ncTheirSessionPublic :: Maybe PublicKey + , ncSessionSecret :: SecretKey + , ncSockAddr :: SockAddr + } + +data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession) + , transportCrypto :: TransportCrypto + } + +newSessionsState :: TransportCrypto -> IO NetCryptoSessions +newSessionsState crypto = error "todo" + +data HandshakeParams + = HParam + { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own + , hpOtherCookie :: Maybe Cookie + , hpTheirSessionKeyPublic :: PublicKey + , hpMySecretKey :: SecretKey + , hpCookieRemotePubkey :: PublicKey + , hpCookieRemoteDhtkey :: PublicKey + } +newHandShakeData :: TransportCrypto -> HandshakeParams -> HandshakeData +newHandShakeData = error "todo" + +cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do + let crypto = transportCrypto sessions + allsessions = netCryptoSessions sessions + anyRight xs f = foldr1 (<|>) $ map f xs + seckeys <- map fst <$> atomically (readTVar (userKeys crypto)) + symkey <- atomically $ transportSymmetric crypto + now <- getPOSIXTime + let lr = do -- Either Monad + (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie) + (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) + <- anyRight seckeys $ \key -> (key,) <$> (decodePlain =<< decrypt (computeSharedSecret key remotePubkey nonce24) encrypted) + -- check cookie time < 15 seconds ago + guard (now - fromIntegral cookieTime < 15) + -- cookie hash is valid? sha512 of ecookie + let hinit = hashInit + hctx = hashUpdate hinit n24 + hctx' = hashUpdate hctx ecookie + digest = hashFinalize hctx' + guard (cookieHash == digest) + -- known friend? + -- todo + return + HParam + { hpTheirBaseNonce = Just baseNonce + , hpOtherCookie = Just otherCookie + , hpTheirSessionKeyPublic = sessionKey + , hpMySecretKey = key + , hpCookieRemotePubkey = remotePubkey + , hpCookieRemoteDhtkey = remoteDhtkey + } + case lr of + Left _ -> return () + Right hp@(HParam + { hpTheirBaseNonce = Just theirBaseNonce + , hpOtherCookie = Just otherCookie + , hpTheirSessionKeyPublic = theirSessionKey + , hpMySecretKey = key + , hpCookieRemotePubkey = remotePublicKey + , hpCookieRemoteDhtkey = remoteDhtPublicKey + }) -> do + sessionsmap <- atomically $ readTVar allsessions + case Map.lookup addr sessionsmap of + Nothing -> do -- create new session + ncState0 <- atomically $ newTVar Accepted + ncTheirPacketNonce0 <- atomically $ newTVar theirBaseNonce + n24 <- atomically $ transportNewNonce crypto + let myhandshakeData = newHandShakeData crypto hp + plain = encodePlain myhandshakeData + state = computeSharedSecret key remoteDhtPublicKey n24 + encrypted = encrypt state plain + myhandshake = Handshake { handshakeCookie = otherCookie + , handshakeNonce = n24 + , handshakeData = encrypted + } + ncMyPacketNonce0 <- atomically $ newTVar (baseNonce myhandshakeData) + ncHandShake0 <- atomically $ newTVar (Just myhandshake) + cookie0 <- atomically $ newTVar (Just otherCookie) + newsession <- generateSecretKey + let netCryptoSession = + NCrypto { ncState = ncState0 + , ncTheirPacketNonce= ncTheirPacketNonce0 + , ncMyPacketNonce = ncMyPacketNonce0 + , ncHandShake = ncHandShake0 + , ncCookie = cookie0 + , ncTheirSessionPublic = Just theirSessionKey + , ncSessionSecret = newsession + , ncSockAddr = addr + } + atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession) + Just netCryptoSession -> return () -- TODO: UPdate existing session + return Nothing +cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do + let crypto = transportCrypto sessions + -- Handle Encrypted Message + -- TODO + return Nothing +cryptoNetHandlerr _ _ _ = return id -- cgit v1.2.3