WIP: Adapting DHT to Tox network (part 4).

1 files changed, 78 insertions, 3 deletions

diff --git a/src/Data/Tox.hs b/src/Data/Tox.hs
index 448b39eb..4449ce65 100644
--- a/src/Data/Tox.hs
+++ b/src/Data/Tox.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DeriveTraversable  #-}
+{-# LANGUAGE DeriveFunctor      #-}
 {-# LANGUAGE PatternSynonyms    #-}
 {-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE TupleSections      #-}
@@ -15,6 +17,9 @@ import Data.Serialize
 import Network.BitTorrent.Address () -- Serialize IP
 import GHC.Generics (Generic)
 import Network.Socket
+import Network.RPC hiding (NodeId)
+import qualified Network.RPC as Envelope (NodeId)
+import Crypto.PubKey.ECC.Types
 
 type Key32   = Word256 -- 32 byte key
 type Nonce8  = Word64  -- 8 bytes
@@ -88,7 +93,7 @@ data Message a = Message
     , msgNonce   :: Nonce24
     , msgPayload :: a
     }
- deriving (Show, Generic)
+ deriving (Show, Generic, Functor, Foldable, Traversable)
 
 isQuery :: Message a -> Bool
 isQuery (Message { msgType = SendNodes })                  = False
@@ -101,8 +106,6 @@ isResponse m = not (isQuery m)
 isError :: Message a -> Bool
 isError _ = False
 
-instance Serialize a => Serialize (Message a) where -- TODO TOX
-
 data PingPayload = PingPayload
     { isPong :: Bool
     , pingId :: Nonce8
@@ -194,3 +197,75 @@ instance Serialize NodeFormat where
 --   [Sendback data, length=8 bytes]
 --   ]
 
+data ToxCipherContext = ToxCipherContext -- TODO
+
+newtype Ciphered = Ciphered { cipheredBytes :: ByteString }
+
+getMessage :: Get (Message Ciphered)
+getMessage = do
+        typ <- get
+        nid <- get
+        tid <- get
+        cnt <- remaining
+        bs <- getBytes cnt
+        return Message { msgType = typ
+                       , msgClient = nid
+                       , msgNonce = tid
+                       , msgPayload = Ciphered bs }
+
+putMessage :: Message Ciphered -> Put
+putMessage (Message {..}) = do
+        put msgType
+        put msgClient
+        put msgNonce
+        let Ciphered bs = msgPayload
+        putByteString bs
+
+decipher :: ToxCipherContext -> Message Ciphered -> Either String (Message ByteString)
+decipher = error "TODO TOX: decipher"
+
+encipher :: ToxCipherContext -> Message ByteString -> Message Ciphered
+encipher = error "TODO TOX: encipher"
+
+-- see rfc7748
+curve25519 :: Curve
+curve25519 = CurveFP (CurvePrime prime curvecommon)
+ where
+    prime = 2^255 - 19 -- (≅ 1 modulo 4)
+
+    -- 1 * v^2 = u^3 + 486662*u^2 + u
+
+    curvecommon = CurveCommon
+        { ecc_a = 486662
+        , ecc_b = 1
+        , ecc_g = Point 9 14781619447589544791020593568409986887264606134616475288964881837755586237401 -- base point
+        , ecc_n = 2^252 + 0x14def9dea2f79cd65812631a5cf5d3ed -- order
+        , ecc_h = 8 -- cofactor
+        }
+
+
+
+instance Envelope Message where
+    type TransactionID Message = Nonce24
+    type NodeId Message = NodeId
+
+    envelopePayload = msgPayload
+
+    envelopeTransaction = msgNonce
+
+    envelopeClass Message { msgType = Ping      } = Query
+    envelopeClass Message { msgType = Pong      } = Response
+    envelopeClass Message { msgType = GetNodes  } = Query
+    envelopeClass Message { msgType = SendNodes } = Response
+
+    buildReply self addr qry payload = (fmap (const payload) qry) { msgClient = self }
+
+instance WireFormat ByteString Message where
+    type SerializableTo ByteString = Serialize
+    type CipherContext ByteString Message = ToxCipherContext
+
+    decodePayload = mapM decode
+    encodePayload = fmap encode
+
+    decodeHeaders ctx bs = runGet getMessage bs >>= decipher ctx
+    encodeHeaders ctx msg = runPut $ putMessage $ encipher ctx msg