Fixed cabal build.

7 files changed, 239 insertions, 574 deletions

diff --git a/Kademlia.hs b/Kademlia.hs
index 531b533b..ef5c6a48 100644
--- a/Kademlia.hs
+++ b/Kademlia.hs
@@ -28,9 +28,8 @@ import Data.Serialize                 (Serialize)
 import Data.Time.Clock.POSIX          (POSIXTime)
 import qualified Data.Wrapper.PSQInt  as Int
          ;import Data.Wrapper.PSQInt  (pattern (:->))
-import Network.Address                (bucketRange)
+import Network.Address                (bucketRange,genBucketSample)
 import Network.BitTorrent.DHT.Search
-import Network.DatagramServer.Types   (genBucketSample)
 import System.Timeout
 import Text.PrettyPrint               as PP hiding (($$), (<>))
 import Text.PrettyPrint.HughesPJClass hiding (($$), (<>))
diff --git a/Mainline.hs b/Mainline.hs
index 5996b214..0f6d7f16 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -55,11 +55,10 @@ import Debug.Trace
 import Kademlia
 import Network.Address                        (Address, fromAddr, fromSockAddr,
                                                setPort, sockAddrPort, testIdBit,
-                                               toSockAddr)
+                                               toSockAddr, genBucketSample')
 import Network.BitTorrent.DHT.ContactInfo     as Peers
 import Network.BitTorrent.DHT.Search          (Search (..))
 import Network.BitTorrent.DHT.Token           as Token
