handlers functino for DHT transport

1 files changed, 38 insertions, 5 deletions

diff --git a/DHTHandlers.hs b/DHTHandlers.hs
index d98a5e60..41a4bc06 100644
--- a/DHTHandlers.hs
+++ b/DHTHandlers.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE PatternSynonyms            #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TupleSections   #-}
 module DHTHandlers where
 
 import DHTTransport
@@ -26,7 +27,7 @@ data TransactionId = TransactionId
  , cryptoNonce    :: Nonce24 -- ^ Used during the encryption layer.
  }
 
-classify :: DHTMessage ((,) Nonce8) -> MessageClass String PacketKind TransactionId
+classify :: Message -> MessageClass String PacketKind TransactionId
 classify msg = mapMessage (\nonce24 (nonce8,_) -> go msg (TransactionId nonce8 nonce24)) msg
  where
     go (DHTPing          {}) = IsQuery PingType
@@ -47,6 +48,33 @@ data Routing = Routing
     , committee6  :: TriadCommittee NodeId SockAddr
     }
 
+newRouting :: SockAddr -> TransportCrypto
+                       -> (TVar (R.BucketList NodeInfo) -> SockAddr -> STM ()) -- ^ invoked on IPv4 change
+                       -> (TVar (R.BucketList NodeInfo) -> SockAddr -> STM ()) -- ^ invoked on IPv6 change
+                       -> IO Routing
+newRouting addr crypto update4 update6 = do
+    let tentative_ip4 = fromMaybe (IPv4 $ toEnum 0) (IPv4 <$> fromSockAddr addr)
+        tentative_ip6 = fromMaybe (IPv6 $ toEnum 0) (IPv6 <$> fromSockAddr addr)
+        tentative_info = NodeInfo
+                { nodeId   = key2id $ transportPublic crypto
+                , nodeIP   = fromMaybe (toEnum 0) (fromSockAddr addr)
+                , nodePort = fromMaybe 0 $ sockAddrPort addr
+                }
+        tentative_info4 = tentative_info { nodeIP = tentative_ip4 }
+    tentative_info6 <-
+        maybe (tentative_info { nodeIP = tentative_ip6 })
+              (\ip6 -> tentative_info { nodeIP = IPv6 ip6 })
+            <$> global6
+    atomically $ do
+        let nobkts = R.defaultBucketCount :: Int
+        tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts
+        tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info6 nobkts
+        committee4 <- newTriadCommittee (update4 tbl4) -- $ updateIPVote tbl4 addr4
+        committee6 <- newTriadCommittee (update6 tbl6) -- $ updateIPVote tbl6 addr6
+        sched4 <- newTVar Int.empty
+        sched6 <- newTVar Int.empty
+        return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6
+
 
 -- TODO: This should cover more cases
 isLocal (IPv6 ip6) = (ip6 == toEnum 0)
@@ -96,11 +124,11 @@ type Message = DHTMessage ((,) Nonce8)
 type Client = QR.Client String PacketKind TransactionId NodeInfo Message
 
 
-wrapAssym :: TransactionId -> NodeInfo -> NodeInfo -> dta -> Assym (Nonce8,dta)
+wrapAssym :: TransactionId -> NodeInfo -> NodeInfo -> (Nonce8 -> dta) -> Assym dta
 wrapAssym (TransactionId n8 n24) src dst dta = Assym
     { senderKey = let NodeId pubkey = nodeId src in pubkey
     , assymNonce = n24
-    , assymData = (n8, dta)
+    , assymData = dta n8
     }
 
 serializer :: PacketKind
@@ -111,7 +139,7 @@ serializer pktkind mkping mkpong = MethodSerializer
         { methodTimeout  = 5
         , method         = pktkind
         -- wrapQuery :: tid -> addr -> addr -> qry -> x
-        , wrapQuery      = \tid src dst ping -> mkping $ wrapAssym tid src dst ping
+        , wrapQuery      = \tid src dst ping -> mkping $ wrapAssym tid src dst (, ping)
         -- unwrapResponse :: x -> b
         , unwrapResponse = fmap (snd . assymData) . mkpong
         }
@@ -180,3 +208,8 @@ transitionCommittee committee (RoutingTransition ni Stranger) = do
         return ()
 transitionCommittee committee _ = return $ return ()
 
+type Handler = MethodHandler String TransactionId NodeInfo Message
+
+handlers :: Routing -> Tox.PacketKind -> Maybe Handler
+handlers routing PingType     = handler PongType pingH
+handlers routing GetNodesType = handler SendNodesType $ getNodesH routing