Integrated TCP relay server.

1 files changed, 49 insertions, 0 deletions

diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index d418f504..a7f1ae83 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -24,6 +24,7 @@ module Crypto.Tox
     , toPublic
     , SymmetricKey(..)
     , TransportCrypto(..)
+    , newCrypto
     , SecretsCache
     , newSecretsCache
     , Encrypted
@@ -105,6 +106,7 @@ import Crypto.Error.Types                     (CryptoFailable (..), throwCryptoE
 import Crypto.ECC
 import Crypto.Error
 #endif
+import Crypto.Random
 import Network.Socket (SockAddr)
 import GHC.Exts (Word(..),inline)
 import GHC.Generics (Generic)
@@ -118,6 +120,8 @@ import System.IO.Unsafe (unsafeDupablePerformIO)
 import Data.Functor.Compose
 import qualified Rank2
 import Data.Functor.Identity
+import DPut
+import DebugTag
 
 -- | A 16-byte mac and an arbitrary-length encrypted stream.
 newtype Encrypted a = Encrypted ByteString
@@ -658,3 +662,48 @@ xorsum bs = unsafeDupablePerformIO $ BA.withByteArray bs $ \ptr16 -> do
     loop (wcnt - 1) $ case r of
         0 -> 0
         _ -> 256 * fromIntegral (BA.index bs (BA.length bs - 1))
+
+showHex :: BA.ByteArrayAccess ba => ba -> String
+showHex bs = C8.unpack $ Base16.encode $ BA.convert bs
+
+newCrypto :: IO TransportCrypto
+newCrypto = do
+    secret <- generateSecretKey
+    alias <- generateSecretKey
+    ralias <- generateSecretKey
+    let pubkey    = toPublic secret
+        aliaspub  = toPublic alias
+        raliaspub = toPublic ralias
+    ukeys <- atomically $ newTVar []
+    (symkey, drg) <- do
+        drg0 <- getSystemDRG
+        return $ randomBytesGenerate 32 drg0 :: IO (ByteString, SystemDRG)
+    noncevar <- atomically $ newTVar $ fst $ withDRG drg drgNew
+    cookieKeys <- atomically $ newTVar []
+    cache <- newSecretsCache
+    dput XNetCrypto $ "secret(tox) = " ++ showHex secret
+    dput XNetCrypto $ "public(tox) = " ++ showHex pubkey
+    dput XNetCrypto $ "symmetric(tox) = " ++ showHex symkey
+    return TransportCrypto
+        { transportSecret = secret
+        , transportPublic = pubkey
+        , onionAliasSecret = alias
+        , onionAliasPublic = aliaspub
+        , rendezvousSecret = ralias
+        , rendezvousPublic = raliaspub
+        , transportSymmetric = return $ SymmetricKey symkey
+        , transportNewNonce = do
+            drg1 <- readTVar noncevar
+            let (nonce, drg2) = withDRG drg1 (Nonce24 <$> getRandomBytes 24)
+            writeTVar noncevar drg2
+            return nonce
+        , transportNewKey = do
+            drg1 <- readTVar noncevar
+            let (k, drg2) = withDRG drg1 generateSecretKey
+            writeTVar noncevar drg2
+            return k
+        , userKeys = return []
+        , pendingCookies = cookieKeys
+        , secretsCache = cache
+        }
+