From e086fb825a24293725b5c57cc567739c4ca796db Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 2 Jun 2018 00:25:00 -0400 Subject: Delete NetCrypto type, separate transports for Handshake,CryptoPacket. --- src/Network/Tox.hs | 17 +++++---------- src/Network/Tox/Crypto/Handlers.hs | 41 +++++++++++++++++-------------------- src/Network/Tox/Crypto/Transport.hs | 14 ------------- 3 files changed, 24 insertions(+), 48 deletions(-) (limited to 'src/Network') diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 8b966266..7ee4dbe0 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -97,7 +97,7 @@ import Crypto.Tox import Data.Word64Map (fitsInInt) import qualified Data.Word64Map (empty) import Network.Kademlia.Bootstrap (forkPollForRefresh, bootstrap) -import Network.Tox.Crypto.Transport (NetCrypto(..), CryptoMessage, HandshakeData(..), Handshake(..),CryptoPacket) +import Network.Tox.Crypto.Transport (CryptoMessage, HandshakeData(..), Handshake(..),CryptoPacket) import Network.Tox.Crypto.Handlers import qualified Network.Tox.DHT.Handlers as DHT import qualified Network.Tox.DHT.Transport as DHT @@ -441,17 +441,10 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do let ignoreErrors _ = return () -- Set this to (hPutStrLn stderr) to debug onion route building. orouter <- newOnionRouter ignoreErrors (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) <- toxTransport crypto orouter lookupClose udp - let sessionsState = sessionsState0 { sessionTransport = nc_combo - , transportCrypto = crypto } - where - -- TODO: This send-only transport is obviated by it's two components. - nc_combo = Transport - { sendMessage = \addr -> \case - NetCrypto x -> sendMessage cryptonet addr x - NetHandshake x -> sendMessage handshakes addr x - , awaitMessage = \_ -> throwIO (userError "oops: awaitMessage nc_combo") - , closeTransport = hPutStrLn stderr "oops: closeTransport nc_combo" - } + + let sessionsState = sessionsState0 { sendHandshake = sendMessage handshakes + , sendSessionPacket = sendMessage cryptonet + , transportCrypto = crypto } let dhtnet0 = layerTransportM (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt tbl4 = DHT.routing4 $ mkrouting (error "missing client") tbl6 = DHT.routing6 $ mkrouting (error "missing client") diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 0027e414..cc2fba6d 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs @@ -4,7 +4,6 @@ {-# LANGUAGE DeriveFunctor #-} module Network.Tox.Crypto.Handlers where -import Network.QueryResponse import Network.Tox.NodeId import Network.Tox.Crypto.Transport import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..), NoSpam(..)) @@ -299,8 +298,9 @@ data NetCryptoSessions = NCSessions , outboundQueueCapacity :: Word32 , nextSessionId :: TVar SessionID , announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession] - , sessionTransport :: Transport String SockAddr NetCrypto - , listenerIDSupply :: TVar Supply + , sendHandshake :: SockAddr -> Handshake Encrypted -> IO () + , sendSessionPacket :: SockAddr -> CryptoPacket Encrypted -> IO () + , listenerIDSupply :: TVar Supply } -- | This is the type of a hook to run when a session is created. @@ -379,7 +379,8 @@ newSessionsState crypto unrechook hooks = do , outboundQueueCapacity = 400 , nextSessionId = nextSessionId0 , announceNewSessionHooks = announceNewSessionHooks0 - , sessionTransport = error "Need to set sessionTransport field of NetCryptoSessions!" + , sendHandshake = error "Need to set sendHandshake field of NetCryptoSessions!" + , sendSessionPacket = error "Need to set sendSessionPacket field of NetCryptoSessions!" , listenerIDSupply = lsupplyVar } @@ -524,7 +525,7 @@ freshCryptoSession sessions let myhandshake= encodeHandshake <$> mbMyhandshakeData ncHandShake0 <- atomically $ newTVar (frmMaybe myhandshake) forM myhandshake $ \response_handshake -> do - sendMessage (sessionTransport sessions) addr (NetHandshake response_handshake) + sendHandshake sessions addr response_handshake ncMyPacketNonce0 <- atomically $ newTVar newBaseNonce cookie0 <- atomically $ newTVar (HaveCookie otherCookie) newsession <- generateSecretKey @@ -634,7 +635,7 @@ runUponHandshake netCryptoSession0 addr pktoq = do fix $ \loop -> do (_,pkt) <- atomically $ PQ.dequeueOutgoing pktoq dput XNetCrypto "NetCryptoDequeueOutgoing thread... Sending encrypted Packet" - sendMessage (sessionTransport sessions) addr (NetCrypto pkt) + sendSessionPacket sessions addr pkt loop -- launch ping thread fuzz <- randomRIO (0,2000) @@ -706,10 +707,6 @@ updateCryptoSession sessions addr hp session handshake = do then freshCryptoSession sessions addr hp -- basenonce mismatch, trigger refresh else atomically $ writeTVar (ncState session) {-Accepted-}(InProgress AwaitingSessionPacket) -cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto)) -cryptoNetHandler sessions addr (NetHandshake hs) = handshakeH sessions addr hs -cryptoNetHandler sessions addr (NetCrypto pkt) = sessionPacketH sessions addr pkt - handshakeH :: NetCryptoSessions -> SockAddr -> Handshake Encrypted -> IO (Maybe a) handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do dput XNetCrypto ("RECIEVED HANDSHAKE from " ++ show addr) @@ -728,18 +725,18 @@ handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypte (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie) Right $ do -- IO Monad decrypted <- anyRight seckeys $ \key -> do - dput XNetCrypto $ "cryptoNetHandler: remotePubkey = " ++ show (key2id $ remotePubkey) - dput XNetCrypto $ "cryptoNetHandler: nonce24 = " ++ show nonce24 + dput XNetCrypto $ "(NetCrypto)handshakeH: remotePubkey = " ++ show (key2id $ remotePubkey) + dput XNetCrypto $ "(NetCrypto)handshakeH: nonce24 = " ++ show nonce24 secret <- lookupSharedSecret crypto key remotePubkey nonce24 let step1 = decrypt secret encrypted case step1 of Left s -> do - dput XNetCrypto $ "cryptoNetHandler: (decrypt) " ++ s + dput XNetCrypto $ "(NetCrypto)handshakeH: (decrypt) " ++ s return (Left s) Right pln -> do case decodePlain pln of Left s -> do - dput XNetCrypto $ "cryptoNetHandler: (decodePlain) " ++ s + dput XNetCrypto $ "(NetCrypto)handshakeH: (decodePlain) " ++ s return (Left s) Right x -> return (Right (key,x)) return $ do -- Either Monad @@ -765,7 +762,7 @@ handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypte , hpCookieRemoteDhtkey = remoteDhtkey } case lr of - Left s -> dput XNetCrypto ("cryptoNetHandler: " ++ s) + Left s -> dput XNetCrypto ("(NetCrypto)handshakeH: " ++ s) Right hp@(HParam { hpTheirBaseNonce = Just theirBaseNonce , hpOtherCookie = otherCookie @@ -774,7 +771,7 @@ handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypte , hpCookieRemotePubkey = remotePublicKey , hpCookieRemoteDhtkey = remoteDhtPublicKey }) -> do - dput XNetCrypto ("cryptoNetHandler: hpTheirBaseNonce = " ++ show theirBaseNonce) + dput XNetCrypto ("(NetCrypto)handshakeH: hpTheirBaseNonce = " ++ show theirBaseNonce) sessionsmap <- atomically $ readTVar allsessions -- Do a lookup, so we can handle the update case differently case Map.lookup addr sessionsmap of @@ -812,25 +809,25 @@ sessionPacketH sessions addr (CryptoPacket nonce16 encrypted) = do lr <- fmap join $ sequence $ do -- Either Monad -- pubkey <- maybeToEither mbpublickey Right $ do -- IO Monad - dput XNetCrypto $ "cryptoNetHandler: pubkey = " ++ show (key2id $ pubkey) - dput XNetCrypto $ "cryptoNetHandler: theirBaseNonce = " ++ show theirBaseNonce - dput XNetCrypto $ "cryptoNetHandler: tempNonce = " ++ show tempNonce + dput XNetCrypto $ "(NetCrypto)sessionPacketH: pubkey = " ++ show (key2id $ pubkey) + dput XNetCrypto $ "(NetCrypto)sessionPacketH: theirBaseNonce = " ++ show theirBaseNonce + dput XNetCrypto $ "(NetCrypto)sessionPacketH: tempNonce = " ++ show tempNonce ++ " nonce16=" ++ printf "0x%x" nonce16 ++ " last2bytes =" ++ printf "0x%x" (last2Bytes theirBaseNonce) secret <- lookupSharedSecret crypto ncSessionSecret pubkey tempNonce let step1 = decrypt secret encrypted case step1 of Left s -> do - dput XNetCrypto $ "cryptoNetHandler: (decrypt) " ++ s + dput XNetCrypto $ "(NetCrypto)sessionPacketH: (decrypt) " ++ s return (Left s) Right pln -> do case decodePlain pln of Left s -> do - dput XNetCrypto $ "cryptoNetHandler: (decodePlain) " ++ s + dput XNetCrypto $ "(NetCrypto)sessionPacketH: (decodePlain) " ++ s return (Left s) Right x -> return (Right x) case lr of Left s -> do - dput XNetCrypto $ "cryptoNetHandler: " ++ s + dput XNetCrypto $ "(NetCrypto)sessionPacketH: " ++ s return Nothing -- decryption failed, ignore packet Right cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) -> do -- decryption succeeded, -- TODO: Why do I need bufferStart & bufferEnd? diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs index 2c998006..0588da4b 100644 --- a/src/Network/Tox/Crypto/Transport.hs +++ b/src/Network/Tox/Crypto/Transport.hs @@ -9,7 +9,6 @@ module Network.Tox.Crypto.Transport , encodeCrypto , parseHandshakes , encodeHandshakes - , NetCrypto(..) , CryptoData(..) , CryptoMessage(..) , MessageName(..) @@ -77,10 +76,6 @@ import Data.Serialize as S import Control.Arrow -data NetCrypto - = NetHandshake (Handshake Encrypted) - | NetCrypto (CryptoPacket Encrypted) - parseCrypto :: (ByteString, SockAddr) -> Either (CryptoPacket Encrypted, SockAddr) (ByteString, SockAddr) parseCrypto ((B.uncons -> Just (0x1b,pkt)),saddr) = either (\_ -> Right (pkt,saddr)) (\x -> Left (x ,saddr)) @@ -98,15 +93,6 @@ encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr) encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr) -parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr) -parseNetCrypto (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetHandshake <$> runGet get pkt -parseNetCrypto (B.uncons -> Just (0x1b,pkt)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetCrypto <$> runGet get pkt -parseNetCrypto _ _ = Left "parseNetCrypto: ?" - -encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr) -encodeNetCrypto (NetHandshake x) saddr = (B.cons 0x1a (runPut $ put x),saddr) -encodeNetCrypto (NetCrypto x) saddr = (B.cons 0x1b (runPut $ put x),saddr) - data Handshake (f :: * -> *) = Handshake { -- The cookie is a cookie obtained by -- sending a cookie request packet to the peer and getting a cookie -- cgit v1.2.3