3 files changed, 24 insertions, 48 deletions

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