diff options
Diffstat (limited to 'src/Network/Tox/Onion/Handlers.hs')
-rw-r--r-- | src/Network/Tox/Onion/Handlers.hs | 29 |
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 | |||
35 | import Data.Ord | 35 | import Data.Ord |
36 | import Data.Functor.Identity | 36 | import Data.Functor.Identity |
37 | 37 | ||
38 | type Client = QR.Client String PacketKind TransactionId OnionDestination Message | 38 | type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message |
39 | type Message = OnionMessage Identity | 39 | type Message = OnionMessage Identity |
40 | 40 | ||
41 | classify :: Message -> MessageClass String PacketKind TransactionId | 41 | classify :: 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. |
62 | announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination -> AnnounceRequest -> IO AnnounceResponse | 62 | announceH :: Routing -> TVar SessionTokens -> TVar AnnouncedKeys -> OnionDestination r -> AnnounceRequest -> IO AnnounceResponse |
63 | announceH routing toks keydb (OnionToOwner naddr retpath) req = do | 63 | announceH 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 | ||
99 | dataToRouteH :: | 99 | dataToRouteH :: |
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 | ||
117 | type NodeDistance = NodeId | 117 | type NodeDistance = NodeId |
118 | 118 | ||
119 | data AnnouncedRoute = AnnouncedRoute NodeInfo (ReturnPath N3) | ||
120 | |||
121 | toOnionDestination :: AnnouncedRoute -> OnionDestination r | ||
122 | toOnionDestination (AnnouncedRoute ni rpath) = OnionToOwner ni rpath | ||
123 | |||
119 | data AnnouncedKeys = AnnouncedKeys | 124 | data 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 | ||
125 | insertKey :: POSIXTime -> NodeId -> OnionDestination -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys | 130 | insertKey :: POSIXTime -> NodeId -> AnnouncedRoute -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys |
126 | insertKey tm pub toxpath d keydb = AnnouncedKeys | 131 | insertKey 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 | |||
134 | areq (OnionAnnounce assym) = Right $ fst $ runIdentity $ assymData assym | 139 | areq (OnionAnnounce assym) = Right $ fst $ runIdentity $ assymData assym |
135 | areq _ = Left "Unexpected non-announce OnionMessage" | 140 | areq _ = Left "Unexpected non-announce OnionMessage" |
136 | 141 | ||
137 | handlers :: Transport err OnionDestination Message | 142 | handlers :: 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) |
143 | handlers net routing toks keydb AnnounceType | 148 | handlers 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) |