Fixed Tox decryption.

10 files changed, 336 insertions, 197 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 835125a5..fad31c0f 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -86,6 +86,7 @@ library
                        Network.DHT
                        Network.DHT.Types
                        Network.DHT.Mainline
+                       Network.DHT.Tox
                        Network.KRPC.Method
                        Data.Torrent
                        Data.Digest.CRC32C
@@ -238,6 +239,7 @@ library
                      , filepath    >= 1.3
                      , mmap        >= 0.5
                      , template-haskell
+                     , cpu
   if flag(network-uri)
     Build-depends:     network      >= 2.6
                      , network-uri  >= 2.6
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index d9b02c41..15db79ea 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -61,6 +61,7 @@ import Control.Concurrent.STM
 import System.Environment
 import Data.BEncode (BValue)
 import Network.DHT.Types
+import Network.DHT.Tox
 import Network.DatagramServer.Types
 import Data.Bits
 import Data.Serialize
@@ -227,96 +228,6 @@ nodeAddrType _ = return ()
 ipType :: f dht ip -> DHT raw dht u ip ()
 ipType _ = return ()
 
-instance Kademlia Tox.Message where
-    data DHTData Tox.Message ip = ToxData
-    namePing      _   = Tox.Ping
-    nameFindNodes _   = Tox.GetNodes
-    initializeDHTData = return ToxData
-
-instance Pretty (NodeId Tox.Message) where
-    pPrint (Tox.NodeId nid) = encodeHexDoc nid
-
-getToxPing isPong c n = do
-    q'r <- get :: Get Word8
-    when (bool 0 1 isPong /= q'r) $
-        fail "Tox ping/pong parse fail."
-    n8 <- get :: Get Tox.Nonce8
-    return $ c (n n8) Ping
-
-putToxPing isPong n8 = do
-    put (bool 0 1 isPong :: Word8)
-    put n8
-
-instance Serialize (Query Tox.Message (Ping Tox.Message)) where
-    get = getToxPing False Network.DHT.Types.Query Tox.QueryNonce
-    put (Network.DHT.Types.Query extra Ping) = putToxPing False (Tox.qryNonce extra)
-instance Serialize (Response Tox.Message (Ping Tox.Message)) where
-    get = getToxPing True Network.DHT.Types.Response Tox.ResponseNonce
-    put (Network.DHT.Types.Response extra Ping) = putToxPing True (Tox.rspNonce extra)
-
-nodeFormatToNodeInfo nf = NodeInfo nid addr u
- where
-    u    = Tox.nodeIsTCP nf
-    addr = NodeAddr (Tox.nodeIP nf) (Tox.nodePort nf)
-    nid  = Tox.nodePublicKey nf
-
-instance Serialize (Query Tox.Message (FindNode Tox.Message ip)) where
-    get = do
-        nid <- get
-        n8 <- get
-        return $ Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)
-    put (Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)) = do
-        put nid
-        put n8
-instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where
-    get = do
-        num <- get :: Get Word8
-        when (num > 4) $ fail "Too many nodes in Tox get-nodes reply"
-        ns0 <- sequence $ replicate (fromIntegral num) (nodeFormatToNodeInfo <$> get)
-        -- TODO: Allow tcp and ipv6. For now filtering to udp ip4...
-        let ns = flip mapMaybe ns0 $ \(NodeInfo nid addr u) -> do
-                    guard $ not u
-                    ip4 <- fromAddr addr
-                    return $ NodeInfo nid ip4 ()
-        n8 <- get
-        return $ Network.DHT.Types.Response (Tox.ResponseNonce n8) $ NodeFound ns
-    put (Network.DHT.Types.Response (Tox.ResponseNonce n8) (NodeFound ns)) = do
-        put ( fromIntegral (length ns) :: Word8 )
-        forM_ ns $ \(NodeInfo nid ip4 ()) -> do
-            put Tox.NodeFormat { nodePublicKey = nid
-                               , nodeIsTCP     = False
-                               , nodeIP        = IPv4 (nodeHost ip4)
-                               , nodePort      = nodePort ip4
-                               }
-        put n8
-
-validateToxExchange q r = qnonce == rnonce
-      where
-        qnonce = Tox.qryNonce . queryExtra    . Tox.msgPayload $ q
-        rnonce = Tox.rspNonce . responseExtra . Tox.msgPayload $ r
-
-instance KRPC Tox.Message (Query    Tox.Message (FindNode  Tox.Message IPv4))
-                          (Response Tox.Message (NodeFound Tox.Message IPv4)) where
-    method = Method Tox.GetNodes
-    validateExchange = validateToxExchange
-    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
-    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
-    messageSender q _ = Tox.msgClient q
-    messageResponder _ r = Tox.msgClient r
-
-instance KRPC Tox.Message (Query    Tox.Message (Ping Tox.Message))
-                          (Response Tox.Message (Ping Tox.Message)) where
-    method = Method Tox.Ping
-    validateExchange = validateToxExchange
-    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
-    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
-    messageSender q _ = Tox.msgClient q
-    messageResponder _ r = Tox.msgClient r
-
-instance DataHandlers ByteString Tox.Message
-
-instance Default Bool where def = False
-
 clientSession :: Node BValue KMessageOf () IPv4 -> Node B.ByteString Tox.Message Bool IPv4 -> MVar () -> Bool ->  RestrictedSocket -> Int -> Handle -> IO ()
 clientSession bt tox signalQuit isBt sock n h = do
     line <- map toLower . dropWhile isSpace <$> hGetLine h
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
index 2535c05c..b130e727 100644
--- a/src/Network/BitTorrent/DHT.hs
+++ b/src/Network/BitTorrent/DHT.hs
@@ -82,7 +82,6 @@ import Data.Bits
 import Data.Default
 import Text.PrettyPrint.HughesPJClass hiding (($$), (<>))
 import Network.KRPC.Method
