Decrypt TCP relay packets.

1 files changed, 29 insertions, 8 deletions

diff --git a/examples/toxrelay.hs b/examples/toxrelay.hs
index 60c2a44b..fdf0c011 100644
--- a/examples/toxrelay.hs
+++ b/examples/toxrelay.hs
@@ -15,6 +15,7 @@ import Crypto.Tox
 import Data.Tox.Relay
 import Network.StreamServer
 import Network.Address (getBindAddress)
+import Network.Tox (newCrypto)
 
 
 
@@ -28,18 +29,37 @@ hGetSized h = runGet get <$> B.hGet h len
  where
     ConstSize len = size :: Size x
 
-relaySession :: TVar (IntMap Handle) -> (RelayPacket -> IO ()) -> sock -> Int -> Handle -> IO ()
-relaySession cons dispatch _ conid h = do
+relaySession :: TransportCrypto -> TVar (IntMap Handle) -> (RelayPacket -> IO ()) -> sock -> Int -> Handle -> IO ()
+relaySession crypto cons dispatch _ conid h = do
     atomically $ modifyTVar' cons $ IntMap.insert conid h
-    mhello <- fmap (>>= decryptPayload _todo) $ hGetSized h
-    B.hPut h $ encode $ encryptPayload _todo $ Welcome _todo _todo
+    -- mhello <- fmap (>>= \h -> decryptPayload (computeSharedSecret me (helloFrom h) (helloNonce h)) h) $ hGetSized h
+
+    (hGetSized h >>=) $ mapM_ $ \helloE -> do
+
+    let me = transportSecret crypto
+        them = helloFrom helloE
+
+    noncef <- lookupNonceFunction crypto me them
+    let mhello = decryptPayload (noncef $ helloNonce helloE) helloE
+
     forM_ mhello $ \hello -> do
+
+        (me',welcome) <- atomically $ do
+            skey <- transportNewKey crypto
+            dta <- HelloData (toPublic skey) <$> transportNewNonce crypto
+            w24 <- transportNewNonce crypto
+            return (skey, Welcome w24 $ pure dta)
+        B.hPut h $ encode $ encryptPayload (noncef $ welcomeNonce welcome) welcome
+
+        let them' = sessionPublicKey (runIdentity $ helloData hello)
+        noncef' <- lookupNonceFunction crypto me' them'
+
         let _ = hello :: Hello Identity
-        fix $ \loop -> do
-            m <- (>>= decrypt _todo >=> decodePlain) <$> hGetPrefixed h
+        flip fix (sessionBaseNonce $ runIdentity $ helloData hello) $ \loop n24 -> do
+            m <- (>>= decrypt (noncef' n24) >=> decodePlain) <$> hGetPrefixed h
             forM_ m $ \p -> do
                 dispatch p
-                loop
+                loop (incrementNonce24 n24)
      `finally`
         atomically (modifyTVar' cons $ IntMap.delete conid)
 
@@ -47,11 +67,12 @@ relaySession cons dispatch _ conid h = do
 
 main :: IO ()
 main = do
+    crypto <- newCrypto
     cons <- newTVarIO IntMap.empty
     a <- getBindAddress "33445" True
     h <- streamServer ServerConfig
                         { serverWarn = hPutStrLn stderr
-                        , serverSession = relaySession cons print
+                        , serverSession = relaySession crypto cons print
                         }
                       a