Initialize Tox secret key.

3 files changed, 37 insertions, 1 deletions

diff --git a/src/Network/DatagramServer/Mainline.hs b/src/Network/DatagramServer/Mainline.hs
index 1f07b13f..fea64ee6 100644
--- a/src/Network/DatagramServer/Mainline.hs
+++ b/src/Network/DatagramServer/Mainline.hs
@@ -51,6 +51,7 @@ module Network.DatagramServer.Mainline
        , KQueryArgs
        , QueryExtra(..)
        , ResponseExtra(..)
+       , PacketDestination(..)
 
        , NodeId(..)
        , nodeIdSize
@@ -347,6 +348,10 @@ instance WireFormat BValue KMessageOf where
     encodeHeaders _ kmsg _ = L.toStrict $ BE.encode kmsg
     encodePayload msg = fmap BE.toBEncode msg
 
+    initializeServerState _ mbid = do
+        i <- maybe genNodeId return mbid
+        return (i, ())
+
 -- | KRPC 'compact list' compatible encoding: contact information for
 -- nodes is encoded as a 26-byte string. Also known as "Compact node
 -- info" the 20-byte Node ID in network byte order has the compact
diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs
index 8d2f9289..1763e74c 100644
--- a/src/Network/DatagramServer/Tox.hs
+++ b/src/Network/DatagramServer/Tox.hs
@@ -45,6 +45,7 @@ import Crypto.Error.Types
 import Data.Hashable
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
+import Data.ByteArray (convert)
 
 
 type Key32   = Word256 -- 32 byte key
@@ -391,4 +392,10 @@ instance WireFormat ByteString Message where
     decodeHeaders ctx bs = runGet getMessage bs >>= decipher ctx
     encodeHeaders ctx msg recipient = runPut $ putMessage $ encipher ctx (toxID recipient) msg
 
+    initializeServerState _ _ = do
+        k <- generateSecretKey
+        let Right nid = S.decode $ convert $ toPublic k
+        return (nid, ToxCipherContext k)
+
+
 instance Read (NodeId Message) where readsPrec d s = map (\(w,xs) -> (NodeId w, xs)) $ decodeHex s
diff --git a/src/Network/DatagramServer/Types.hs b/src/Network/DatagramServer/Types.hs
index 14968764..6aa7aeaa 100644
--- a/src/Network/DatagramServer/Types.hs
+++ b/src/Network/DatagramServer/Types.hs
@@ -35,7 +35,7 @@ import Data.IP
 import Network.Socket
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
-import Text.Read        (readMaybe)
+import Text.Read        (readMaybe, readEither)
 import Data.Serialize                  as S
 import qualified Data.ByteString.Char8 as Char8
 import qualified Data.ByteString as BS
@@ -43,6 +43,7 @@ import Data.ByteString.Base16          as Base16
 import System.Entropy
 import Network.DatagramServer.Error
 import Data.LargeWord
+import Data.Char
 
 
 class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
@@ -274,6 +275,26 @@ deriving instance ( Show (NodeId dht)
                   , Show addr
                   , Show u ) => Show (NodeInfo dht addr u)
 
+hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F')
+
+instance ( FiniteBits (NodeId dht)
+         , Read (NodeId dht)
+         , Read (NodeAddr addr)
+         , Default u
+         ) => Read (NodeInfo dht addr u) where
+  readsPrec i = RP.readP_to_S $ do
+    RP.skipSpaces
+    let n = finiteBitSize (undefined :: NodeId dht) `div` 4
+    hexhash <- sequence $ replicate n (RP.satisfy hexdigit)
+    RP.char '@' RP.+++ RP.satisfy isSpace
+    addrstr <- RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')'))
+                RP.+++ RP.munch (not . isSpace)
+    addr <- either fail return $ readEither addrstr
+    nid <- either fail return $ readEither hexhash
+    return $ NodeInfo nid addr def
+
+
+
 mapAddress :: (addr -> b) -> NodeInfo dht addr u -> NodeInfo dht b u
 mapAddress f ni = ni { nodeAddr = fmap f (nodeAddr ni) }
 
@@ -348,6 +369,9 @@ class (Envelope envelope, Address (PacketDestination envelope)) => WireFormat ra
     encodeHeaders :: CipherContext raw envelope -> envelope raw -> PacketDestination envelope -> ByteString
     encodePayload :: SerializableTo raw a => envelope a -> envelope raw
 
+    initializeServerState :: Proxy (envelope raw) -> Maybe (NodeId envelope) -> IO (NodeId envelope, CipherContext raw envelope)
+
+
 encodeHexDoc :: Serialize x => x -> Doc
 encodeHexDoc nid = PP.text $ Char8.unpack $ Base16.encode $ S.encode nid