Implemented "dhtkey" publish method.

1 files changed, 86 insertions, 17 deletions

diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 4c3de3e6..6635fad1 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -25,6 +25,8 @@ module Network.Tox.Onion.Transport
     , OnionMessage(..)
     , Rendezvous(..)
     , DataToRoute(..)
+    , OnionData(..)
+    , AnnouncedRendezvous(..)
     , AnnounceResponse(..)
     , AnnounceRequest(..)
     , Forwarding(..)
@@ -41,6 +43,7 @@ module Network.Tox.Onion.Transport
     , N3
     , onionKey
     , onionAliasSelector
+    , selectAlias
     ) where
 
 import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
@@ -50,13 +53,12 @@ import Network.Tox.NodeId
 import qualified Crypto.Tox as ToxCrypto
 import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,FriendRequest,asymNodeInfo)
 
-import Debug.Trace
-import Control.Arrow
 import Control.Applicative
+import Control.Arrow
 import Control.Concurrent.STM
 import Control.Monad
-import qualified Data.ByteString  as B
-         ;import Data.ByteString  (ByteString)
+import qualified Data.ByteString    as B
+         ;import Data.ByteString    (ByteString)
 import Data.Coerce
 import Data.Function
 import Data.Functor.Contravariant
@@ -64,14 +66,16 @@ import Data.Functor.Identity
 import Data.IP
 import Data.Maybe
 import Data.Monoid
-import Data.Serialize             as S
+import Data.Serialize               as S
 import Data.Type.Equality
 import Data.Typeable
 import Data.Word
-import GHC.Generics               ()
+import Debug.Trace
+import GHC.Generics                 ()
 import GHC.TypeLits
 import Network.Socket
 import System.IO
+import qualified Text.ParserCombinators.ReadP as RP
 
 type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
 
@@ -609,6 +613,15 @@ instance Sized OnionData where
             ConstSize n -> n
             VarSize f   -> f req
 
+instance Serialize OnionData where
+    get = do
+        tag <- get
+        case tag :: Word8 of
+            0x9c -> OnionDHTPublicKey <$> get
+            0x20 -> OnionFriendRequest <$> get
+            _    -> fail $ "Unknown onion data: "++show tag
+    put (OnionDHTPublicKey dpk) = put (0x9c :: Word8) >> put dpk
+    put (OnionFriendRequest fr) = put (0x20 :: Word8) >> put fr
 
 selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey)
 selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias skey pkey) _ _)
@@ -731,30 +744,86 @@ data Rendezvous = Rendezvous
  deriving Eq
 
 instance Show Rendezvous where
-    show (Rendezvous k ni) = concat [show $ key2id k, ":", show ni]
-
+    showsPrec d (Rendezvous k ni)
+        = showsPrec d (key2id k)
+          . (':' :)
+          . showsPrec d ni
+
+data AnnouncedRendezvous = AnnouncedRendezvous
+    { remoteUserKey :: PublicKey
+    , rendezvous :: Rendezvous
+    }
+  deriving Eq
+
+instance Show AnnouncedRendezvous where
+    showsPrec d (AnnouncedRendezvous remote rendez)
+        = showsPrec d (key2id remote)
+          . (':' :)
+          . showsPrec d rendez
+
+instance Read AnnouncedRendezvous where
+    readsPrec d = RP.readP_to_S $ do
+        ukstr <- RP.munch (/=':')
+        RP.char ':'
+        rkstr <- RP.munch (/=':')
+        RP.char ':'
+        nistr <- RP.munch (const True)
+        return AnnouncedRendezvous
+            { remoteUserKey = id2key $ read ukstr
+            , rendezvous = Rendezvous
+                { rendezvousKey = id2key $ read rkstr
+                , rendezvousNode = read nistr
+                }
+            }
+
+
+selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector
+selectAlias crypto pkey = do
+        ks <- filter (\(sk,pk) -> pk == id2key pkey)
+                                <$> readTVar (userKeys crypto)
+        maybe (return SearchingAlias)
+              (return . uncurry AnnouncingAlias)
+              (listToMaybe ks)
 
 
 parseDataToRoute
     :: TransportCrypto
          -> (OnionMessage Encrypted,OnionDestination r)
-         -> IO (Either (DataToRoute,Rendezvous) (OnionMessage Encrypted, OnionDestination r))
+         -> IO (Either ((PublicKey,OnionData),AnnouncedRendezvous) (OnionMessage Encrypted, OnionDestination r))
 parseDataToRoute crypto (OnionToRouteResponse dta, od) =
     return $ either (const $ Right (OnionToRouteResponse dta,od)) Left $ do
         -- XXX: Do something with decryption failure?
-        decrypted <- uncomposed
-             $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto)
-                              (asymmNonce dta)
-                              (Right dta)
-        return ( runIdentity decrypted
-               , Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od )
+        dtr <- fmap runIdentity
+                 $ uncomposed
+                 $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto)
+                                  (asymmNonce dta)
+                                  (Right dta)
+        let (sk,pk) = case onionAliasSelector od of
+                SearchingAlias        -> (onionAliasSecret &&& onionAliasPublic) crypto
+                AnnouncingAlias sk pk -> (sk,pk)
+        omsg <- fmap runIdentity
+                $ uncomposed
+                $ decryptMessage (sk,pk)
+                                 (asymmNonce dta)
+                                 (Left (dataFromKey dtr, dataToRoute dtr))
+        return ( (pk, omsg)
+               , AnnouncedRendezvous
+                    (dataFromKey dtr)
+                    $ Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od )
 parseDataToRoute _ msg = return $ Right msg
 
 encodeDataToRoute :: TransportCrypto
-                     -> (DataToRoute,Rendezvous)
+                     -> ((PublicKey,OnionData),AnnouncedRendezvous)
                      -> IO (Maybe (OnionMessage Encrypted,OnionDestination r))
-encodeDataToRoute crypto (plain, Rendezvous pub ni) = do
+encodeDataToRoute crypto ((me,omsg), AnnouncedRendezvous toxid (Rendezvous pub ni)) = do
     nonce <- atomically $ transportNewNonce crypto
+    asel <- atomically $ selectAlias crypto (key2id me)
+    let (sk,pk) = case asel of
+            AnnouncingAlias sk pk -> (sk,pk)
+            _                     -> (onionAliasSecret crypto, onionAliasPublic crypto)
+    let plain = DataToRoute { dataFromKey = pk
+                            , dataToRoute = encryptMessage sk toxid nonce omsg
+                            }
     let dta = encryptMessage (onionAliasSecret crypto) pub nonce plain
     return $ Just ( OnionToRoute pub -- Public key of destination node
                                  Asymm { senderKey  = onionAliasPublic crypto