-import Network.DatagramServer.Types           (genBucketSample')
 import qualified Network.DHT.Routing          as R
          ;import Network.DHT.Routing          (Info, Timestamp, getTimestamp)
 import Network.QueryResponse
diff --git a/bittorrent.cabal b/bittorrent.cabal
index fad31c0f..5f5af8c7 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -68,41 +68,71 @@ flag thread-debug
   description: Add instrumentation to threads.
   default: True
 
-flag tox-only
-  description: Enable only the Tox DHT and disable Mainline bencoded messages.
-  default: False
-
 library
   default-language:    Haskell2010
   default-extensions:  PatternGuards
                      , OverloadedStrings
                      , RecordWildCards
-  hs-source-dirs:      src
-  exposed-modules:     Network.DatagramServer
-                       Network.DatagramServer.Mainline
-                       Network.DatagramServer.Tox
-                       Network.DatagramServer.Types
-                       Network.DatagramServer.Error
-                       Network.DHT
-                       Network.DHT.Types
-                       Network.DHT.Mainline
-                       Network.DHT.Tox
-                       Network.KRPC.Method
-                       Data.Torrent
-                       Data.Digest.CRC32C
-                       Network.Address
-                       Network.BitTorrent.DHT
-                       Network.BitTorrent.DHT.ContactInfo
-                       Network.BitTorrent.DHT.Query
-                       Network.DHT.Routing
-                       Network.BitTorrent.DHT.Session
-                       Network.BitTorrent.DHT.Token
-                       Network.StreamServer
-                       Network.SocketLike
-                       Network.BitTorrent.DHT.Search
-                       Data.MinMaxPSQ
-                       Data.Wrapper.PSQ
-                       StaticAssert
+  hs-source-dirs:      src, .
+  exposed-modules:  Network.SocketLike
+                    Data.Digest.CRC32C
+                    Data.Bits.ByteString
+                    Data.Wrapper.PSQ
+                    Data.Wrapper.PSQInt
+                    Data.MinMaxPSQ
+                    Network.Address
+                    Network.DHT.Routing
+                    Data.Torrent
+                    Network.BitTorrent.DHT.ContactInfo
+                    Network.BitTorrent.DHT.Token
+                    Network.BitTorrent.DHT.Search
+                    Network.QueryResponse
+                    Network.StreamServer
+                    Data.BEncode.Pretty
+                    Tasks
+                    Kademlia
+                    Mainline
+
+  build-depends:      base
+                    , containers
+                    , array
+                    , hashable
+                    , network
+                    , network-uri
+                    , iproute
+                    , stm
+                    , base16-bytestring
+                    , base32-bytestring
+                    , base64-bytestring
+                    , psqueues
+                    , reflection
+                    , deepseq
+                    , text
+                    , filepath
+                    , directory
+                    , bencoding
+
+                    , cryptonite
+                    , memory
+                    , time
+                    , random
+                    , entropy
+
+                    , cereal
+                    , http-types
+
+                    , split
+                    , pretty
+                    , convertible
+                    , data-default
+
+                    , async-pool
+                    , lens
+                    , lifted-async
+                    , lifted-base
+                    , monad-control
+                    , transformers-base
+                    , mtl
 
   other-modules:       Paths_bittorrent
                        Crypto.Cipher.Salsa
@@ -155,107 +185,6 @@ library
                        Network.BitTorrent.Internal.Types
                        System.Torrent.FileMap
                        System.Torrent.Tree
-  build-depends:       lifted-base
-                     , convertible  >= 1.0
-                     , pretty       >= 1.1
-
-                       -- Control
-                     , deepseq      >= 1.3
-                     , lens         >= 3.0
-                     , resourcet    >= 0.4
-                     , mtl
-                     , monad-control
-                     , transformers-base
-                     , transformers  >= 0.2
-
-                       -- Concurrency
-                     , SafeSemaphore
-                     , lifted-async
-                     , async-pool
---                     , BoundedChan >= 1.0.1.0
-                     , split-channel >= 0.2
-                     , stm           >= 2.4
-
-                       -- Streaming
-                     , conduit          >= 1.1
-                     , conduit-extra    >= 1.1
-                     , cereal-conduit   >= 0.5
-
-                       -- * Logging
-                     , fast-logger  >= 2.0
-                     , monad-logger >= 0.3.4
-
-                       -- Data & Data structures
-                     , array
-                     , containers   >= 0.5
-                     , data-default >= 0.5.2
-                     , data-default-class
---                     , data-dword
-                     , intset       >= 0.1
--- patched build:    , intset       == 0.1.1.10000
-                     -- , PSQueue      >= 1.1
-                     , psqueues
-                     , split        >= 0.2
-                     , text         >= 0.11.0
-                     , unordered-containers
-                     , vector       >= 0.10
-
-                       -- Hashing
-                     , cryptonite
-                     , memory
-                     , hashable     >= 1.2
-                     , largeword
-
-                       -- Codecs & Serialization
-                     , attoparsec        >= 0.10
-                     , base16-bytestring >= 0.1
-                     , base32-bytestring >= 0.2
-                     , base64-bytestring >= 1.0
-                     , cereal            >= 0.3.5
-
-                       -- Time
-                     , old-locale   >= 1.0
-                     , time         >= 1.0
-
-                       -- Network
-                     , http-types   >= 0.8
-                     , http-client  >= 0.2 && < 0.5
-                      -- ^ We call setUri with Default Request instance,
-                      --   but that instance was removed in an API breaking
-                      --   change of http-client package, version 0.5.0.
-                     , http-conduit >= 2.0
-                      -- ^ may wish  && < 2.3
-                      --   to tie upper bound here to http-client version
-                      --   maintained by same author
-                     , iproute      >= 1.2.11
-
-                       -- RNG/PRNG
-                     , entropy        >= 0.2
-                     , random         >= 1.0.0.2
-                     , random-shuffle >= 0.0.0.4
-
-                       -- System
-                     , directory   >= 1.2
-                     , filepath    >= 1.3
-                     , mmap        >= 0.5
-                     , template-haskell
-                     , cpu
-  if flag(network-uri)
-    Build-depends:     network      >= 2.6
-                     , network-uri  >= 2.6
-  else
-    Build-depends:     network      >= 2.4 && < 2.6
-  if flag(bits-extras)
-    build-depends:     base       == 4.*
-                     , bits-extras  >= 0.1.2
-  else
-    build-depends:     base       >= 4.8
-  if !flag(tox-only)
-    build-depends:     bencoding         >= 0.4.3
-    exposed-modules:   Data.BEncode.Pretty
-  else
-    build-depends:     largeword
-    exposed-modules:   Network.DatagramServer.Tox
   if flag(aeson)
     build-depends: aeson, aeson-pretty, unordered-containers, vector
     cpp-options:   -DBENCODE_AESON
@@ -356,13 +285,12 @@ test-suite spec
                        -- * Bittorrent
                      , bittorrent
                      , temporary
+                     , bencoding         >= 0.4.3
   if flag(network-uri)
     Build-depends:     network      >= 2.6
                      , network-uri  >= 2.6
   else
     Build-depends:     network      >= 2.4 && < 2.6
-  if !flag(tox-only)
-    build-depends:     bencoding         >= 0.4.3
   ghc-options:         -Wall -fno-warn-orphans
 
 
@@ -404,19 +332,16 @@ executable dhtd
   hs-source-dirs:      examples
   main-is:             dhtd.hs
   default-language:    Haskell2010
-  build-depends:       base, network, bytestring
-                     , mtl
-                     , lifted-base
+  build-depends:       base, network, bytestring, hashable, deepseq
+                     , aeson
+                     , async-pool
                      , pretty
-                     , data-default
-                     , monad-logger
                      , bittorrent
                      , unix
                      , containers
                      , stm
                      , cereal
                      , bencoding
-                     , random
   if flag(thread-debug)
     build-depends: time
     cpp-options:   -DTHREAD_DEBUG
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 004369ce..55b34f98 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -196,7 +196,6 @@ import System.Posix.Types
 
 import Network.Address
 import Network.DHT.Routing
-import Network.DatagramServer.Mainline
 
 
 {-----------------------------------------------------------------------
diff --git a/src/Network/Address.hs b/src/Network/Address.hs
index 9ecd89a3..8715a82d 100644
--- a/src/Network/Address.hs
+++ b/src/Network/Address.hs
@@ -59,18 +59,13 @@ module Network.Address
        , peerSocket
 
          -- * Node
+       , NodeAddr (..)
+
          -- ** Id
-       , NodeId
        , testIdBit
-       , genNodeId
        , bucketRange
        , genBucketSample
-
-         -- ** Info
-       , NodeAddr (..)
-       , NodeInfo (..)
-       , mapAddress
-       , traverseAddress
+       , genBucketSample'
 
          -- * Fingerprint
          -- $fingerprint
@@ -126,7 +121,6 @@ import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
 import System.Locale    (defaultTimeLocale)
 #endif
 import System.Entropy
-import Network.DatagramServer.Types as RPC
 
 -- import Paths_bittorrent (version)
 
@@ -147,9 +141,82 @@ sockAddrPort (SockAddrInet6 p _ _ _) = Just p
 sockAddrPort _                       = Nothing
 {-# INLINE sockAddrPort #-}
 
-instance Address a => Address (NodeAddr a) where
-  toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost
-  fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> sockAddrPort sa
+class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
+    => Address a where
+  toSockAddr   :: a        -> SockAddr
+  fromSockAddr :: SockAddr -> Maybe a
+
+fromAddr :: (Address a, Address b) => a -> Maybe b
+fromAddr = fromSockAddr . toSockAddr
+
+-- | Note that port is zeroed.
+instance Address IPv4 where
+  toSockAddr = SockAddrInet 0 . toHostAddress
+  fromSockAddr (SockAddrInet _ h) = Just (fromHostAddress h)
+  fromSockAddr  _                 = Nothing
+
+-- | Note that port is zeroed.
+instance Address IPv6 where
+  toSockAddr h = SockAddrInet6 0 0 (toHostAddress6 h) 0
+  fromSockAddr (SockAddrInet6 _ _ h _) = Just (fromHostAddress6 h)
+  fromSockAddr  _                      = Nothing
+
+-- | Note that port is zeroed.
+instance Address IP where
+  toSockAddr (IPv4 h) = toSockAddr h
+  toSockAddr (IPv6 h) = toSockAddr h
+  fromSockAddr sa =
+        IPv4 <$> fromSockAddr sa
+    <|> IPv6 <$> fromSockAddr sa
+
+data NodeAddr a = NodeAddr
+  { nodeHost ::                !a
+  , nodePort :: {-# UNPACK #-} !PortNumber
+  } deriving (Eq, Ord, Typeable, Functor, Foldable, Traversable)
+
+instance Show a => Show (NodeAddr a) where
+  showsPrec i NodeAddr {..}
+    = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort
+
+instance Read (NodeAddr IPv4) where
+  readsPrec i = RP.readP_to_S $ do
+    ipv4 <- RP.readS_to_P (readsPrec i)
+    _    <- RP.char ':'
+    port <- toEnum <$> RP.readS_to_P (readsPrec i)
+    return $ NodeAddr ipv4 port
+
+-- | @127.0.0.1:6882@
+instance Default (NodeAddr IPv4) where
+  def = "127.0.0.1:6882"
+
+-- | KRPC compatible encoding.
+instance Serialize a => Serialize (NodeAddr a) where
+  get = NodeAddr <$> get <*> get
+  {-# INLINE get #-}
+  put NodeAddr {..} = put nodeHost >> put nodePort
+  {-# INLINE put #-}
+
+-- | Example:
+--
+--   @nodePort \"127.0.0.1:6881\" == 6881@
+--
+instance IsString (NodeAddr IPv4) where
+  fromString str
+    | [hostAddrStr, portStr] <- splitWhen (== ':') str
+    , Just hostAddr <- readMaybe hostAddrStr
+    , Just portNum  <- toEnum <$> readMaybe portStr
+                = NodeAddr hostAddr portNum
+    | otherwise = error $ "fromString: unable to parse (NodeAddr IPv4): " ++ str
+
+
+instance Hashable a => Hashable (NodeAddr a) where
+  hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort)
+  {-# INLINE hashWithSalt #-}
+
+instance Pretty ip => Pretty (NodeAddr ip) where
+  pPrint NodeAddr {..} = pPrint nodeHost <> ":" <> pPrint nodePort
+
+
 
 instance Address PeerAddr where
   toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost
@@ -552,6 +619,37 @@ testIdBit :: FiniteBits bs => bs -> Word -> Bool
 testIdBit bs i = testBit bs (fromIntegral (finiteBitSize bs - 1 - fromIntegral i))
 {-# INLINE testIdBit #-}
 
+-- | Generate a random 'NodeId' within a range suitable for a bucket.  To
+-- obtain a sample for bucket number /index/ where /is_last/ indicates if this
+-- is for the current deepest bucket in our routing table:
+--
+-- > sample <- genBucketSample nid (bucketRange index is_last)
+genBucketSample :: ( FiniteBits nid
+                   , Serialize nid
+                   ) => nid -> (Int,Word8,Word8) -> IO nid
+genBucketSample n qmb = genBucketSample' getEntropy n qmb
+
+-- | Generalizion of 'genBucketSample' that accepts a byte generator
+-- function to use instead of the system entropy.
+genBucketSample' :: forall m dht nid.
+                    ( Applicative m
+                    , FiniteBits nid
+                    , Serialize nid
+                    ) =>
+    (Int -> m ByteString) -> nid -> (Int,Word8,Word8) -> m nid
+genBucketSample' gen self (q,m,b)
+    | q <= 0           =  either error id . S.decode <$> gen nodeIdSize
+    | q >= nodeIdSize  =  pure self
+    | otherwise        =  either error id . S.decode .  build <$> gen (nodeIdSize - q + 1)
+ where
+    nodeIdSize = finiteBitSize (undefined :: nid) `div` 8
+    build tl = BS.init hd <> BS.cons (h .|. t) (BS.tail tl)
+     where
+        hd = BS.take q $ S.encode self
+        h = xor b (complement m .&. BS.last hd)
+        t = m .&. BS.head tl
+
+
 ------------------------------------------------------------------------
 
 -- | Accepts a depth/index of a bucket and whether or not it is the last one,
@@ -583,11 +681,69 @@ instance BEncode a => BEncode (NodeAddr a) where
   {-# INLINE fromBEncode #-}
 #endif
 
-fromPeerAddr :: PeerAddr -> NodeAddr IP
-fromPeerAddr PeerAddr {..} = NodeAddr
-  { nodeHost = peerHost
-  , nodePort = peerPort
-  }
+
+instance Hashable PortNumber where
+  hashWithSalt s = hashWithSalt s . fromEnum
+  {-# INLINE hashWithSalt #-}
+
+instance Pretty PortNumber where
+  pPrint = PP.int . fromEnum
+  {-# INLINE pPrint #-}
+
+instance Serialize PortNumber where
+  get = fromIntegral <$> getWord16be
+  {-# INLINE get #-}
+  put = putWord16be . fromIntegral
+  {-# INLINE put #-}
+
+instance Pretty IPv4 where
+  pPrint = PP.text . show
+  {-# INLINE pPrint #-}
+
+instance Pretty IPv6 where
+  pPrint = PP.text . show
+  {-# INLINE pPrint #-}
+
+instance Pretty IP where
+  pPrint = PP.text . show
+  {-# INLINE pPrint #-}
+
+
+-- | When 'get'ing an IP it must be 'isolate'd to the appropriate
+-- number of bytes since we have no other way of telling which
+-- address type we are trying to parse
+instance Serialize IP where
+    put (IPv4 ip) = put ip
+    put (IPv6 ip) = put ip
+
+    get = do
+      n <- remaining
+      case n of
+        4  -> IPv4 <$> get
+        16 -> IPv6 <$> get
+        _ -> fail (show n ++ " is the wrong number of remaining bytes to parse IP")
+
+instance Serialize IPv4 where
+    put = putWord32host    .  toHostAddress
+    get = fromHostAddress <$> getWord32host
+
+instance Serialize IPv6 where
+    put ip = put $ toHostAddress6 ip
+    get = fromHostAddress6 <$> get
+
+
+instance Hashable IPv4 where
+  hashWithSalt = hashUsing toHostAddress
+  {-# INLINE hashWithSalt #-}
+
+instance Hashable IPv6 where
+  hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
+
+instance Hashable IP where
+  hashWithSalt s (IPv4 h) = hashWithSalt s h
+  hashWithSalt s (IPv6 h) = hashWithSalt s h
+
+
 
 ------------------------------------------------------------------------
 
diff --git a/src/Network/BitTorrent/DHT/Search.hs b/src/Network/BitTorrent/DHT/Search.hs
index 12fc29f6..54547211 100644
--- a/src/Network/BitTorrent/DHT/Search.hs
+++ b/src/Network/BitTorrent/DHT/Search.hs
@@ -26,7 +26,6 @@ import qualified Data.MinMaxPSQ   as MM
 import qualified Data.Wrapper.PSQ as PSQ
          ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ, PSQKey)
 import Network.Address hiding (NodeId)
-import Network.DatagramServer.Types
 import Network.DHT.Routing as R
 #ifdef THREAD_DEBUG
 import Control.Concurrent.Lifted.Instrument
diff --git a/src/Network/DatagramServer/Types.hs b/src/Network/DatagramServer/Types.hs
deleted file mode 100644
index 68aa9212..00000000
--- a/src/Network/DatagramServer/Types.hs
+++ /dev/null
@@ -1,412 +0,0 @@
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE DeriveFoldable             #-}
-{-# LANGUAGE DeriveTraversable          #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE RankNTypes             #-}
-{-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies           #-}
-{-# LANGUAGE StandaloneDeriving     #-}
-module Network.DatagramServer.Types
-        ( module Network.DatagramServer.Types
-        , module Network.DatagramServer.Error
-        ) where
-
-import Control.Applicative
-import qualified Text.ParserCombinators.ReadP as RP
-import Data.Word
-import Data.Monoid
-import Data.Hashable
-import Data.String
-import Data.Bits
-import Data.ByteString (ByteString)
-import Data.Kind       (Constraint)
-import Data.Data
-import Data.Default
-import Data.List.Split
-import Data.Ord
-import Data.IP
-import Network.Socket
-import Text.PrettyPrint as PP hiding ((<>))
-import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
-import Text.Read        (readMaybe, readEither)
-import Data.Serialize                  as S
-import qualified Data.ByteString.Char8 as Char8
-import qualified Data.ByteString as BS
-import Data.ByteString.Base16          as Base16
-import System.Entropy
-import Network.DatagramServer.Error
-import Data.LargeWord
-import Data.Char
-
-
-class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
-    => Address a where
-  toSockAddr   :: a        -> SockAddr
-  fromSockAddr :: SockAddr -> Maybe a
-
-fromAddr :: (Address a, Address b) => a -> Maybe b
-fromAddr = fromSockAddr . toSockAddr
-
--- | Note that port is zeroed.
-instance Address IPv4 where
-  toSockAddr = SockAddrInet 0 . toHostAddress
-  fromSockAddr (SockAddrInet _ h) = Just (fromHostAddress h)
-  fromSockAddr  _                 = Nothing
-
--- | Note that port is zeroed.
-instance Address IPv6 where
-  toSockAddr h = SockAddrInet6 0 0 (toHostAddress6 h) 0
-  fromSockAddr (SockAddrInet6 _ _ h _) = Just (fromHostAddress6 h)
-  fromSockAddr  _                      = Nothing
-
--- | Note that port is zeroed.
-instance Address IP where
-  toSockAddr (IPv4 h) = toSockAddr h
-  toSockAddr (IPv6 h) = toSockAddr h
-  fromSockAddr sa =
-        IPv4 <$> fromSockAddr sa
-    <|> IPv6 <$> fromSockAddr sa
-
-
-
-
-
-newtype ReflectedIP = ReflectedIP SockAddr
-  deriving (Eq, Ord, Show)
-
--- The MessageClass/MessageClassG duality is merely a way to help GHC derive
--- instances without having to cope with the QueryMethod and TransactionID type
--- functions
-type MessageClass msg = MessageClassG (QueryMethod msg) (TransactionID msg)
-data MessageClassG meth tid = Query meth
-                            | Response (Maybe ReflectedIP)
-                            | Error (KError tid)
- deriving (Eq,Ord,Show) --  ,Read, Data: not implemented by SockAddr
-
-
-class Envelope envelope where
-    data TransactionID envelope
-    type QueryMethod envelope
-    data NodeId envelope
-    data QueryExtra envelope
-    data ResponseExtra envelope
-    data PacketDestination envelope
-
-    envelopePayload     :: envelope a -> a
-    envelopeTransaction :: envelope a -> TransactionID envelope
-    envelopeClass       :: envelope a -> MessageClass envelope
-
-    -- | > replyAddress qry addr
-    --
-    --    [ qry ]  received query message
-    --
-    --    [ addr ] SockAddr of query origin
-    --
-    -- Returns: Destination address for reply.
-    makeAddress :: Either (NodeId envelope) (envelope a) -> SockAddr -> PacketDestination envelope
-
-    -- | > buildReply self addr qry response
-    --
-    --    [ self ]     this node's id.
-    --
-    --    [ addr ]     SockAddr of query origin.
-    --
-    --    [ qry ]      received query message.
-    --
-    --    [ response ] response payload.
-    --
-    -- Returns: response message envelope
-    buildReply :: NodeId envelope -> SockAddr -> envelope a -> b -> envelope b
-
-    -- This is a abstract constructor and a design wart.  Since it returns into
-    -- the IO monad, it allows for outside state to be used in creating
-    -- envelopes.
-    buildQuery :: NodeId envelope -> SockAddr -> QueryMethod envelope -> TransactionID envelope -> a -> IO (envelope a)
-
-    uniqueTransactionId :: Int -> IO (TransactionID envelope)
-
-    fromRoutableNode :: QueryExtra envelope -> Bool
-    fromRoutableNode _ = True
-
--- | In Kademlia, the distance metric is XOR and the result is
--- interpreted as an unsigned integer.
-newtype NodeDistance nodeid = NodeDistance nodeid
-  deriving (Eq, Ord)
-
--- | distance(A,B) = |A xor B| Smaller values are closer.
-distance :: Bits nid => nid -> nid -> NodeDistance nid
-distance a b = NodeDistance $ xor a b
-
-instance Serialize nodeid => Show (NodeDistance nodeid) where
-  show (NodeDistance w) = Char8.unpack $ Base16.encode $ S.encode w
-
-instance Serialize nodeid => Pretty (NodeDistance nodeid) where
-  pPrint n = text $ show n
-
-
--- | When 'get'ing an IP it must be 'isolate'd to the appropriate
--- number of bytes since we have no other way of telling which
--- address type we are trying to parse
-instance Serialize IP where
-    put (IPv4 ip) = put ip
-    put (IPv6 ip) = put ip
-
-    get = do
-      n <- remaining
-      case n of
-        4  -> IPv4 <$> get
-        16 -> IPv6 <$> get
-        _ -> fail (show n ++ " is the wrong number of remaining bytes to parse IP")
-
-instance Serialize IPv4 where
-    put = putWord32host    .  toHostAddress
-    get = fromHostAddress <$> getWord32host
-
-instance Serialize IPv6 where
-    put ip = put $ toHostAddress6 ip
-    get = fromHostAddress6 <$> get
-
-instance Pretty IPv4 where
-  pPrint = PP.text . show
-  {-# INLINE pPrint #-}
-
-instance Pretty IPv6 where
-  pPrint = PP.text . show
-  {-# INLINE pPrint #-}
-
-instance Pretty IP where
-  pPrint = PP.text . show
-  {-# INLINE pPrint #-}
-
-instance Hashable IPv4 where
-  hashWithSalt = hashUsing toHostAddress
-  {-# INLINE hashWithSalt #-}
-
-instance Hashable IPv6 where
-  hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
-
-instance Hashable IP where
-  hashWithSalt s (IPv4 h) = hashWithSalt s h
-  hashWithSalt s (IPv6 h) = hashWithSalt s h
-
-
-
-
-
-data NodeAddr a = NodeAddr
-  { nodeHost ::                !a
-  , nodePort :: {-# UNPACK #-} !PortNumber
-  } deriving (Eq, Ord, Typeable, Functor, Foldable, Traversable)
-
-instance Show a => Show (NodeAddr a) where
-  showsPrec i NodeAddr {..}
-    = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort
-
-instance Read (NodeAddr IPv4) where
-  readsPrec i = RP.readP_to_S $ do
-    ipv4 <- RP.readS_to_P (readsPrec i)
-    _    <- RP.char ':'
-    port <- toEnum <$> RP.readS_to_P (readsPrec i)
-    return $ NodeAddr ipv4 port
-
--- | @127.0.0.1:6882@
-instance Default (NodeAddr IPv4) where
-  def = "127.0.0.1:6882"
-
--- | KRPC compatible encoding.
-instance Serialize a => Serialize (NodeAddr a) where
-  get = NodeAddr <$> get <*> get
-  {-# INLINE get #-}
-  put NodeAddr {..} = put nodeHost >> put nodePort
-  {-# INLINE put #-}
-
--- | Example:
---
---   @nodePort \"127.0.0.1:6881\" == 6881@
---
-instance IsString (NodeAddr IPv4) where
-  fromString str
-    | [hostAddrStr, portStr] <- splitWhen (== ':') str
-    , Just hostAddr <- readMaybe hostAddrStr
-    , Just portNum  <- toEnum <$> readMaybe portStr
-                = NodeAddr hostAddr portNum
-    | otherwise = error $ "fromString: unable to parse (NodeAddr IPv4): " ++ str
-
-instance Hashable PortNumber where
-  hashWithSalt s = hashWithSalt s . fromEnum
-  {-# INLINE hashWithSalt #-}
-
-instance Pretty PortNumber where
-  pPrint = PP.int . fromEnum
-  {-# INLINE pPrint #-}
-
-
-instance Hashable a => Hashable (NodeAddr a) where
-  hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort)
-  {-# INLINE hashWithSalt #-}
-
-instance Pretty ip => Pretty (NodeAddr ip) where
-  pPrint NodeAddr {..} = pPrint nodeHost <> ":" <> pPrint nodePort
-
-
-instance Serialize PortNumber where
-  get = fromIntegral <$> getWord16be
-  {-# INLINE get #-}
-  put = putWord16be . fromIntegral
-  {-# INLINE put #-}
-
-
-
-
-data NodeInfo dht addr u = NodeInfo
-  { nodeId   :: !(NodeId dht)
-  , nodeAddr :: !(NodeAddr addr)
-  , nodeAnnotation :: u
-  } deriving (Functor, Foldable, Traversable)
-
-deriving instance ( Show (NodeId dht)
-                  , Show addr
-                  , Show u ) => Show (NodeInfo dht addr u)
-
-hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F')
-
-instance ( FiniteBits (NodeId dht)
-         , Read (NodeId dht)
-         , Read (NodeAddr addr)
-         , Default u
-         ) => Read (NodeInfo dht addr u) where
-  readsPrec i = RP.readP_to_S $ do
-    RP.skipSpaces
-    let n = finiteBitSize (undefined :: NodeId dht) `div` 4
-    hexhash <- sequence $ replicate n (RP.satisfy hexdigit)
-    RP.char '@' RP.+++ RP.satisfy isSpace
-    addrstr <- RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')'))
-                RP.+++ RP.munch (not . isSpace)
-    addr <- either fail return $ readEither addrstr
-    nid <- either fail return $ readEither hexhash
-    return $ NodeInfo nid addr def
-
-
-
-mapAddress :: (addr -> b) -> NodeInfo dht addr u -> NodeInfo dht b u
-mapAddress f ni = ni { nodeAddr = fmap f (nodeAddr ni) }
-
-traverseAddress :: Applicative f => (addr -> f b) -> NodeInfo dht addr u -> f (NodeInfo dht b u)
-traverseAddress f ni = fmap (\addr -> ni { nodeAddr = addr }) $ traverse f (nodeAddr ni)
-
--- Warning: Eq and Ord only look at the nodeId field.
-instance Eq (NodeId dht) => Eq (NodeInfo dht a u) where
-    a == b  = (nodeId a == nodeId b)
-
-instance Ord (NodeId dht) => Ord (NodeInfo dht a u) where
-  compare = comparing nodeId
-
-
--- TODO WARN is the 'system' random suitable for this?
--- | Generate random NodeID used for the entire session.
---   Distribution of ID's should be as uniform as possible.
---
-genNodeId :: forall dht.
-             ( Serialize (NodeId dht)
-             , FiniteBits (NodeId dht)
-             ) => IO (NodeId dht)
-genNodeId = either error id . S.decode <$> getEntropy nodeIdSize
- where
-    nodeIdSize = finiteBitSize (undefined :: NodeId dht) `div` 8
-
--- | Generate a random 'NodeId' within a range suitable for a bucket.  To
--- obtain a sample for bucket number /index/ where /is_last/ indicates if this
--- is for the current deepest bucket in our routing table:
---
--- > sample <- genBucketSample nid (bucketRange index is_last)
-genBucketSample :: ( FiniteBits nid
-                   , Serialize nid
-                   ) => nid -> (Int,Word8,Word8) -> IO nid
-genBucketSample n qmb = genBucketSample' getEntropy n qmb
-
--- | Generalizion of 'genBucketSample' that accepts a byte generator
--- function to use instead of the system entropy.
-genBucketSample' :: forall m dht nid.
-                    ( Applicative m
-                    , FiniteBits nid
-                    , Serialize nid
-                    ) =>
-    (Int -> m ByteString) -> nid -> (Int,Word8,Word8) -> m nid
-genBucketSample' gen self (q,m,b)
-    | q <= 0           =  either error id . S.decode <$> gen nodeIdSize
-    | q >= nodeIdSize  =  pure self
-    | otherwise        =  either error id . S.decode .  build <$> gen (nodeIdSize - q + 1)
- where
-    nodeIdSize = finiteBitSize (undefined :: nid) `div` 8
-    build tl = BS.init hd <> BS.cons (h .|. t) (BS.tail tl)
-     where
-        hd = BS.take q $ S.encode self
-        h = xor b (complement m .&. BS.last hd)
-        t = m .&. BS.head tl
-
-class (Envelope envelope, Address (PacketDestination envelope)) => WireFormat raw envelope where
-    type SerializableTo raw :: * -> Constraint
-    type CipherContext raw envelope
-
-    parsePacket :: Proxy envelope -> ByteString -> Either String raw
-
-    default parsePacket :: raw ~ ByteString => Proxy envelope -> ByteString -> Either String ByteString
-    parsePacket _ = Right
-
-    buildError :: KError (TransactionID envelope) -> Maybe (envelope raw)
-    buildError _ = Nothing
-
-    decodeHeaders :: CipherContext raw envelope -> raw -> Either String (envelope raw)
-    decodePayload :: SerializableTo raw a => envelope raw -> Either String (envelope a)
-
-    encodeHeaders :: CipherContext raw envelope -> envelope raw -> PacketDestination envelope -> ByteString
-    encodePayload :: SerializableTo raw a => envelope a -> envelope raw
-
-    initializeServerState :: Proxy (envelope raw) -> Maybe (NodeId envelope) -> IO (NodeId envelope, CipherContext raw envelope)
-
-
-encodeHexDoc :: Serialize x => x -> Doc
-encodeHexDoc nid = PP.text $ Char8.unpack $ Base16.encode $ S.encode nid
-
-decodeHex :: Serialize x => String -> [(x,String)]
-decodeHex s = either (const []) (pure . (, Char8.unpack ybs)) $ S.decode xbs
-    where
-        (xbs,ybs) = Base16.decode $ Char8.pack s
-
--- FIXME Orphan Serialize intance for large words
-instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where
-   put (LargeKey lo hi) = put hi >> put lo
-   get = flip LargeKey <$> get <*> get
-
-instance (Pretty ip, Pretty (NodeId dht)) => Pretty (NodeInfo dht ip u) where
-  pPrint NodeInfo {..} = pPrint nodeId <> "@(" <> pPrint nodeAddr <> ")"
-
-instance (Pretty ip, Pretty (NodeId dht)) => Pretty [NodeInfo dht ip u] where
-  pPrint = PP.vcat . PP.punctuate "," . map pPrint
-
-
-
-putSockAddr (SockAddrInet port addr)
-    = put (0x34 :: Word8) >> put port >> put addr
-putSockAddr (SockAddrInet6 port flow addr scope)
-    = put (0x36 :: Word8) >> put port >> put addr >> put scope >> put flow
-putSockAddr (SockAddrUnix path)
-    = put (0x75 :: Word8) >> put path
-putSockAddr (SockAddrCan num)
-    = put (0x63 :: Word8) >> put num
-
-getSockAddr = do
-    c <- get
-    case c :: Word8 of
-        0x34 -> SockAddrInet <$> get <*> get
-        0x36 -> (\p a s f -> SockAddrInet6 p f a s) <$> get <*> get <*> get <*> get
-        0x75 -> SockAddrUnix <$> get
-        0x63 -> SockAddrCan <$> get
-        _ -> fail "getSockAddr"