-import Network.BitTorrent.DHT.Query (DataHandlers)
 
 {-----------------------------------------------------------------------
 --  DHT types
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index 60b772b3..003bb5b9 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -27,7 +27,6 @@ module Network.BitTorrent.DHT.Query
        , getPeersH
        , announceH
        , defaultHandlers
-       , DataHandlers
 
          -- * Query
          -- ** Basic
@@ -89,6 +88,8 @@ import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
 import Data.Time
 import Data.Time.Clock.POSIX
 import Data.Hashable (Hashable)
+import Data.Serialize
+import Data.Hashable
 
 import Network.DatagramServer as KRPC hiding (Options, def)
 import Network.KRPC.Method    as KRPC
@@ -143,7 +144,7 @@ nodeHandler :: forall raw dht addr u t q r.
     -> QueryMethod dht
     -> (NodeAddr addr -> q -> IO r)
     -> Handler IO dht raw
-nodeHandler insertNode myNodeIdAccordingTo logm dta method action = handler method $ \ sockAddr msg -> do
+nodeHandler insertNode myNodeIdAccordingTo logm dta method action = handler (\sockaddr -> myNodeIdAccordingTo (error "todo")) method $ \ sockAddr msg -> do
   let remoteId = messageSender (msg :: dht (Query dht q)) resptype
       qextra   = queryExtra qry
       resptype = Proxy :: Proxy (Response dht r)
@@ -229,14 +230,6 @@ kademliaHandlers logger = do
            , handler (nameFindNodes dht) $ findNodeH getclosest
            ]
 
-class DataHandlers raw dht where
-    dataHandlers ::
-        ( Ord ip , Hashable ip, Typeable ip, Serialize ip) =>
-         (NodeId dht  -> IO [NodeInfo dht ip ()])
-        -> DHTData dht ip
-        -> [MethodHandler raw dht ip]
-    dataHandlers _ _ = []
-
 instance DataHandlers BValue KMessageOf where
     dataHandlers = bthandlers
 
@@ -256,11 +249,6 @@ bthandlers getclosest dta =
         then Left <$> getclosest (toNodeId ih)
         else return (Right ps)
 
-data MethodHandler raw dht ip =
-        forall a b. ( SerializableTo raw (Response dht b)
-                    , SerializableTo raw (Query dht a)
-                    , KRPC dht (Query dht a) (Response dht b)
-                    ) => MethodHandler (QueryMethod dht) (NodeAddr ip -> a -> IO b)
 
 -- | Includes all default query handlers.
 defaultHandlers :: forall raw dht u ip.
