Fleshed out a little more of the Mainline DHT client.

1 files changed, 27 insertions, 0 deletions

diff --git a/Mainline.hs b/Mainline.hs
index 01d683d1..e2ab2d7f 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -16,6 +16,7 @@ import Data.ByteString          as B
 import Data.ByteString.Lazy     (toStrict)
 import Data.Data
 import Data.IP
+import Data.Monoid
 import qualified Data.Serialize as S
 import Data.Typeable
 import Data.Word
@@ -149,3 +150,29 @@ newClient addr = do
     let net = layerTransport parsePacket encodePacket udp
     return net
 
+classify :: Message BValue -> MessageClass String Method TransactionId
+classify (Q { msgID = tid, qryMethod = meth }) = IsQuery meth tid
+classify (R { msgID = tid                   }) = IsResponse tid
+
+encodePayload () tid self dest b = R (nodeId self) tid (Right $ BE.toBEncode b) (Just $ nodeAddr dest)
+
+errorPayload () tid self dest e = R (nodeId self) tid (Left e) (Just $ nodeAddr dest)
+
+decodePayload :: BEncode a => Message BValue -> Either String a
+decodePayload msg = BE.fromBEncode $ qryPayload msg
+
+handler f = Just $ MethodHandler decodePayload encodePayload f
+
+handlers :: Method -> Maybe (MethodHandler String TransactionId NodeInfo (Message BValue) ())
+handlers (Method "ping"     ) = handler pingH
+handlers (Method "find_node") = error "find_node"
+handlers (Method "get_peers") = error "get_peers"
+handlers (Method meth       ) = Just $ MethodHandler decodePayload errorPayload (defaultH meth)
+
+data Ping = Ping
+
+pingH :: NodeInfo -> Ping -> IO Ping
+pingH = error "pingH"
+
+defaultH :: ByteString -> NodeInfo -> BValue -> IO Error
+defaultH meth _ _ = return $ Error MethodUnknown ("Unknown method " <> meth)