diff options
author | joe <joe@jerkface.net> | 2017-08-31 15:42:27 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-08-31 15:42:49 -0400 |
commit | eba3cdcc646211cc152c16d0813cc7e9b1c3111b (patch) | |
tree | e90c45a86d11b16da4eee5f21bb8ee618d7d94d6 /DHTTransport.hs | |
parent | a6b55a29ff656f105ca79c7d4f060920a37c7c70 (diff) |
Separated module OnionTransport from ToxTransport.
Diffstat (limited to 'DHTTransport.hs')
-rw-r--r-- | DHTTransport.hs | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/DHTTransport.hs b/DHTTransport.hs index 6b3af2fc..3de276f1 100644 --- a/DHTTransport.hs +++ b/DHTTransport.hs | |||
@@ -1,8 +1,10 @@ | |||
1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
2 | {-# LANGUAGE KindSignatures #-} | 2 | {-# LANGUAGE KindSignatures #-} |
3 | {-# LANGUAGE LambdaCase #-} | ||
3 | module DHTTransport | 4 | module DHTTransport |
4 | ( parseDHTAddr | 5 | ( parseDHTAddr |
5 | , encodeDHTAddr | 6 | , encodeDHTAddr |
7 | , forwardDHTRequests | ||
6 | , module ToxAddress | 8 | , module ToxAddress |
7 | , DHTMessage(..) | 9 | , DHTMessage(..) |
8 | , Ping | 10 | , Ping |
@@ -16,6 +18,7 @@ module DHTTransport | |||
16 | 18 | ||
17 | import ToxAddress | 19 | import ToxAddress |
18 | import ToxCrypto | 20 | import ToxCrypto |
21 | import Network.QueryResponse | ||
19 | 22 | ||
20 | import Control.Arrow | 23 | import Control.Arrow |
21 | import qualified Data.ByteString as B | 24 | import qualified Data.ByteString as B |
@@ -24,6 +27,8 @@ import Data.Serialize as S (Get, Serialize, get, put, runGet) | |||
24 | import Data.Word | 27 | import Data.Word |
25 | import Network.Socket | 28 | import Network.Socket |
26 | 29 | ||
30 | type DHTTransport = Transport String NodeInfo (DHTMessage Encrypted8) | ||
31 | type HandleHi a = Maybe (Either String (DHTMessage Encrypted8, NodeInfo)) -> IO a | ||
27 | 32 | ||
28 | 33 | ||
29 | data DHTMessage (f :: * -> *) | 34 | data DHTMessage (f :: * -> *) |
@@ -175,3 +180,16 @@ data CookieData = CookieData -- 16 (mac) | |||
175 | 180 | ||
176 | instance Sized CookieRequest where | 181 | instance Sized CookieRequest where |
177 | size = ConstSize 64 -- 32 byte key + 32 byte padding | 182 | size = ConstSize 64 -- 32 byte key + 32 byte padding |
183 | |||
184 | forwardDHTRequests :: TransportCrypto -> (PublicKey -> IO (Maybe NodeInfo)) -> DHTTransport -> DHTTransport | ||
185 | forwardDHTRequests crypto closeLookup dht = dht { awaitMessage = await' } | ||
186 | where | ||
187 | await' :: HandleHi a -> IO a | ||
188 | await' pass = awaitMessage dht $ \case | ||
189 | Just (Right (m@(DHTDHTRequest target payload),src)) | target /= transportPublic crypto | ||
190 | -> do mni <- closeLookup target | ||
191 | -- Forward the message if the target is in our close list. | ||
192 | forM_ mni $ \ni -> sendMessage dht ni m | ||
193 | await' pass | ||
194 | m -> pass m | ||
195 | |||