1 files changed, 53 insertions, 4 deletions

diff --git a/DHTHandlers.hs b/DHTHandlers.hs
index 2857abf3..e2b4ec05 100644
--- a/DHTHandlers.hs
+++ b/DHTHandlers.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TupleSections   #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PatternSynonyms            #-}
+{-# LANGUAGE TupleSections              #-}
 module DHTHandlers where
 
 import DHTTransport
 import Network.QueryResponse as QR hiding (Client)
 import qualified Network.QueryResponse as QR (Client)
 import ToxCrypto
-import ToxMessage  as Tox (PacketKind(..), pattern PingType, pattern PongType, pattern GetNodesType, pattern SendNodesType, pattern DHTRequestType)
 import Network.BitTorrent.DHT.Search
 import qualified Data.Wrapper.PSQInt as Int
 import Kademlia
@@ -28,6 +28,8 @@ import Data.IP
 import Data.Ord
 import Data.Maybe
 import Data.Bits
+import Data.Serialize (Serialize)
+import Data.Word
 import System.IO
 
 data TransactionId = TransactionId
@@ -36,6 +38,53 @@ data TransactionId = TransactionId
  }
  deriving (Eq,Ord,Show)
 
+newtype PacketKind = PacketKind Word8
+ deriving (Eq, Ord, Serialize)
+
+pattern OnionRequest0Type = PacketKind 128 -- 0x80     Onion Request 0
+pattern OnionRequest1Type = PacketKind 129 -- 0x81     Onion Request 1
+pattern OnionRequest2Type = PacketKind 130 -- 0x82     Onion Request 2
+pattern AnnounceType  = PacketKind 131 -- 0x83     Announce Request
+pattern AnnounceResponseType = PacketKind 132 -- 0x84     Announce Response
+
+pattern DataRequestType = PacketKind 133 -- 0x85     Onion Data Request (data to route request packet)
+pattern DataResponseType = PacketKind 134 -- 0x86     Onion Data Response (data to route response packet)
+-- 0x8c     Onion Response 3
+-- 0x8d     Onion Response 2
+pattern OnionResponse3Type = PacketKind 140 -- 0x8c     Onion Response 3
+pattern OnionResponse2Type = PacketKind 141 -- 0x8d     Onion Response 2
+pattern OnionResponse1Type = PacketKind 142 -- 0x8e     Onion Response 1
+-- 0xf0     Bootstrap Info
+
+pattern DHTRequestType = PacketKind 32 -- 0x20     DHT Request
+
+pattern CookieRequestType = PacketKind 0x18
+pattern CookieResponseType = PacketKind 0x19
+
+pattern PingType      = PacketKind 0 -- 0x00     Ping Request
+pattern PongType      = PacketKind 1 -- 0x01     Ping Response
+pattern GetNodesType  = PacketKind 2 -- 0x02     Nodes Request
+pattern SendNodesType = PacketKind 4 -- 0x04     Nodes Response
+
+
+instance Show PacketKind where
+    showsPrec d PingType = mappend "PingType"
+    showsPrec d PongType = mappend "PongType"
+    showsPrec d GetNodesType = mappend "GetNodesType"
+    showsPrec d SendNodesType = mappend "SendNodesType"
+    showsPrec d DHTRequestType = mappend "DHTRequestType"
+    showsPrec d OnionRequest0Type = mappend "OnionRequest0Type"
+    showsPrec d OnionResponse1Type = mappend "OnionResponse1Type"
+    showsPrec d OnionResponse3Type = mappend "OnionResponse3Type"
+    showsPrec d AnnounceType = mappend "AnnounceType"
+    showsPrec d AnnounceResponseType = mappend "AnnounceResponseType"
+    showsPrec d DataRequestType = mappend "DataRequestType"
+    showsPrec d DataResponseType = mappend "DataResponseType"
+    showsPrec d CookieRequestType = mappend "CookieRequestType"
+    showsPrec d CookieResponseType = mappend "CookieResponseType"
+    showsPrec d (PacketKind x) = mappend "PacketKind " . showsPrec (d+1) x
+
+
 classify :: Message -> MessageClass String PacketKind TransactionId
 classify msg = mapMessage (\nonce24 (nonce8,_) -> go msg (TransactionId nonce8 nonce24)) msg
  where
@@ -245,7 +294,7 @@ isGetNodes _      _               = Left "Bad GetNodes"
 mkSendNodes :: TransactionId -> NodeInfo -> NodeInfo -> SendNodes -> DHTMessage ((,) Nonce8)
 mkSendNodes tid src dst sendnodes = DHTSendNodes $ wrapAssym tid src dst (, sendnodes)
 
-handlers :: Routing -> Tox.PacketKind -> Maybe Handler
+handlers :: Routing -> PacketKind -> Maybe Handler
 handlers routing PingType     = Just $ MethodHandler (isPing snd) mkPong pingH
 handlers routing GetNodesType = Just $ MethodHandler (isGetNodes snd) mkSendNodes $ getNodesH routing