1 files changed, 6 insertions, 236 deletions

diff --git a/src/Network/BitTorrent/Address.hs b/src/Network/BitTorrent/Address.hs
index 560ac1ef..f364abbe 100644
--- a/src/Network/BitTorrent/Address.hs
+++ b/src/Network/BitTorrent/Address.hs
@@ -13,6 +13,7 @@
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE ViewPatterns               #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -60,13 +61,10 @@ module Network.BitTorrent.Address
          -- * Node
          -- ** Id
        , NodeId
-       , nodeIdSize
        , testIdBit
        , genNodeId
        , bucketRange
        , genBucketSample
-       , bep42
-       , bep42s
 
          -- ** Info
        , NodeAddr (..)
@@ -129,47 +127,15 @@ import System.Locale    (defaultTimeLocale)
 #endif
 import System.Entropy
 import Data.Digest.CRC32C
-import qualified Network.RPC as RPC
+import Network.RPC as RPC
 import Network.KRPC.Message (KMessageOf)
-import Network.DHT.Mainline
+-- import Network.DHT.Mainline
 
 -- import Paths_bittorrent (version)
 
-{-----------------------------------------------------------------------
---  Address
------------------------------------------------------------------------}
-
 instance Pretty UTCTime where
   pPrint = PP.text . show
 
-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
-
 setPort :: PortNumber -> SockAddr -> SockAddr
 setPort port (SockAddrInet  _   h  ) = SockAddrInet  port   h
 setPort port (SockAddrInet6 _ f h s) = SockAddrInet6 port f h s
@@ -388,21 +354,6 @@ instance BEncode PortNumber where
         = pure $ fromIntegral n
         | otherwise = decodingError $ "PortNumber: " ++ show n
 #endif