diff --git a/src/Network/DHT/Mainline.hs b/src/Network/DHT/Mainline.hs
index 9af42a6d..bdf9e8b2 100644
--- a/src/Network/DHT/Mainline.hs
+++ b/src/Network/DHT/Mainline.hs
@@ -56,6 +56,8 @@
 --   <http://pdos.csail.mit.edu/~petar/papers/maymounkov-kademlia-lncs.pdf>
 --
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances  #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -94,6 +96,7 @@ module Network.DHT.Mainline
        , checkToken
        ) where
 
+import Data.String
 import Control.Applicative
 import Data.Bool
 #ifdef VERSION_bencoding
@@ -570,3 +573,7 @@ instance Kademlia KMessageOf where
     initializeDHTData = TorrentData
                 <$> newTVarIO def
                 <*> (newTVarIO =<< nullSessionTokens)
+
+deriving instance IsString (QueryMethod dht) => IsString (Method dht param result)
+deriving instance BEncode (QueryMethod dht) => BEncode (Method dht param result)
+
diff --git a/src/Network/DHT/Tox.hs b/src/Network/DHT/Tox.hs
new file mode 100644
index 00000000..d6fc866f
--- /dev/null
+++ b/src/Network/DHT/Tox.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+module Network.DHT.Tox where
+
+import Data.Serialize
+import Data.Default
+import Text.PrettyPrint.HughesPJClass
+
+import Network.DHT.Types
+import Network.DatagramServer.Types
+import qualified Network.DatagramServer.Tox as Tox
+import Network.KRPC.Method
+import Data.Word
+import Data.ByteString (ByteString)
+import Data.IP
+import Data.Bool
+import Data.Maybe
+import Control.Monad
+import System.Random
+
+instance Kademlia Tox.Message where
+    data DHTData Tox.Message ip = ToxData
+    namePing      _   = Tox.Ping
+    nameFindNodes _   = Tox.GetNodes
+    initializeDHTData = return ToxData
+
+instance Pretty (NodeId Tox.Message) where
+    pPrint (Tox.NodeId nid) = encodeHexDoc nid
+
+instance Serialize (Query Tox.Message (Ping Tox.Message)) where
+    get = getToxPing False Network.DHT.Types.Query Tox.QueryNonce
+    put (Network.DHT.Types.Query extra Ping) = putToxPing False (Tox.qryNonce extra)
+instance Serialize (Response Tox.Message (Ping Tox.Message)) where
+    get = getToxPing True Network.DHT.Types.Response Tox.ResponseNonce
+    put (Network.DHT.Types.Response extra Ping) = putToxPing True (Tox.rspNonce extra)
+
+instance Serialize (Query Tox.Message (FindNode Tox.Message ip)) where
+    get = do
+        nid <- get
+        n8 <- get
+        return $ Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)
+    put (Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)) = do
+        put nid
+        put n8
+instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where
+    get = do
+        num <- get :: Get Word8
+        when (num > 4) $ fail "Too many nodes in Tox get-nodes reply"
+        ns0 <- sequence $ replicate (fromIntegral num) (nodeFormatToNodeInfo <$> get)
+        -- TODO: Allow tcp and ipv6. For now filtering to udp ip4...
+        let ns = flip mapMaybe ns0 $ \(NodeInfo nid addr u) -> do
+                    guard $ not u
+                    ip4 <- fromAddr addr
+                    return $ NodeInfo nid ip4 ()
+        n8 <- get
+        return $ Network.DHT.Types.Response (Tox.ResponseNonce n8) $ NodeFound ns
+    put (Network.DHT.Types.Response (Tox.ResponseNonce n8) (NodeFound ns)) = do
+        put ( fromIntegral (length ns) :: Word8 )
+        forM_ ns $ \(NodeInfo nid ip4 ()) -> do
+            put Tox.NodeFormat { nodePublicKey = nid
+                               , nodeIsTCP     = False
+                               , nodeIP        = IPv4 (nodeHost ip4)
+                               , nodePort      = nodePort ip4
+                               }
+        put n8
+
+instance KRPC Tox.Message (Query    Tox.Message (FindNode  Tox.Message IPv4))
+                          (Response Tox.Message (NodeFound Tox.Message IPv4)) where
+    method = Method Tox.GetNodes
+    validateExchange = validateToxExchange
+    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
+    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
+    messageSender q _ = Tox.msgClient q
+    messageResponder _ r = Tox.msgClient r
+
+instance KRPC Tox.Message (Query    Tox.Message (Ping Tox.Message))
+                          (Response Tox.Message (Ping Tox.Message)) where
+    method = Method Tox.Ping
+    validateExchange = validateToxExchange
+    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
+    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
+    messageSender q _ = Tox.msgClient q
+    messageResponder _ r = Tox.msgClient r
+
+instance DataHandlers ByteString Tox.Message
+
+instance Default Bool where def = False
+
+getToxPing isPong c n = do
+    q'r <- get :: Get Word8
+    when (bool 0 1 isPong /= q'r) $
+        fail "Tox ping/pong parse fail."
+    n8 <- get :: Get Tox.Nonce8
+    return $ c (n n8) Ping
+
+putToxPing isPong n8 = do
+    put (bool 0 1 isPong :: Word8)
+    put n8
+
+validateToxExchange q r = qnonce == rnonce
+      where
+        qnonce = Tox.qryNonce . queryExtra    . Tox.msgPayload $ q
+        rnonce = Tox.rspNonce . responseExtra . Tox.msgPayload $ r
+
+
+nodeFormatToNodeInfo nf = NodeInfo nid addr u
+ where
+    u    = Tox.nodeIsTCP nf
+    addr = NodeAddr (Tox.nodeIP nf) (Tox.nodePort nf)
+    nid  = Tox.nodePublicKey nf
+
+-- instance Default Bool where def = False
diff --git a/src/Network/DHT/Types.hs b/src/Network/DHT/Types.hs
index 47f98ebe..287d5680 100644
--- a/src/Network/DHT/Types.hs
+++ b/src/Network/DHT/Types.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE GADTs, MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -14,6 +17,11 @@ import Network.DatagramServer.Types
 import Network.DHT.Routing
 import Data.Typeable
 import GHC.Generics
+import Data.Serialize
+import Data.Hashable
+import Data.String
+import Data.Monoid
+import Data.Char
 
 data TableParameters msg ip u = TableParameters
     { maxBuckets :: Int
@@ -81,3 +89,88 @@ class Kademlia dht where
     namePing :: Proxy dht -> QueryMethod dht
     nameFindNodes :: Proxy dht -> QueryMethod dht
     initializeDHTData :: IO (DHTData dht ip)
+data MethodHandler raw dht ip =
+        forall a b. ( SerializableTo raw (Response dht b)
+                    , SerializableTo raw (Query dht a)
+                    , KRPC dht (Query dht a) (Response dht b)
+                    ) => MethodHandler (QueryMethod dht) (NodeAddr ip -> a -> IO b)
+
+class DataHandlers raw dht where
+    dataHandlers ::
+        ( Ord ip , Hashable ip, Typeable ip, Serialize ip) =>
+         (NodeId dht  -> IO [NodeInfo dht ip ()])
+        -> DHTData dht ip
+        -> [MethodHandler raw dht ip]
+    dataHandlers _ _ = []
+
+-- | Method datatype used to describe method name, parameters and
+-- return values of procedure. Client use a method to /invoke/, server
+-- /implements/ the method to make the actual work.
+--
+--   We use the following fantom types to ensure type-safiety:
+--
+--     * param: Type of method parameters.
+--
+--     * result: Type of return value of the method.
+--
+newtype Method dht param result = Method { methodName :: QueryMethod dht }
+
+deriving instance Eq (QueryMethod dht) => Eq (Method dht param result)
+deriving instance Ord (QueryMethod dht) => Ord (Method dht param result)
+
+-- | Example:
+--
+--   @show (Method \"concat\" :: [Int] Int) == \"concat :: [Int] -> Int\"@
+--
+instance (Show (QueryMethod dht), Typeable a, Typeable b) => Show (Method dht a b) where
+  showsPrec _ = showsMethod
+
+showsMethod :: forall dht a b. ( Show (QueryMethod dht), Typeable a , Typeable b ) => Method dht a b -> ShowS
+showsMethod (Method name) =
+    -- showString (BC.unpack name) <>
+    shows (show name) <>
+    showString " :: " <>
+    shows paramsTy <>
+    showString " -> " <>
+    shows valuesTy
+  where
+    impossible = error "KRPC.showsMethod: impossible"
+    paramsTy = typeOf (impossible :: a)
+    valuesTy = typeOf (impossible :: b)
+
+-- | In order to perform or handle KRPC query you need to provide
+--   corresponding 'KRPC' class.
+--
+--   Example:
+--
+--   @
+--   data Ping = Ping Text deriving BEncode
+--   data Pong = Pong Text deriving BEncode
+--
+--   instance 'KRPC' Ping Pong where
+--     method = \"ping\"
+--   @
+--
+class ( Typeable req, Typeable resp, Envelope dht)
+    => KRPC dht req resp | req -> resp, resp -> req where
+
+  -- | Method name. Default implementation uses lowercased @req@
+  -- datatype name.
+  --
+  method :: Method dht req resp
+
+  -- TODO add underscores
+  default method :: (IsString (QueryMethod dht), Typeable req) => Method dht req resp
+  method = Method $ fromString $ map toLower $ show $ typeOf hole
+    where
+      hole = error "krpc.method: impossible" :: req
+
+
+  validateExchange :: dht req -> dht resp -> Bool
+  validateExchange _ _ = True
+
+  makeQueryExtra :: DHTData dht ip -> NodeId dht -> Proxy req -> Proxy resp -> IO (QueryExtra dht)
+  makeResponseExtra :: DHTData dht ip -> NodeId dht -> req -> Proxy resp -> IO (ResponseExtra dht)
+
+  messageSender :: dht req -> Proxy resp -> NodeId dht
+  messageResponder :: Proxy req -> dht resp -> NodeId dht
diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs
index bcf8b9af..55a26e58 100644
--- a/src/Network/DatagramServer.hs
+++ b/src/Network/DatagramServer.hs
@@ -451,14 +451,15 @@ prettyQF e = T.encodeUtf8 $ "handler fail while performing query: "
 --   corresponding 'QueryFailure's.
 --
 handler :: forall h a b msg raw. (Applicative h, Functor msg, WireFormat raw msg, SerializableTo raw a, SerializableTo raw b)
-        => QueryMethod msg -> (SockAddr -> msg a -> h b) -> Handler h msg raw
-handler name body = (name, wrapper)
+        => (SockAddr -> h (NodeId msg)) -> QueryMethod msg -> (SockAddr -> msg a -> h b) -> Handler h msg raw
+handler whoami name body = (name, wrapper)
   where
     wrapper :: SockAddr -> msg raw -> h (Either String (msg raw))
     wrapper addr args =
       case decodePayload args of
         Left  e -> pure $ Left e
-        Right a -> Right . encodePayload . buildReply (error "self node-id") addr args <$> body addr a
+        Right a -> do
+            (\me bs -> Right $ encodePayload $ buildReply me addr args bs) <$> whoami addr <*> body addr a
 
 runHandler :: ( Envelope msg
               , Show (QueryMethod msg)
@@ -528,8 +529,8 @@ handleQuery :: ( WireFormat raw msg
 handleQuery mgr@Manager{..} hs meth raw q addr = void $ fork $ do
   myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery"
   res <- dispatchHandler mgr hs meth q addr
+  (me,ctx) <- serverState (error "TODO TOX ToxCipherContext 2 or () for Mainline")
   let  res' = either buildError Just res
-       ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline"
        dest = makeAddress (Right q) addr
        resbs = fmap (\raw -> encodeHeaders ctx raw dest) res' :: Maybe BS.ByteString
   -- TODO: Generalize this debug print.
@@ -565,7 +566,7 @@ listener :: forall raw msg.
             ) => Manager raw msg -> [Handler IO msg raw] -> Protocol raw msg -> IO ()
 listener mgr@Manager{..} hs p = do
   fix $ \again -> do
-    let ctx = error "TODO TOX ToxCipherContext or () for Mainline"
+    (me, ctx) <- serverState (error "TODO TOX ToxCipherContext or () for Mainline")
     (bs, addr) <- liftIO $ do
       handle exceptions $ BS.recvFrom sock (optMaxMsgSize options)
     case parsePacket (msgProxy p) bs >>= \r -> (,) r <$> decodeHeaders ctx r of
diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs
index 5003f3a4..9d60d066 100644
--- a/src/Network/DatagramServer/Tox.hs
+++ b/src/Network/DatagramServer/Tox.hs
@@ -51,6 +51,10 @@ import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
 import qualified Data.ByteArray as BA
 import Data.ByteArray ( Bytes, convert )
 import Data.Monoid
+import System.Endian
+import qualified Data.ByteString.Base16 as Base16
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Char8 as C8
 
 
 type Key32   = Word256 -- 32 byte key
@@ -119,9 +123,14 @@ data Message a = Message
     , msgNonce   :: TransactionID Message
     , msgPayload :: a
     }
- deriving (Show, Generic, Functor, Foldable, Traversable)
+ deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
 
-deriving instance Show (NodeId Message) -- TODO: print as hex
+instance Show (NodeId Message) where
+    showsPrec d pubkey s =
+        "NodeId \"" ++ C8.unpack (Base16.encode $ convert pubkey) ++ '"':s
+
+instance Show (TransactionID Message) where
+    showsPrec d nonce = mappend "TID " . quoted (mappend $ bin2hex nonce)
 
 isQuery :: Message a -> Bool
 isQuery (Message { msgType = SendNodes })                  = False
@@ -231,13 +240,26 @@ data ToxCipherContext = ToxCipherContext
 
 data Ciphered = Ciphered { cipheredMAC :: Poly1305.Auth
                          , cipheredBytes :: ByteString }
+ deriving Eq
+
+quoted shows s = '"':shows ('"':s)
+
+bin2hex :: ByteArrayAccess bs => bs -> String
+bin2hex = C8.unpack . Base16.encode . convert
+
+instance Show Ciphered where
+    showsPrec d (Ciphered (Poly1305.Auth mac) bytes) =
+        mappend  "Ciphered (Auth "
+        . quoted (mappend $ bin2hex mac)
+        . (") " ++)
+        . quoted (mappend $ bin2hex bytes)
 
 getMessage :: Get (Message Ciphered)
 getMessage = do
         typ <- get
         nid <- get
         tid <- get
-        mac <- Poly1305.Auth . convert <$> getBytes 2
+        mac <- Poly1305.Auth . convert <$> getBytes 16
         cnt <- remaining
         bs <- getBytes cnt
         return Message { msgType = typ
@@ -254,11 +276,19 @@ putMessage (Message {..}) = do
         putByteString (convert mac)
         putByteString bs
 
+-- XXX: assumes ByteArray is little-endian
 id2key :: NodeId Message -> PublicKey
 id2key recipient = case publicKey recipient of
     CryptoPassed key -> key
     CryptoFailed e   -> error ("id2key: "++show e)
 
+-- XXX: S.decode is Big-endian
+-- TODO: implement ByteArray instance, avoid S.decode
+key2id :: PublicKey -> NodeId Message
+key2id pk = case S.decode (BA.convert pk) of
+                Left _ -> error "key2id"
+                Right nid -> nid
+
 
 zeros32 :: Bytes
 zeros32 = BA.replicate 32 0
@@ -305,6 +335,11 @@ encipherAndHash hash crypt m = Ciphered a c
 
 decipherAndAuth :: Poly1305.State -> XSalsa.State -> Ciphered -> Either String ByteString
 decipherAndAuth hash crypt (Ciphered mac c)
+    {-
+    | C8.length m /= C8.length c = Left $ "Unequal lengths: "++show (C8.length m, C8.length c)
+    -- | C8.length c /= 40          = Left $ "Unexpected c length: " ++ show (C8.length c, bin2hex c)
+    | otherwise                  = Right m
+    -}
     | (a == mac) = Right m
     | otherwise  = Left "decipherAndAuth: auth fail"
   where
@@ -340,14 +375,16 @@ curve25519 = CurveFP (CurvePrime prime curvecommon)
 
 instance Envelope Message where
     newtype TransactionID Message = TID Nonce24
-        deriving (Eq,Ord,Show,Serialize) -- Read
+        deriving (Eq,Ord) -- Read
 
     newtype NodeId Message = NodeId Word256
-        deriving (Serialize, Eq, Ord, Bits, FiniteBits)
+        deriving (Eq, Ord, Bits, FiniteBits)
 
     type QueryMethod Message = MessageType
 
     newtype QueryExtra Message = QueryNonce { qryNonce :: Nonce8 }
+        deriving (Eq, Ord, Show)
+
     newtype ResponseExtra Message = ResponseNonce { rspNonce :: Nonce8 }
 
     data PacketDestination Message = ToxAddr { toxID :: NodeId Message
@@ -381,23 +418,83 @@ instance Envelope Message where
              $ S.decode $ Char8.pack (take 24 $ show cnt ++ repeat ' ')
 
 
+{-
+instance Serialize (TransactionID Message) where
+    get = do
+        lo <- getWord64le
+        mid <- getWord64le
+        hi <- getWord64le
+        return $ TID (LargeKey lo
+                     (LargeKey mid hi))
+
+    put (TID (LargeKey lo (LargeKey mid hi))) = do
+        putWord64le lo
+        putWord64le mid
+        putWord64le hi
+
+instance Serialize (NodeId Message) where
+    get = do
+        lo <- getWord64le
+        mid <- getWord64le
+        hi <- getWord64le
+        highest <- getWord64le
+        return $ NodeId (LargeKey lo
+                        (LargeKey mid
+                        (LargeKey hi highest)))
+    put (NodeId (LargeKey lo (LargeKey mid (LargeKey hi highest)))) = do
+        putWord64le lo
+        putWord64le mid
+        putWord64le hi
+        putWord64le highest
+
+-}
+
+instance Serialize (TransactionID Message) where
+    get = do
+        hi <- getWord64be
+        mid <- getWord64be
+        lo <- getWord64be
+        return $ TID (LargeKey lo
+                     (LargeKey mid hi))
+
+    put (TID (LargeKey lo (LargeKey mid hi))) = do
+        putWord64be hi
+        putWord64be mid
+        putWord64be lo
+
+instance Serialize (NodeId Message) where
+    get = do
+        highest <- getWord64be
+        hi <- getWord64be
+        mid <- getWord64be
+        lo <- getWord64be
+        return $ NodeId (LargeKey lo
+                        (LargeKey mid
+                        (LargeKey hi highest)))
+    put (NodeId (LargeKey lo (LargeKey mid (LargeKey hi highest)))) = do
+        putWord64be highest
+        putWord64be hi
+        putWord64be mid
+        putWord64be lo
+
+
 staticAssert isLittleEndian -- assumed by 'withWord64Ptr'
 
 with3Word64Ptr :: Nonce24 -> (Ptr Word64 -> IO a) -> IO a
 with3Word64Ptr (LargeKey wlo (LargeKey wmid whi)) kont =
     allocaBytes (sizeOf wlo * 3) $ \p -> do
-        pokeElemOff p 0 wlo
-        pokeElemOff p 1 wmid
-        pokeElemOff p 2 whi
+        pokeElemOff p 2 $ toBE64 wlo
+        pokeElemOff p 1 $ toBE64 wmid
+        pokeElemOff p 0 $ toBE64 whi
         kont p
 
 with4Word64Ptr :: Key32 -> (Ptr Word64 -> IO a) -> IO a
 with4Word64Ptr (LargeKey wlo (LargeKey wmid (LargeKey whi whighest))) kont =
     allocaBytes (sizeOf wlo * 4) $ \p -> do
-        pokeElemOff p 0 wlo
-        pokeElemOff p 1 wmid
-        pokeElemOff p 2 whi
-        pokeElemOff p 3 whighest
+        pokeElemOff p 3 $ toBE64 wlo
+        pokeElemOff p 2 $ toBE64 wmid
+        pokeElemOff p 1 $ toBE64 whi
+        pokeElemOff p 0 $ toBE64 whighest
         kont p
 
 
@@ -440,13 +537,15 @@ instance WireFormat ByteString Message where
 
     initializeServerState _ _ = do
         k <- generateSecretKey
+        {-
         nid <- withByteArray (toPublic k) $ \p -> do
             wlo     <- peekElemOff p 0
             wmid    <- peekElemOff p 1
             whi     <- peekElemOff p 2
             whigest <- peekElemOff p 3
             return $ LargeKey wlo (LargeKey wmid (LargeKey whi whigest))
-        return (NodeId nid, ToxCipherContext k)
+        -}
+        return (key2id $ toPublic k, ToxCipherContext k)
 
 
 instance Read (NodeId Message) where readsPrec d s = map (\(w,xs) -> (NodeId w, xs)) $ decodeHex s
diff --git a/src/Network/KRPC/Method.hs b/src/Network/KRPC/Method.hs
index 4d2be86d..da69d14b 100644
--- a/src/Network/KRPC/Method.hs
+++ b/src/Network/KRPC/Method.hs
@@ -38,76 +38,3 @@ import Network.DatagramServer.Types
 import Network.DHT.Types
 
 
--- | Method datatype used to describe method name, parameters and
--- return values of procedure. Client use a method to /invoke/, server
--- /implements/ the method to make the actual work.
---
---   We use the following fantom types to ensure type-safiety:
---
---     * param: Type of method parameters.
---
---     * result: Type of return value of the method.
---
-newtype Method dht param result = Method { methodName :: QueryMethod dht }
-
-deriving instance Eq (QueryMethod dht) => Eq (Method dht param result)
-deriving instance Ord (QueryMethod dht) => Ord (Method dht param result)
-deriving instance IsString (QueryMethod dht) => IsString (Method dht param result)
-deriving instance BEncode (QueryMethod dht) => BEncode (Method dht param result)
-
--- | Example:
---
---   @show (Method \"concat\" :: [Int] Int) == \"concat :: [Int] -> Int\"@
---
-instance (Show (QueryMethod dht), Typeable a, Typeable b) => Show (Method dht a b) where
-  showsPrec _ = showsMethod
-
-showsMethod :: forall dht a b. ( Show (QueryMethod dht), Typeable a , Typeable b ) => Method dht a b -> ShowS
-showsMethod (Method name) =
-    -- showString (BC.unpack name) <>
-    shows (show name) <>
-    showString " :: " <>
-    shows paramsTy <>
-    showString " -> " <>
-    shows valuesTy
-  where
-    impossible = error "KRPC.showsMethod: impossible"
-    paramsTy = typeOf (impossible :: a)
-    valuesTy = typeOf (impossible :: b)
-
--- | In order to perform or handle KRPC query you need to provide
---   corresponding 'KRPC' class.
---
---   Example:
---
---   @
---   data Ping = Ping Text deriving BEncode
---   data Pong = Pong Text deriving BEncode
---
---   instance 'KRPC' Ping Pong where
---     method = \"ping\"
---   @
---
-class ( Typeable req, Typeable resp, Envelope dht)
-    => KRPC dht req resp | req -> resp, resp -> req where
-
-  -- | Method name. Default implementation uses lowercased @req@
-  -- datatype name.
-  --
-  method :: Method dht req resp
-
-  -- TODO add underscores
-  default method :: (IsString (QueryMethod dht), Typeable req) => Method dht req resp
-  method = Method $ fromString $ L.map toLower $ show $ typeOf hole
-    where
-      hole = error "krpc.method: impossible" :: req
-
-
-  validateExchange :: dht req -> dht resp -> Bool
-  validateExchange _ _ = True
-
-  makeQueryExtra :: DHTData dht ip -> NodeId dht -> Proxy req -> Proxy resp -> IO (QueryExtra dht)
-  makeResponseExtra :: DHTData dht ip -> NodeId dht -> req -> Proxy resp -> IO (ResponseExtra dht)
-
-  messageSender :: dht req -> Proxy resp -> NodeId dht
-  messageResponder :: Proxy req -> dht resp -> NodeId dht