tox: Generate keys within STM monad.

2 files changed, 10 insertions, 2 deletions

diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index a1f40c76..c44282cf 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE TypeOperators #-}
@@ -99,6 +100,7 @@ import Crypto.Error
 #endif
 import Network.Socket (SockAddr)
 import GHC.Exts (Word(..),inline)
+import GHC.Generics (Generic)
 import GHC.Prim
 import Data.Word64Map (fitsInInt)
 import Data.MinMaxPSQ (MinMaxPSQ')
@@ -109,7 +111,7 @@ import System.IO.Unsafe (unsafeDupablePerformIO)
 
 -- | A 16-byte mac and an arbitrary-length encrypted stream.
 newtype Encrypted a = Encrypted ByteString
- deriving (Eq,Ord,Data,ByteArrayAccess)
+ deriving (Eq,Ord,Data,ByteArrayAccess,Hashable,Generic)
 
 newtype Encrypted8 a = E8 (Encrypted (a,Nonce8))
  deriving (Serialize, Show)
@@ -358,7 +360,7 @@ hsalsa20 k n = BA.append a b
 
 
 newtype Nonce24 = Nonce24 ByteString
- deriving (Eq, Ord, ByteArrayAccess, Data)
+ deriving (Eq, Ord, ByteArrayAccess, Data, Generic, Hashable)
 
 nonce24ToWord16 :: Nonce24 -> Word16
 nonce24ToWord16 (Nonce24 n24) = fromIntegral (B.index n24 23) + 256 * fromIntegral (B.index n24 22)
@@ -536,6 +538,7 @@ data TransportCrypto = TransportCrypto
     , rendezvousPublic :: PublicKey
     , transportSymmetric :: STM SymmetricKey
     , transportNewNonce :: STM Nonce24
+    , transportNewKey   :: STM SecretKey
     , userKeys :: STM [(SecretKey,PublicKey)]
     , pendingCookies :: TVar [(SockAddr, (Int, PublicKey))]
     , secretsCache :: SecretsCache
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 1bf6efc5..7011618c 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -101,6 +101,11 @@ newCrypto = do
             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