summaryrefslogtreecommitdiff
path: root/DHTTransport.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-08-31 15:42:27 -0400
committerjoe <joe@jerkface.net>2017-08-31 15:42:49 -0400
commiteba3cdcc646211cc152c16d0813cc7e9b1c3111b (patch)
treee90c45a86d11b16da4eee5f21bb8ee618d7d94d6 /DHTTransport.hs
parenta6b55a29ff656f105ca79c7d4f060920a37c7c70 (diff)
Separated module OnionTransport from ToxTransport.
Diffstat (limited to 'DHTTransport.hs')
-rw-r--r--DHTTransport.hs18
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 #-}
3module DHTTransport 4module 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
17import ToxAddress 19import ToxAddress
18import ToxCrypto 20import ToxCrypto
21import Network.QueryResponse
19 22
20import Control.Arrow 23import Control.Arrow
21import qualified Data.ByteString as B 24import qualified Data.ByteString as B
@@ -24,6 +27,8 @@ import Data.Serialize as S (Get, Serialize, get, put, runGet)
24import Data.Word 27import Data.Word
25import Network.Socket 28import Network.Socket
26 29
30type DHTTransport = Transport String NodeInfo (DHTMessage Encrypted8)
31type HandleHi a = Maybe (Either String (DHTMessage Encrypted8, NodeInfo)) -> IO a
27 32
28 33
29data DHTMessage (f :: * -> *) 34data DHTMessage (f :: * -> *)
@@ -175,3 +180,16 @@ data CookieData = CookieData -- 16 (mac)
175 180
176instance Sized CookieRequest where 181instance Sized CookieRequest where
177 size = ConstSize 64 -- 32 byte key + 32 byte padding 182 size = ConstSize 64 -- 32 byte key + 32 byte padding
183
184forwardDHTRequests :: TransportCrypto -> (PublicKey -> IO (Maybe NodeInfo)) -> DHTTransport -> DHTTransport
185forwardDHTRequests 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