summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/dhtd.hs5
-rw-r--r--src/Crypto/Tox.hs6
-rw-r--r--src/Network/Tox/Onion/Handlers.hs22
3 files changed, 24 insertions, 9 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 37f16f02..2b0191a3 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -595,13 +595,14 @@ main = do
595 -- _todo :: IO Tox.AnnounceResponse 595 -- _todo :: IO Tox.AnnounceResponse
596 -- -> IO ([Tox.NodeInfo], [Crypto.PubKey.Curve25519.PublicKey], b0) 596 -- -> IO ([Tox.NodeInfo], [Crypto.PubKey.Curve25519.PublicKey], b0)
597 Tox.unwrapAnnounceResponse 597 Tox.unwrapAnnounceResponse
598 <$> Tox.announceH (Tox.toxRouting tox) 598 <$> clientAddress (Tox.toxDHT tox) Nothing
599 <*> Tox.announceH (Tox.toxRouting tox)
599 (Tox.toxTokens tox) 600 (Tox.toxTokens tox)
600 (Tox.toxAnnouncedKeys tox) 601 (Tox.toxAnnouncedKeys tox)
601 (Tox.OnionDestination ni Nothing) 602 (Tox.OnionDestination ni Nothing)
602 (Tox.AnnounceRequest zeros32 nid Tox.zeroID)) 603 (Tox.AnnounceRequest zeros32 nid Tox.zeroID))
603 show -- PublicKey 604 show -- PublicKey
604 (const Nothing)) -- TODO: show token 605 (fmap show))
605 ] 606 ]
606 , dhtParseId = readEither :: String -> Either String Tox.NodeId 607 , dhtParseId = readEither :: String -> Either String Tox.NodeId
607 , dhtSearches = toxSearches 608 , dhtSearches = toxSearches
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index 6660fc13..c8b3665f 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -57,6 +57,7 @@ import qualified Data.ByteArray as BA
57 ;import Data.ByteArray as BA (ByteArrayAccess, Bytes) 57 ;import Data.ByteArray as BA (ByteArrayAccess, Bytes)
58import Data.ByteString as B 58import Data.ByteString as B
59import qualified Data.ByteString.Base16 as Base16 59import qualified Data.ByteString.Base16 as Base16
60import qualified Data.ByteString.Base64 as Base64
60import qualified Data.ByteString.Char8 as C8 61import qualified Data.ByteString.Char8 as C8
61import Data.Data 62import Data.Data
62import Data.Functor.Contravariant 63import Data.Functor.Contravariant
@@ -252,6 +253,9 @@ quoted shows s = '"':shows ('"':s)
252bin2hex :: ByteArrayAccess bs => bs -> String 253bin2hex :: ByteArrayAccess bs => bs -> String
253bin2hex = C8.unpack . Base16.encode . BA.convert 254bin2hex = C8.unpack . Base16.encode . BA.convert
254 255
256bin2base64 :: ByteArrayAccess bs => bs -> String
257bin2base64 = C8.unpack . Base64.encode . BA.convert
258
255instance Show Nonce24 where 259instance Show Nonce24 where
256 showsPrec d nonce = quoted (mappend $ bin2hex nonce) 260 showsPrec d nonce = quoted (mappend $ bin2hex nonce)
257 261
@@ -288,7 +292,7 @@ newtype Nonce32 = Nonce32 ByteString
288 deriving (Eq, Ord, ByteArrayAccess, Data) 292 deriving (Eq, Ord, ByteArrayAccess, Data)
289 293
290instance Show Nonce32 where 294instance Show Nonce32 where
291 showsPrec d nonce = quoted (mappend $ bin2hex nonce) 295 showsPrec d nonce = mappend $ bin2base64 nonce
292 296
293instance Serialize Nonce32 where 297instance Serialize Nonce32 where
294 get = Nonce32 <$> getBytes 32 298 get = Nonce32 <$> getBytes 32
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 91dd843e..167df336 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -159,9 +159,19 @@ handlers net routing toks keydb AnnounceType
159 $ announceH routing toks keydb 159 $ announceH routing toks keydb
160handlers net _ _ keydb _ = Just $ NoReply Right $ dataToRouteH keydb net 160handlers net _ _ keydb _ = Just $ NoReply Right $ dataToRouteH keydb net
161 161
162
163data Rendezvous = Rendezvous
164 { rendezvousKey :: PublicKey
165 , rendezvousNode :: NodeInfo
166 }
167 deriving Eq
168
169instance Show Rendezvous where
170 show (Rendezvous k ni) = concat [show $ key2id k, ":", show ni]
171
162toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 172toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
163 -> Client r 173 -> Client r
164 -> Search NodeId (IP, PortNumber) (Maybe Nonce32) NodeInfo PublicKey 174 -> Search NodeId (IP, PortNumber) (Maybe Nonce32) NodeInfo Rendezvous
165toxidSearch getTimeout client = Search 175toxidSearch getTimeout client = Search
166 { searchSpace = toxSpace 176 { searchSpace = toxSpace
167 , searchNodeAddress = nodeIP &&& nodePort 177 , searchNodeAddress = nodeIP &&& nodePort
@@ -194,23 +204,23 @@ announceSerializer getTimeout = MethodSerializer
194 _ -> Nothing 204 _ -> Nothing
195 } 205 }
196 206
197unwrapAnnounceResponse :: AnnounceResponse -> ([NodeInfo], [PublicKey], Maybe Nonce32) 207unwrapAnnounceResponse :: NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
198unwrapAnnounceResponse (AnnounceResponse is_stored (SendNodes ns)) 208unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns))
199 = case is_stored of 209 = case is_stored of
200 NotStored n32 -> (ns, [], Just n32) 210 NotStored n32 -> (ns, [], Just n32)
201 SendBackKey k -> (ns, [k], Nothing) 211 SendBackKey k -> (ns, [Rendezvous k ni], Nothing)
202 Acknowledged n32 -> (ns, [], Just n32) 212 Acknowledged n32 -> (ns, [], Just n32)
203 213
204announce :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) 214announce :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
205 -> Client r 215 -> Client r
206 -> NodeId 216 -> NodeId
207 -> NodeInfo 217 -> NodeInfo
208 -> IO (Maybe ([NodeInfo],[PublicKey],Maybe Nonce32)) 218 -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32))
209announce getTimeout client nid ni = 219announce getTimeout client nid ni =
210 -- Four tries and then we tap out. 220 -- Four tries and then we tap out.
211 flip fix 4 $ \loop n -> do 221 flip fix 4 $ \loop n -> do
212 let oaddr = OnionDestination ni Nothing 222 let oaddr = OnionDestination ni Nothing
213 mb <- QR.sendQuery client (announceSerializer getTimeout) (AnnounceRequest zeros32 nid zeroID) oaddr 223 mb <- QR.sendQuery client (announceSerializer getTimeout) (AnnounceRequest zeros32 nid zeroID) oaddr
214 maybe (if n>0 then loop $! n - 1 else return Nothing) 224 maybe (if n>0 then loop $! n - 1 else return Nothing)
215 (return . Just . unwrapAnnounceResponse) 225 (return . Just . unwrapAnnounceResponse ni)
216 $ join mb 226 $ join mb