summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Onion/Handlers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Onion/Handlers.hs')
-rw-r--r--src/Network/Tox/Onion/Handlers.hs29
1 files changed, 17 insertions, 12 deletions
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 72398735..08f5cabd 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -35,7 +35,7 @@ import Data.Bits
35import Data.Ord 35import Data.Ord
36import Data.Functor.Identity 36import Data.Functor.Identity
37 37
38type Client = QR.Client String PacketKind TransactionId OnionDestination Message 38type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message
39type Message = OnionMessage Identity 39type Message = OnionMessage Identity
40 40
41classify :: Message -> MessageClass String PacketKind TransactionId 41classify :: Message -> MessageClass String PacketKind TransactionId
@@ -59,7 +59,7 @@ classify msg = go msg
59-- The reason for this 20 second timeout in toxcore is that it gives a reasonable 59-- The reason for this 20 second timeout in toxcore is that it gives a reasonable
60-- time (20 to 40 seconds) for a peer to announce himself while taking in count 60-- time (20 to 40 seconds) for a peer to announce himself while taking in count
61-- all the possible delays with some extra seconds. 61-- all the possible delays with some extra seconds.
62announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination -> AnnounceRequest -> IO AnnounceResponse 62announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination r -> AnnounceRequest -> IO AnnounceResponse
63announceH routing toks keydb (OnionToOwner naddr retpath) req = do 63announceH routing toks keydb (OnionToOwner naddr retpath) req = do
64 case () of 64 case () of
65 _ | announcePingId req == zeros32 65 _ | announcePingId req == zeros32
@@ -76,7 +76,7 @@ announceH routing toks keydb (OnionToOwner naddr retpath) req = do
76 let storing = (nodeId naddr == announceSeeking req) 76 let storing = (nodeId naddr == announceSeeking req)
77 record <- atomically $ do 77 record <- atomically $ do
78 when (withTok && storing) $ do 78 when (withTok && storing) $ do
79 let toxpath = OnionToOwner naddr{ nodeId = announceKey req } retpath 79 let toxpath = AnnouncedRoute naddr{ nodeId = announceKey req } retpath
80 -- Note: The following distance calculation assumes that 80 -- Note: The following distance calculation assumes that
81 -- our nodeid doesn't change and is the same for both 81 -- our nodeid doesn't change and is the same for both
82 -- routing4 and routing6. 82 -- routing4 and routing6.
@@ -89,16 +89,16 @@ announceH routing toks keydb (OnionToOwner naddr retpath) req = do
89 then Nonce32 . toPaddedByteString 32 <$> grantToken toks naddr 89 then Nonce32 . toPaddedByteString 32 <$> grantToken toks naddr
90 else return $ zeros32 90 else return $ zeros32
91 let k = case record of 91 let k = case record of
92 Nothing -> NotStored newtok 92 Nothing -> NotStored newtok
93 Just (OnionDestination {}) | storing -> Acknowledged newtok 93 Just _ | storing -> Acknowledged newtok
94 Just (OnionToOwner ni _) -> SendBackKey $ id2key (nodeId ni) 94 Just (AnnouncedRoute ni _) -> SendBackKey $ id2key (nodeId ni)
95 let response = AnnounceResponse k ns 95 let response = AnnounceResponse k ns
96 hPutStrLn stderr $ unwords ["Announce:", show req, "-reply->", show response] 96 hPutStrLn stderr $ unwords ["Announce:", show req, "-reply->", show response]
97 return response 97 return response
98 98
99dataToRouteH :: 99dataToRouteH ::
100 TVar AnnouncedKeys 100 TVar AnnouncedKeys
101 -> Transport err OnionDestination (OnionMessage f) 101 -> Transport err (OnionDestination r) (OnionMessage f)
102 -> addr 102 -> addr
103 -> OnionMessage f 103 -> OnionMessage f
104 -> IO () 104 -> IO ()
@@ -111,18 +111,23 @@ dataToRouteH keydb udp _ (OnionToRoute pub assym) = do
111 return rpath 111 return rpath
112 forM_ mb $ \rpath -> do 112 forM_ mb $ \rpath -> do
113 -- forward 113 -- forward
114 sendMessage udp rpath $ OnionToRouteResponse assym 114 sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse assym
115 hPutStrLn stderr $ "Forwarding data-to-route -->"++show k 115 hPutStrLn stderr $ "Forwarding data-to-route -->"++show k
116 116
117type NodeDistance = NodeId 117type NodeDistance = NodeId
118 118
119data AnnouncedRoute = AnnouncedRoute NodeInfo (ReturnPath N3)
120
121toOnionDestination :: AnnouncedRoute -> OnionDestination r
122toOnionDestination (AnnouncedRoute ni rpath) = OnionToOwner ni rpath
123
119data AnnouncedKeys = AnnouncedKeys 124data AnnouncedKeys = AnnouncedKeys
120 { keyByAge :: !(PSQ NodeId (Down POSIXTime)) -- timeout of 300 seconds 125 { keyByAge :: !(PSQ NodeId (Down POSIXTime)) -- timeout of 300 seconds
121 , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,OnionDestination)) 126 , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,AnnouncedRoute))
122 } 127 }
123 128
124 129
125insertKey :: POSIXTime -> NodeId -> OnionDestination -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys 130insertKey :: POSIXTime -> NodeId -> AnnouncedRoute -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys
126insertKey tm pub toxpath d keydb = AnnouncedKeys 131insertKey tm pub toxpath d keydb = AnnouncedKeys
127 { keyByAge = PSQ.insert pub (Down tm) (keyByAge keydb) 132 { keyByAge = PSQ.insert pub (Down tm) (keyByAge keydb)
128 , keyAssoc = case MinMaxPSQ.lookup' pub (keyAssoc keydb) of 133 , keyAssoc = case MinMaxPSQ.lookup' pub (keyAssoc keydb) of
@@ -134,12 +139,12 @@ areq :: Message -> Either String AnnounceRequest
134areq (OnionAnnounce assym) = Right $ fst $ runIdentity $ assymData assym 139areq (OnionAnnounce assym) = Right $ fst $ runIdentity $ assymData assym
135areq _ = Left "Unexpected non-announce OnionMessage" 140areq _ = Left "Unexpected non-announce OnionMessage"
136 141
137handlers :: Transport err OnionDestination Message 142handlers :: Transport err (OnionDestination r) Message
138 -> Routing 143 -> Routing
139 -> TVar SessionTokens 144 -> TVar SessionTokens
140 -> TVar AnnouncedKeys 145 -> TVar AnnouncedKeys
141 -> PacketKind 146 -> PacketKind
142 -> Maybe (MethodHandler String TransactionId OnionDestination Message) 147 -> Maybe (MethodHandler String TransactionId (OnionDestination r) Message)
143handlers net routing toks keydb AnnounceType 148handlers net routing toks keydb AnnounceType
144 = Just 149 = Just
145 $ MethodHandler areq (\(TransactionId n8 n24) src dst -> OnionAnnounceResponse n8 n24 . Identity) 150 $ MethodHandler areq (\(TransactionId n8 n24) src dst -> OnionAnnounceResponse n8 n24 . Identity)