From aa5ea9e2049c741140773d2adf0f0daea236d913 Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 5 Aug 2017 23:45:31 -0400 Subject: Implemented Tox's announce handler. --- Tox.hs | 362 +++++++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 252 insertions(+), 110 deletions(-) (limited to 'Tox.hs') diff --git a/Tox.hs b/Tox.hs index 8ee065d6..a14e223b 100644 --- a/Tox.hs +++ b/Tox.hs @@ -7,71 +7,78 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Tox where import Control.Applicative import Control.Arrow -import Control.Concurrent (MVar) +import Control.Concurrent (MVar) import Control.Concurrent.STM -import qualified Crypto.Cipher.Salsa as Salsa -import qualified Crypto.Cipher.XSalsa as XSalsa +import Control.Monad +import qualified Crypto.Cipher.ChaChaPoly1305 as Symmetric +import qualified Crypto.Cipher.Salsa as Salsa +import qualified Crypto.Cipher.XSalsa as XSalsa import Crypto.ECC.Class -import qualified Crypto.Error as Cryptonite +import qualified Crypto.Error as Cryptonite import Crypto.Error.Types -import qualified Crypto.MAC.Poly1305 as Poly1305 +import qualified Crypto.MAC.Poly1305 as Poly1305 import Crypto.PubKey.Curve25519 import Crypto.PubKey.ECC.Types import Crypto.Random +import qualified Data.Aeson as JSON + ;import Data.Aeson (FromJSON, ToJSON, (.=)) +import Data.Bitraversable (bisequence) +import Data.Bits +import Data.Bits.ByteString () import Data.Bool import qualified Data.ByteArray as BA - ;import Data.ByteArray (ByteArrayAccess,Bytes) + ;import Data.ByteArray (ByteArrayAccess, Bytes) import qualified Data.ByteString as B ;import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as Base16 -import qualified Data.ByteString.Char8 as C8 -import Data.ByteString.Lazy (toStrict) +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as C8 +import Data.ByteString.Lazy (toStrict) +import Data.Char import Data.Data +import Data.Hashable import Data.IP import Data.Maybe +import qualified Data.MinMaxPSQ as MinMaxPSQ + ;import Data.MinMaxPSQ (MinMaxPSQ') import Data.Monoid -import qualified Data.Serialize as S +import Data.Ord +import qualified Data.Serialize as S +import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) import Data.Typeable import Data.Word +import qualified Data.Wrapper.PSQ as PSQ + ;import Data.Wrapper.PSQ (PSQ) +import qualified Data.Wrapper.PSQInt as Int import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable -import GHC.Generics (Generic) -import Network.Address (Address, fromSockAddr, sockAddrPort, testIdBit, - toSockAddr, setPort, un4map, WantIP(..), ipFamily, - either4or6) +import GHC.Generics (Generic) +import Global6 +import Kademlia +import Network.Address (Address, WantIP (..), either4or6, + fromSockAddr, ipFamily, setPort, + sockAddrPort, testIdBit, + toSockAddr, un4map) +import Network.BitTorrent.DHT.Search (Search (..)) +import qualified Network.DHT.Routing as R import Network.QueryResponse import Network.Socket import System.Endian -import Data.Hashable -import Data.Bits -import Data.Bits.ByteString () -import qualified Text.ParserCombinators.ReadP as RP -import Data.Char -import TriadCommittee -import qualified Network.DHT.Routing as R -import qualified Data.Wrapper.PSQInt as Int -import Data.Time.Clock.POSIX (POSIXTime) -import Global6 -import Data.Ord import System.IO -import qualified Data.Aeson as JSON - ;import Data.Aeson (FromJSON, ToJSON, (.=)) -import Control.Monad -import Text.Read -import Kademlia -import Network.BitTorrent.DHT.Search (Search (..)) +import qualified Text.ParserCombinators.ReadP as RP import Text.Printf -import qualified Crypto.Cipher.ChaChaPoly1305 as Symmetric -import Data.Bitraversable (bisequence) -import ToxMessage (quoted,bin2hex) -import qualified ToxMessage as Tox +import Text.Read +import qualified ToxMessage as Tox + ;import ToxMessage (bin2hex, quoted) +import TriadCommittee +import Network.BitTorrent.DHT.Token as Token {- newtype NodeId = NodeId ByteString @@ -224,7 +231,7 @@ nodeInfo nid saddr | otherwise = Left "Address family not supported." data TransactionId = TransactionId - { transactionKey :: Nonce8 -- ^ Used to lookup pending query. + { transactionKey :: Tox.Nonce8 -- ^ Used to lookup pending query. , cryptoNonce :: Tox.Nonce24 -- ^ Used during the encryption layer. } @@ -247,8 +254,7 @@ pattern OnionRequest0 = Tox.PacketKind 128 -- 0x80 Onion Request 0 pattern OnionRequest1 = Tox.PacketKind 129 -- 0x81 Onion Request 1 pattern OnionRequest2 = Tox.PacketKind 130 -- 0x82 Onion Request 2 pattern AnnounceType = Tox.PacketKind 131 -- 0x83 Announce Request - --- 0x84 Announce Response +pattern AnnounceResponseType = Tox.PacketKind 132 -- 0x84 Announce Response -- 0x85 Onion Data Request (data to route request packet) -- 0x86 Onion Data Response (data to route response packet) -- 0x8c Onion Response 3 @@ -276,19 +282,6 @@ instance Show Tox.PacketKind where showsPrec d AnnounceType = mappend "AnnounceType" showsPrec d (Tox.PacketKind x) = mappend "PacketKind " . showsPrec (d+1) x -newtype Nonce8 = Nonce8 Word64 - deriving (Eq, Ord, S.Serialize) - -instance ByteArrayAccess Nonce8 where - length _ = 8 - withByteArray (Nonce8 w64) kont = - allocaBytes 8 $ \p -> do - poke (castPtr p :: Ptr Word64) $ toBE64 w64 - kont p - -instance Show Nonce8 where - showsPrec d nonce = quoted (mappend $ bin2hex nonce) - {- newtype Tox.Nonce24 = Tox.Nonce24 ByteString deriving (Eq, Ord, ByteArrayAccess) @@ -319,7 +312,7 @@ data Msg = Msg { msgType :: Tox.PacketKind , msgNonce :: Tox.Nonce24 , msgData :: ByteString - , msgSendBack :: Nonce8 + , msgSendBack :: Tox.Nonce8 } deriving Show @@ -400,7 +393,7 @@ putMessage (Message {..}) = do {- data Plain a = Plain - { plainId :: Nonce8 -- transactionKey of TransactionId + { plainId :: Tox.Nonce8 -- transactionKey of TransactionId , plainPayload :: a } deriving (Eq, Show, Generic, Functor, Foldable, Traversable) @@ -426,11 +419,11 @@ key2id pk = case S.decode (BA.convert pk) of Right nid -> nid -zeros32 :: Bytes -zeros32 = BA.replicate 32 0 +zeros32 :: Nonce32 +zeros32 = Nonce32 $ BA.replicate 32 0 -zeros24 :: Bytes -zeros24 = BA.take 24 zeros32 +zeros24 :: ByteString +zeros24 = BA.take 24 zs where Nonce32 zs = zeros32 hsalsa20 k n = a <> b where @@ -451,7 +444,7 @@ computeSharedSecret sk recipient nonce = (hash, crypt) -- cipher state st0 = XSalsa.initialize 20 k nonce -- Poly1305 key - (rs, crypt) = XSalsa.combine st0 zeros32 + (rs, crypt) = XSalsa.combine st0 zs where Nonce32 zs = zeros32 -- Since rs is 32 bytes, this pattern should never fail... Cryptonite.CryptoPassed hash = Poly1305.initialize rs @@ -464,16 +457,25 @@ encryptMessage sk _ recipient plaintext else Left . OnionPayload <$> plaintext -} -encryptAssymetric :: SecretKey -> NodeId -> NodeId -> Msg -> (Tox.PacketKind, Tox.Assymetric) -encryptAssymetric sk pk recipient (Msg typ nonce plaintext sendback) - = ( typ - , Tox.Assymetric - { senderKey = pk - , sent = Tox.UnclaimedAssymetric - { assymetricNonce = nonce - , assymetricData = withSecret encipherAndHash sk recipient nonce (plaintext <> S.encode sendback) - } - } ) +encryptAssymetric :: SecretKey -> NodeId -> NodeId -> Msg -> Tox.Assymetric +encryptAssymetric sk pk recipient (Msg typ nonce plaintext sendback) = assym + where + assym = Tox.Assymetric + { senderKey = pk + , sent = Tox.UnclaimedAssymetric + { assymetricNonce = nonce + , assymetricData = withSecret encipherAndHash sk recipient nonce (plaintext <> S.encode sendback) + } + } + +encryptUnclm :: SecretKey -> NodeId -> NodeId -> Msg -> Tox.UnclaimedAssymetric +encryptUnclm sk pk recipient (Msg typ nonce plaintext _) = unclm + where + unclm = Tox.UnclaimedAssymetric + { assymetricNonce = nonce + , assymetricData = withSecret encipherAndHash sk recipient nonce plaintext + } + {- decryptMessage :: SecretKey -> SecretsCache -> Message Ciphered -> Either String (Message ByteString) @@ -481,15 +483,29 @@ decryptMessage sk _ ciphertext = mapM (withSecret decipherAndAuth sk (msgOrigin ciphertext) (msgNonce ciphertext)) ciphertext -} -decryptAssymetric :: SecretKey -> (Tox.PacketKind, Tox.Assymetric) -> Either String Msg -decryptAssymetric sk (typ,assym) +decryptAssymetric :: SecretKey -> Tox.PacketKind -> Tox.Assymetric -> Either String Msg +decryptAssymetric sk typ assym = f <$> withSecret decipherAndAuth sk (Tox.senderKey assym) nonce (Tox.assymetricData . Tox.sent $ assym) where nonce = Tox.assymetricNonce . Tox.sent $ assym - f bs = uncurry (Msg typ nonce) . second (either (const (Nonce8 0)) id . S.decode) $ B.splitAt (B.length bs - 8) bs + f bs = uncurry (Msg typ nonce) + . second (either (const (Tox.Nonce8 0)) id . S.decode) + $ B.splitAt (B.length bs - 8) bs + +{- +decryptUnclm :: SecretKey -> Tox.PacketKind -> NodeId -> Tox.Nonce8 -> Tox.UnclaimedAssymetric -> Either String Msg +decryptUnclm sk typ sender n8 unclm + = f <$> withSecret decipherAndAuth sk + sender + nonce + (Tox.assymetricData unclm) + where + nonce = Tox.assymetricNonce unclm + f bs = Msg typ nonce bs n8 +-} withSecret f sk recipient nonce x = f hash crypt x where @@ -544,7 +560,7 @@ unzipMessage msg = either (\x -> Left msg { msgPayload = x }) -- TODO: -- Represents the encrypted portion of a Tox packet. --- data Payload a = Payload a !Nonce8 +-- data Payload a = Payload a !Tox.Nonce8 -- -- Generic packet type: Message (Payload ByteString) @@ -565,22 +581,40 @@ encodePacket sk cache msg ni = ( S.runPut . putMessage $ encryptMessage sk cache msgLayer :: SecretKey -> NodeId - -> Transport String NodeInfo (Tox.PacketKind,Tox.Assymetric) + -> Transport String NodeInfo (Tox.PacketKind,InterediateRep) -> Transport String NodeInfo Msg msgLayer sk pk = layerTransport parse serialize where - parse x addr = fmap (,addr) $ decryptAssymetric sk x - serialize x addr = (encryptAssymetric sk pk (nodeId addr) x, addr) - -asymLayer :: Transport String SockAddr Tox.Packet -> Transport String NodeInfo (Tox.PacketKind,Tox.Assymetric) + parse (typ,Assym x) addr = fmap (,addr) $ decryptAssymetric sk typ x + parse (typ,Assym' x) addr = fmap (,addr) $ decryptAssymetric sk typ x + parse (typ,Unclm n x) addr = Right ( Msg typ (Tox.assymetricNonce x) (S.encode (Tox.assymetricData x)) n + , addr) + serialize x addr = case Tox.pktClass (msgType x) of + Tox.AssymetricClass {} -> ((msgType x, Assym $ encryptAssymetric sk pk (nodeId addr) x), addr) + Tox.AliasedClass {} -> ((msgType x, Assym' $ encryptAssymetric sk pk (nodeId addr) x), addr) + Tox.NoncedUnclaimedClass {} -> ((msgType x, Unclm (msgSendBack x) $ encryptUnclm sk pk (nodeId addr) x),addr) + +data InterediateRep = Assym Tox.Assymetric + | Assym' Tox.Assymetric + | Unclm Tox.Nonce8 Tox.UnclaimedAssymetric + +asymLayer :: Transport String SockAddr Tox.Packet -> Transport String NodeInfo (Tox.PacketKind,InterediateRep) asymLayer = layerTransport parse serialize where parse x addr = case Tox.pktClass (Tox.pktKind x) of - Tox.AssymetricClass top fromp -> fmap ((Tox.pktKind x,y),) $ nodeInfo (Tox.senderKey y) addr where y = fromp x - - serialize (typ,assym) addr = (x,nodeAddr addr) - where x = case Tox.pktClass typ of - Tox.AssymetricClass top _ -> top assym + Tox.AssymetricClass top fromp -> go Tox.senderKey fromp Assym + Tox.AliasedClass top fromp -> go Tox.senderKey ((\(Tox.Aliased a) -> a) . fromp) Assym' + Tox.NoncedUnclaimedClass top fromp -> go (const zeroID) fromp (uncurry Unclm) + where go mkaddr fromp c = let y = fromp x + in fmap ((Tox.pktKind x,c y),) + $ nodeInfo (mkaddr y) addr + + serialize (typ,Assym assym) addr = (x,nodeAddr addr) + where x = case Tox.pktClass typ of Tox.AssymetricClass top _ -> top assym + serialize (typ,Assym' assym) addr = (x,nodeAddr addr) + where x = case Tox.pktClass typ of Tox.AliasedClass top _ -> top (Tox.Aliased assym) + serialize (typ,Unclm nonce unclm) addr = (x,nodeAddr addr) + where x = case Tox.pktClass typ of Tox.NoncedUnclaimedClass top _ -> top nonce unclm toxLayer :: Transport String SockAddr ByteString -> Transport String SockAddr Tox.Packet toxLayer = layerTransport (\x addr -> (,addr) <$> S.decode x) @@ -605,11 +639,13 @@ trimPackets :: SockAddr -> ByteString -> IO (Maybe (ByteString -> ByteString)) trimPackets addr bs = do hPutStrLn stderr $ "GOT " ++ show (Tox.PacketKind (B.head bs)) return $ case Tox.PacketKind (B.head bs) of - PingType -> Just id - PongType -> Just id - SendNodesType -> Just id - GetNodesType -> Just id - _ -> Nothing + PingType -> Just id + PongType -> Just id + SendNodesType -> Just id + GetNodesType -> Just id + AnnounceType -> Just id + AnnounceResponseType -> Just id + _ -> Nothing newClient :: SockAddr -> IO (ToxClient, Routing) newClient addr = do @@ -664,18 +700,23 @@ newClient addr = do let mapT = transactionMethods (contramapT nonceKey mapMethods) gen map_var <- atomically $ newTVar (drg, mempty) return $ Left (mapT,map_var) + keydb <- atomically $ newTVar $ AnnouncedKeys PSQ.empty MinMaxPSQ.empty + toks <- do + nil <- nullSessionTokens + atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids. let net = addHandler (handleMessage client) $ addVerbosity $ msgLayer secret pubkey $ onInbound (updateRouting client routing) $ asymLayer + -- $ addHandler (handleMessage aclient) $ toxLayer $ addVerbosity2 $ addHandler trimPackets udp - dispatch tbl var = DispatchMethods + dispatch tbl var handlers = DispatchMethods { classifyInbound = classify - , lookupHandler = handlers var + , lookupHandler = handlers -- var , tableMethods = tbl } @@ -685,8 +726,11 @@ newClient addr = do -- handlers :: TVar -> Method -> Maybe Handler - handlers var PingType = handler PongType pingH - handlers var GetNodesType = handler SendNodesType $ getNodesH routing + -- handlers :: forall h u. (TVar (h, u (MVar Msg)) -> Tox.PacketKind -> Maybe Handler) + handlers :: Tox.PacketKind -> Maybe Handler + handlers PingType = handler PongType pingH + handlers GetNodesType = handler SendNodesType $ getNodesH routing + handlers AnnounceType = handler AnnounceResponseType $ announceH routing toks keydb {- handlers var OnionRequest0 = noreply OnionRequest0 $ onionSend0H (symmetricCipher (return symkey) @@ -697,28 +741,33 @@ newClient addr = do $ onionResponse1H (symmetricDecipher (return symkey)) udp -} - handlers var _ = Nothing + handlers _ = Nothing -- TODO DHTRequest public key (onion) -- TODO DHTRequest NAT ping -- TODO BootstrapInfo 0xf0 + announceHandlers _ = Nothing + genNonce24 var (TransactionId nonce8 _) = atomically $ do (g,pending) <- readTVar var let (bs, g') = randomBytesGenerate 24 g writeTVar var (g',pending) return $ TransactionId nonce8 (Tox.Nonce24 bs) - client = either mkclient mkclient tblvar + client = either mkclient mkclient tblvar handlers mkclient :: DRG g => ( TransactionMethods (g,t (MVar Msg)) TransactionId Msg , TVar (g, t (MVar Msg)) - ) -> ToxClient - mkclient (tbl,var) = Client + ) + -- -> (forall h u. (TVar (h, u (MVar Msg)) -> Tox.PacketKind -> Maybe Handler)) + -> (Tox.PacketKind -> Maybe Handler) + -> ToxClient + mkclient (tbl,var) handlers = Client { clientNet = net - , clientDispatcher = dispatch tbl var + , clientDispatcher = dispatch tbl var handlers , clientErrorReporter = (printErrors stderr) { reportTimeout = reportTimeout ignoreErrors } , clientPending = var , clientAddress = \maddr -> atomically $ do @@ -756,15 +805,15 @@ toxSpace = R.KademliaSpace {- -last8 :: ByteString -> Nonce8 +last8 :: ByteString -> Tox.Nonce8 last8 bs | let len = B.length bs , (len >= 8) - = Nonce8 $ let bs' = B.drop (len - 8) bs + = Tox.Nonce8 $ let bs' = B.drop (len - 8) bs Right w = S.runGet S.getWord64be bs' in w | otherwise - = Nonce8 0 + = Tox.Nonce8 0 dropEnd8 :: ByteString -> ByteString dropEnd8 bs = B.take (B.length bs - 8) bs @@ -772,7 +821,7 @@ dropEnd8 bs = B.take (B.length bs - 8) bs data Payload a = Payload { payload :: a - , sendback :: Nonce8 + , sendback :: Tox.Nonce8 } instance S.Serialize a => S.Serialize (Payload a) where @@ -826,7 +875,7 @@ classify (Msg { msgType = typ _ -> const $ IsUnknown ("Unknown message type: "++show typ) {- -encodePayload typ (TransactionId (Nonce8 tid) nonce) self dest b +encodePayload typ (TransactionId (Tox.Nonce8 tid) nonce) self dest b = Message { msgType = typ , msgOrigin = nodeId self , msgNonce = nonce @@ -856,12 +905,13 @@ transitionCommittee committee (RoutingTransition ni Stranger) = do hPutStrLn stderr $ "delVote "++show (nodeId ni) transitionCommittee committee _ = return $ return () -updateRouting :: ToxClient -> Routing -> NodeInfo -> (Tox.PacketKind, Tox.Assymetric) -> IO () -updateRouting client routing naddr (typ,msg) = do +updateRouting :: ToxClient -> Routing -> NodeInfo -> (Tox.PacketKind, InterediateRep) -> IO () +updateRouting client routing naddr (typ,Assym msg) = do hPutStrLn stderr $ "updateRouting "++show typ case prefer4or6 naddr Nothing of Want_IP4 -> updateTable client naddr (routing4 routing) (committee4 routing) (sched4 routing) Want_IP6 -> updateTable client naddr (routing6 routing) (committee6 routing) (sched6 routing) +updateRouting _ _ _ _ = return () updateTable client naddr tbl committee sched = do self <- atomically $ R.thisNode <$> readTVar tbl @@ -1034,12 +1084,47 @@ putCiphered (Ciphered (Poly1305.Auth mac) bs) = do S.putByteString (BA.convert mac) S.putByteString bs -data Announce = Announce - { announcePingId :: NodeId -- Ping ID - , announceSeeking :: NodeId -- Public key we are searching for - , announceKey :: NodeId -- Public key that we want those sending back data packets to use +newtype Nonce32 = Nonce32 ByteString + deriving (Eq, Ord, ByteArrayAccess, Data) + +instance S.Serialize Nonce32 where + get = Nonce32 <$> S.getBytes 32 + put (Nonce32 bs) = S.putByteString bs + +data AnnounceRequest = AnnounceRequest + { announcePingId :: Nonce32 -- Ping ID + , announceSeeking :: NodeId -- Public key we are searching for + , announceKey :: NodeId -- Public key that we want those sending back data packets to use + } + +instance S.Serialize AnnounceRequest where + get = AnnounceRequest <$> S.get <*> S.get <*> S.get + put (AnnounceRequest p s k) = S.put (p,s,k) + +data KeyRecord = NotStored Nonce32 + | SendBackKey Tox.PubKey + | Acknowledged Nonce32 + +instance S.Serialize KeyRecord where + get = do + is_stored <- S.get :: S.Get Word8 + case is_stored of + 1 -> SendBackKey <$> S.get + 2 -> Acknowledged <$> S.get + _ -> NotStored <$> S.get + put (NotStored n32) = S.put (0 :: Word8) >> S.put n32 + put (SendBackKey key) = S.put (1 :: Word8) >> S.put key + put (Acknowledged n32) = S.put (2 :: Word8) >> S.put n32 + +data AnnounceResponse = AnnounceResponse + { is_stored :: KeyRecord + , announceNodes :: SendNodes } +instance S.Serialize AnnounceResponse where + get = AnnounceResponse <$> S.get <*> S.get + put (AnnounceResponse st ns) = S.put st >> S.put ns + pingH :: NodeInfo -> Ping -> IO Pong pingH _ Ping = return Pong @@ -1075,6 +1160,50 @@ getNodesH routing addr (GetNodes nid) = do k = 4 +-- Toxcore generates `ping_id`s by taking a 32 byte sha hash of the current time, +-- some secret bytes generated when the instance is created, the current time +-- divided by a 20 second timeout, the public key of the requester and the source +-- ip/port that the packet was received from. Since the ip/port that the packet +-- was received from is in the `ping_id`, the announce packets being sent with a +-- ping id must be sent using the same path as the packet that we received the +-- `ping_id` from or announcing will fail. +-- +-- The reason for this 20 second timeout in toxcore is that it gives a reasonable +-- time (20 to 40 seconds) for a peer to announce himself while taking in count +-- all the possible delays with some extra seconds. +announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> NodeInfo -> AnnounceRequest -> IO AnnounceResponse +announceH routing toks keydb naddr req = do + case () of + _ | announcePingId req == zeros32 + -> go False + + _ | Nonce32 bs <- announcePingId req + , let tok = fromPaddedByteString 32 bs + -> checkToken toks naddr tok >>= go + where + go withTok = do + ns <- getNodesH routing naddr (GetNodes (announceSeeking req)) + tm <- getPOSIXTime + let storing = (nodeId naddr == announceSeeking req) + record <- atomically $ do + when (withTok && storing) $ do + let ni = Tox.Aliased (naddr { nodeId = announceKey req }) + -- Note: The following distance calculation assumes that + -- our nodeid doesn't change and is the same for both + -- routing4 and routing6. + d = xor (nodeId (tentativeId routing)) + (announceSeeking req) + modifyTVar' keydb (insertKey tm (announceSeeking req) ni d) + ks <- readTVar keydb + return $ snd <$> MinMaxPSQ.lookup' (announceSeeking req) (keyAssoc ks) + newtok <- if storing + then Nonce32 . toPaddedByteString 32 <$> grantToken toks naddr + else return $ zeros32 + let k = case record of + Nothing -> NotStored newtok + Just (Tox.Aliased ni) | storing -> Acknowledged newtok + Just (Tox.Aliased ni) -> SendBackKey (nodeId ni) + return $ AnnounceResponse k ns {- symmetricCipher :: DRG g => STM ByteString -> STM g -> (g -> STM ()) -> ByteString -> IO (Tox.Nonce24, SymmetricCiphered) @@ -1157,9 +1286,9 @@ onionResponse1H symdecipher udp addr Message{ msgNonce -} intKey :: TransactionId -> Int -intKey (TransactionId (Nonce8 w) _) = fromIntegral w +intKey (TransactionId (Tox.Nonce8 w) _) = fromIntegral w -nonceKey :: TransactionId -> Nonce8 +nonceKey :: TransactionId -> Tox.Nonce8 nonceKey (TransactionId n _) = n -- randomBytesGenerate :: ByteArray byteArray => Int -> gen -> (byteArray, gen) @@ -1168,7 +1297,7 @@ gen :: forall gen. DRG gen => gen -> (TransactionId, gen) gen g = let (bs, g') = randomBytesGenerate 24 g (ws, g'') = randomBytesGenerate 8 g' Right w = S.runGet S.getWord64be ws - in ( TransactionId (Nonce8 w) (Tox.Nonce24 bs), g'' ) + in ( TransactionId (Tox.Nonce8 w) (Tox.Nonce24 bs), g'' ) @@ -1206,3 +1335,16 @@ toxSearch qry = Search nodeSearch client = toxSearch (getNodes client) + +type NodeDistance = Tox.PubKey + +data AnnouncedKeys = AnnouncedKeys + { keyByAge :: PSQ NodeId (Down POSIXTime) -- timeout of 300 seconds + , keyAssoc :: MinMaxPSQ' Tox.PubKey NodeDistance (Tox.Aliased NodeInfo) + } + +insertKey :: POSIXTime -> Tox.PubKey -> Tox.Aliased NodeInfo -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys +insertKey tm pub ni d keydb = AnnouncedKeys + { keyByAge = PSQ.insert pub (Down tm) (keyByAge keydb) + , keyAssoc = MinMaxPSQ.insert' pub ni d (keyAssoc keydb) + } -- cgit v1.2.3