More informative types on toxCrypto/toxHandshakes.

1 files changed, 12 insertions, 17 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 6df239b5..8b966266 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(..))
+import Network.Tox.Crypto.Transport          (NetCrypto(..), 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
@@ -239,8 +239,8 @@ data Tox = Tox
     { toxDHT            :: DHT.Client
     , toxOnion          :: Onion.Client RouteId
     , toxToRoute        :: Transport String Onion.AnnouncedRendezvous (PublicKey,Onion.OnionData)
-    , toxCrypto         :: Transport String SockAddr NetCrypto
-    , toxHandshakes     :: Transport String SockAddr NetCrypto
+    , toxCrypto         :: Transport String SockAddr (CryptoPacket Encrypted)
+    , toxHandshakes     :: Transport String SockAddr (Handshake Encrypted)
     , toxCryptoSessions :: NetCryptoSessions
     , toxCryptoKeys     :: TransportCrypto
     , toxRouting        :: DHT.Routing
@@ -441,22 +441,17 @@ 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
-
-    -- TODO: Avoid adapting these transports here.
-    let nc_cryptonet  = layerTransport (\x addr -> Right (NetCrypto x,addr))
-                                       (\(NetCrypto x) addr -> (x,addr))
-                                       cryptonet
-        nc_handshakes = layerTransport (\x addr -> Right (NetHandshake x,addr))
-                                       (\(NetHandshake x) addr -> (x,addr))
-                                       handshakes
-        nc_combo = nc_handshakes
+    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 { sessionTransport = nc_combo
-                                       , 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")
@@ -480,8 +475,8 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
         { toxDHT            = dhtclient
         , toxOnion          = onionclient
         , toxToRoute        = onInbound (updateContactInfo roster) dtacrypt
-        , toxCrypto         = addHandler (hPutStrLn stderr) (cryptoNetHandler sessionsState) nc_cryptonet
-        , toxHandshakes     = addHandler (hPutStrLn stderr) (cryptoNetHandler sessionsState) nc_handshakes
+        , toxCrypto         = addHandler (hPutStrLn stderr) (sessionPacketH sessionsState) cryptonet
+        , toxHandshakes     = addHandler (hPutStrLn stderr) (handshakeH     sessionsState) handshakes
         , toxCryptoSessions = sessionsState
         , toxCryptoKeys     = crypto
         , toxRouting        = mkrouting dhtclient