-
-instance Serialize PortNumber where
-  get = fromIntegral <$> getWord16be
-  {-# INLINE get #-}
-  put = putWord16be . fromIntegral
-  {-# INLINE put #-}
-
-instance Hashable PortNumber where
-  hashWithSalt s = hashWithSalt s . fromEnum
-  {-# INLINE hashWithSalt #-}
-
-instance Pretty PortNumber where
-  pPrint = PP.int . fromEnum
-  {-# INLINE pPrint #-}
-
 {-----------------------------------------------------------------------
 --  IP addr
 -----------------------------------------------------------------------}
@@ -457,51 +408,6 @@ instance BEncode IPv6 where
   {-# INLINE fromBEncode #-}
 #endif
 
--- | 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
-
 {-----------------------------------------------------------------------
 --  Peer addr
 -----------------------------------------------------------------------}
@@ -666,13 +572,6 @@ testIdBit :: FiniteBits bs => bs -> Word -> Bool
 testIdBit bs i = testBit bs (fromIntegral (finiteBitSize bs - fromIntegral i))
 {-# INLINE testIdBit #-}
 
--- 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 :: IO NodeId
-genNodeId = NodeId . either error id . S.decode <$> getEntropy nodeIdSize
-
 ------------------------------------------------------------------------
 
 -- | Accepts a depth/index of a bucket and whether or not it is the last one,
@@ -693,54 +592,8 @@ bucketRange depth is_last = (q,m,b)
      m = 2^(7-r) - 1
      b = if is_last then 0 else 2^(7-r)
 
--- | 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 :: NodeId -> (Int,Word8,Word8) -> IO NodeId
-genBucketSample n qmb = genBucketSample' getEntropy n qmb
-
--- | Generalizion of 'genBucketSample' that accepts a byte generator
--- function to use instead of the system entropy.
-genBucketSample' :: Applicative m =>
-    (Int -> m ByteString) -> NodeId -> (Int,Word8,Word8) -> m NodeId
-genBucketSample' gen (NodeId self) (q,m,b)
-    | q <= 0           =  NodeId . either error id . S.decode <$> gen nodeIdSize
-    | q >= nodeIdSize  =  pure (NodeId self)
-    | otherwise        =  NodeId . either error id . S.decode .  build <$> gen (nodeIdSize - q + 1)
- where
-    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
-
 ------------------------------------------------------------------------
 
-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 x = [ (fromPeerAddr a, s) | (a, s) <- readsPrec i x ]
-
--- | @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 #-}
-
 #ifdef VERSION_bencoding
 -- | Torrent file compatible encoding.
 instance BEncode a => BEncode (NodeAddr a) where
@@ -750,20 +603,6 @@ instance BEncode a => BEncode (NodeAddr a) where
   {-# INLINE fromBEncode #-}
 #endif
 
-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
-
--- | Example:
---
---   @nodePort \"127.0.0.1:6881\" == 6881@
---
-instance IsString (NodeAddr IPv4) where
-  fromString = fromPeerAddr . fromString
-
 fromPeerAddr :: PeerAddr a -> NodeAddr a
 fromPeerAddr PeerAddr {..} = NodeAddr
   { nodeHost = peerHost
@@ -772,45 +611,10 @@ fromPeerAddr PeerAddr {..} = NodeAddr
 
 ------------------------------------------------------------------------
 
-data NodeInfo dht addr u = NodeInfo
-  { nodeId   :: !(RPC.NodeId dht)
-  , nodeAddr :: !(NodeAddr addr)
-  , nodeAnnotation :: u
-  } deriving (Functor, Foldable, Traversable)
-
-deriving instance ( Show (RPC.NodeId dht)
-                  , Show addr
-                  , Show u ) => Show (NodeInfo dht addr u)
-
-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 (RPC.NodeId dht) => Eq (NodeInfo dht a u) where
-    a == b  = (nodeId a == nodeId b)
-
-instance Ord (RPC.NodeId dht) => Ord (NodeInfo dht a u) where
-  compare = comparing nodeId
-
--- | KRPC 'compact list' compatible encoding: contact information for
--- nodes is encoded as a 26-byte string. Also known as "Compact node
--- info" the 20-byte Node ID in network byte order has the compact
--- IP-address/port info concatenated to the end.
-instance Serialize a => Serialize (NodeInfo KMessageOf a ()) where
-  get = (\a b -> NodeInfo a b ()) <$> get <*> get
-  put NodeInfo {..} = put nodeId >> put nodeAddr
-
-instance Pretty ip => Pretty (NodeInfo KMessageOf ip ()) where
-  pPrint NodeInfo {..} = pPrint nodeId <> "@(" <> pPrint nodeAddr <> ")"
-
-instance Pretty ip => Pretty [NodeInfo KMessageOf ip ()] where
-  pPrint = PP.vcat . PP.punctuate "," . L.map pPrint
-
 -- | Order by closeness: nearest nodes first.
-rank :: (x -> NodeId) -> NodeId -> [x] -> [x]
+rank :: ( Ord (NodeId dht)
+        , Bits (NodeId dht)
+        ) => (x -> NodeId dht) -> NodeId dht -> [x] -> [x]
 rank f nid = L.sortBy (comparing (RPC.distance nid . f))
 
 {-----------------------------------------------------------------------
@@ -1219,40 +1023,6 @@ fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
       return $ Version (catMaybes $ L.map decodeShadowVerNr str) []
 
 
--- | Yields all 8 DHT neighborhoods available to you given a particular ip
--- address.
-bep42s :: Address a => a -> NodeId -> [NodeId]
-bep42s addr (NodeId r) = mapMaybe (bep42 addr) rs
- where
-    rs = L.map (NodeId . change3bits r) [0..7]
-
--- change3bits :: ByteString -> Word8 -> ByteString
--- change3bits bs n = BS.snoc (BS.init bs) (BS.last bs .&. 0xF8 .|. n)
-
-change3bits :: (Num b, Bits b) => b -> b -> b
-change3bits bs n = (bs .&. complement 7) .|. n
-
--- | Modifies a purely random 'NodeId' to one that is related to a given
--- routable address in accordance with BEP 42.
-bep42 :: Address a => a -> NodeId -> Maybe NodeId
-bep42 addr (NodeId r)
- | Just ip <- fmap S.encode (fromAddr addr :: Maybe IPv4)
-              <|> fmap S.encode (fromAddr addr :: Maybe IPv6)
-    = genBucketSample' retr (NodeId $ crc $ applyMask ip) (3,0x07,0)
- | otherwise
-    = Nothing
- where
-    ip4mask = "\x03\x0f\x3f\xff" :: ByteString
-    ip6mask = "\x01\x03\x07\x0f\x1f\x3f\x7f\xff" :: ByteString
-    nbhood_select = (fromIntegral r :: Word8) .&. 7
-    retr n = pure $ BS.drop (nodeIdSize - n) $ S.encode r
-    crc = flip shiftL (finiteBitSize (NodeId undefined) - 32) . fromIntegral . crc32c . BS.pack
-    applyMask ip = case BS.zipWith (.&.) msk ip of
-                    (b:bs) -> (b .|. shiftL nbhood_select 5) : bs
-                    bs     -> bs
-        where msk | BS.length ip == 4  =  ip4mask
-                  | otherwise          =  ip6mask
-
 
 -- | Given a string specifying a port (numeric or service name)
 -- and a flag indicating whether you want to support IPv6, this