1 files changed, 0 insertions, 362 deletions

diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
deleted file mode 100644
index 1a67c7c4..00000000
--- a/src/Network/BitTorrent/DHT.hs
+++ /dev/null
@@ -1,362 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   BitTorrent uses a \"distributed sloppy hash table\" (DHT) for
---   storing peer contact information for \"trackerless\" torrents. In
---   effect, each peer becomes a tracker.
---
---   Normally you don't need to import other DHT modules.
---
---   For more info see:
---   <http://www.bittorrent.org/beps/bep_0005.html>
---
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeOperators     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE CPP #-}
-module Network.BitTorrent.DHT
-       ( -- * Distributed Hash Table
-         DHT
-       , Options (..)
-       , fullLogging
-       , dht
-
-         -- * Bootstrapping
-         -- $bootstrapping-terms
-       , tNodes
-       , defaultBootstrapNodes
-       , resolveHostName
-       , bootstrap
-       , isBootstrapped
-
-         -- * Initialization
-       , snapshot
-
-         -- * Operations
-       -- , Network.BitTorrent.DHT.lookup
-       , Network.BitTorrent.DHT.insert
-       , Network.BitTorrent.DHT.delete
-
-         -- * Embedding
-         -- ** Session
-       , LogFun
-       , Node
-       , defaultHandlers
-       , newNode
-       , closeNode
-
-         -- ** Monad
-       -- , MonadDHT (..)
-       , runDHT
-       ) where
-
-import Control.Monad.Logger
-import Control.Monad.Reader
-import Control.Exception
-import qualified Data.ByteString as BS
-import Data.Conduit as C
-import qualified Data.Conduit.List as C
-import Data.Serialize
-import Network.Socket
-import Text.PrettyPrint.HughesPJClass as PP (pPrint,render)
-
-import Data.Torrent
-import Network.Address
-import Network.BitTorrent.DHT.Query
-import Network.BitTorrent.DHT.Session
-import Network.DHT.Routing as T hiding (null)
-import qualified Data.Text as Text
-import Data.Typeable
-import Data.Monoid
-import Network.DatagramServer.Mainline (KMessageOf)
-import qualified Network.DatagramServer as KRPC (listen, Protocol(..))
-import Network.DatagramServer.Types
-import Network.DHT.Types
-import Data.Bits
-import Data.Default
-import Text.PrettyPrint.HughesPJClass hiding (($$), (<>))
-import Network.KRPC.Method
-
-{-----------------------------------------------------------------------
---  DHT types
------------------------------------------------------------------------}
-
-#if 0
-class MonadDHT m where
-  liftDHT :: DHT raw dht u IPv4 a -> m a
-
-instance MonadDHT (DHT raw dht u IPv4) where
-  liftDHT = id
-#endif
-
--- | Convenience method.  Pass this to 'dht' to enable full logging.
-fullLogging :: LogSource -> LogLevel -> Bool
-fullLogging _ _ = True
-
--- | Run DHT on specified port. <add note about resources>
-dht ::
-    ( Ord ip
-    , Address ip
-    , Functor dht
-    , Ord (NodeId dht)
-    , FiniteBits (NodeId dht)
-    , Serialize (NodeId dht)
-    , Show (NodeId dht)
-    , SerializableTo raw (Response dht (Ping dht))
-    , SerializableTo raw (Query dht (Ping dht))
-    , SerializableTo raw (Response dht (NodeFound dht ip))
-    , SerializableTo raw (Query dht (FindNode dht ip))
-    , Ord (TransactionID dht)
-    , Serialize (TransactionID dht)
-    , Eq (QueryMethod dht)
-    , Show (QueryMethod dht)
-    , Pretty (NodeInfo dht ip u)
-    , Kademlia dht
-    , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
-    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
-    , DataHandlers raw dht
-    , WireFormat raw dht
-    , Show u
-    , Default u
-    , Typeable dht
-    )
-    => Options     -- ^ normally you need to use 'Data.Default.def';
-    -> NodeAddr ip -- ^ address to bind this node;
-    -> (LogSource -> LogLevel -> Bool) -- ^ use 'fullLogging' as a noisy default
-    -> DHT raw dht u ip a    -- ^ actions to run: 'bootstrap', 'lookup', etc;
-    -> IO a        -- ^ result.
-dht opts addr logfilter action = do
-  runStderrLoggingT $ filterLogger logfilter $ LoggingT $ \ logger -> do
-    bracket (newNode opts addr logger Nothing) closeNode $
-      \ node -> runDHT node $ do
-            hs <- defaultHandlers logger
-            m <- asks manager
-            liftIO $ KRPC.listen m hs (KRPC.Protocol Proxy Proxy)
-            action
-{-# INLINE dht #-}
-
-{-----------------------------------------------------------------------
---  Bootstrapping
------------------------------------------------------------------------}
--- $bootstrapping-terms
---
---  [@Bootstrapping@] DHT @bootstrapping@ is the process of filling
---  routing 'Table' by /good/ nodes.
---
---  [@Bootstrapping time@] Bootstrapping process can take up to 5
---  minutes. Bootstrapping should only happen at first application
---  startup, if possible you should use 'snapshot' & 'restore'
---  mechanism which must work faster.
---
---  [@Bootstrap nodes@] DHT @bootstrap node@ is either:
---
---    * a specialized high performance node maintained by bittorrent
---    software authors\/maintainers, like those listed in
---    'defaultBootstrapNodes'. /Specialized/ means that those nodes
---    may not support 'insert' queries and is running for the sake of
---    bootstrapping only.
---
---    * an ordinary bittorrent client running DHT node. The list of
---    such bootstrapping nodes usually obtained from
---    'Data.Torrent.tNodes' field or
---    'Network.BitTorrent.Exchange.Message.Port' messages.
-
--- Do not include the following hosts in the default bootstrap nodes list:
---
---   * "dht.aelitis.com" and "dht6.azureusplatform.com" - since
---   Azureus client have a different (and probably incompatible) DHT
---   protocol implementation.
---
---   * "router.utorrent.com" since it is just an alias to
---   "router.bittorrent.com".
---      XXX: ignoring this advise as it resolves to a different
---      ip address for me.
-
--- | List of bootstrap nodes maintained by different bittorrent
--- software authors.
-defaultBootstrapNodes :: [NodeAddr HostName]
-defaultBootstrapNodes =
-  [ NodeAddr "router.bittorrent.com"  6881 -- by BitTorrent Inc.
-
-    -- doesn't work at the moment (use git blame)  of commit
-  , NodeAddr "dht.transmissionbt.com" 6881 -- by Transmission project
-
-  , NodeAddr "router.utorrent.com"  6881
-  ]
-
--- TODO Multihomed hosts
-
--- | Resolve either a numeric network address or a hostname to a
--- numeric IP address of the node.  Usually used to resolve
--- 'defaultBootstrapNodes' or 'Data.Torrent.tNodes' lists.
-resolveHostName :: NodeAddr HostName -> IO (NodeAddr IPv4)
-resolveHostName NodeAddr {..} = do
-  let hints = defaultHints { addrFamily = AF_INET, addrSocketType = Datagram }
-  -- getAddrInfo throws exception on empty list, so the pattern matching never fail
-  info : _ <- getAddrInfo (Just hints) (Just nodeHost) (Just (show nodePort))
-  case fromSockAddr (addrAddress info) of
-    Nothing   -> error "resolveNodeAddr: impossible"
-    Just addr -> return addr
-
--- | One good node may be sufficient.
---
---   This operation do block, use
---   'Control.Concurrent.Async.Lifted.async' if needed.
-bootstrap :: forall raw dht u ip.
-    ( Ord ip
-    , Address ip
-    , Functor dht
-    , Ord (NodeId dht)
-    , FiniteBits (NodeId dht)
-    , Serialize (NodeId dht)
-    , Show (NodeId dht)
-    , Pretty (NodeId dht)
-    , SerializableTo raw (Response dht (Ping dht))
-    , SerializableTo raw (Query dht (Ping dht))
-    , SerializableTo raw (Response dht (NodeFound dht ip))
-    , SerializableTo raw (Query dht (FindNode dht ip))
-    , Ord (TransactionID dht)
-    , Serialize (TransactionID dht)
-    , Eq (QueryMethod dht)
-    , Show (QueryMethod dht)
-    , Pretty (NodeInfo dht ip u)
-    , Kademlia dht
-    , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
-    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
-    , DataHandlers raw dht
-    , WireFormat raw dht
-    , Show u
-    , Default u
-    , Serialize u
-    ) => Maybe BS.ByteString -> [PacketDestination dht] -> DHT raw dht u ip ()
-bootstrap mbs startNodes = do
-  restored <-
-    case decode <$> mbs of
-        Just (Right tbl) -> return (T.toList tbl)
-        Just (Left e)    -> do $(logWarnS) "restore" (Text.pack e)
-                               return []
-        Nothing          -> return []
-
-  $(logInfoS) "bootstrap" "Start node bootstrapping"
-  let searchAll aliveNodes = do
-        nid <- myNodeIdAccordingTo (error "FIXME")
-        ns <- bgsearch ioFindNodes nid
-        return ( ns :: [NodeInfo dht ip u] )
-  input_nodes <- (restored ++) . T.toList <$> getTable
-  -- Step 1: Use iterative searches to flesh out the table..
-  do let knowns = map (map $ fst) input_nodes
-     -- Below, we reverse the nodes since the table serialization puts the
-     -- nearest nodes last and we want to choose a similar node id to bootstrap
-     -- faster.
-     (alive_knowns,_) <- unzip <$> queryParallel (pingQ <$> reverse (concat knowns))
-     b <- isBootstrapped
-     -- If our cached nodes are alive and our IP address did not change, it's possible
-     -- we are already bootsrapped, so no need to do any searches.
-     when (not b) $ do
-         ns <- searchAll $ take 2 alive_knowns
-         -- We only use the supplied bootstrap nodes when we don't know of any
-         -- others to try.
-         when (null ns) $ do
-            -- TODO filter duplicated in startNodes list
-            -- TODO retransmissions for startNodes
-            (aliveNodes,_) <- unzip <$> queryParallel (coldPingQ <$> startNodes)
-            _ <- searchAll $ take 2 aliveNodes
-            return ()
-  -- Step 2: Repeatedly refresh incomplete buckets until the table is full.
-  maxbuckets <- asks $ optBucketCount . options
-  flip fix 0 $ \loop icnt -> do
-      tbl <- getTable
-      let unfull = filter ((/=defaultBucketSize) . snd)
-          us = zip
-                -- is_last = True for the last bucket
-                (True:repeat False)
-                -- Only non-full buckets unless it is the last one and the
-                -- maximum number of buckets has not been reached.
-                $ case reverse $ zip [0..] $ T.shape tbl of
-                    p@(n,_):ps | n+1==maxbuckets -> unfull (p:ps)
-                    p:ps                         -> p:unfull ps
-                    []                           -> []
-      forM_ us $ \(is_last,(index,_)) -> do
-        nid <- myNodeIdAccordingTo (error "FIXME")
-        sample <- liftIO $ genBucketSample nid (bucketRange index is_last)
-        $(logDebugS) "bootstrapping"
-            $ "BOOTSTRAP sample"
-              <> Text.pack (show (is_last,index,T.shape tbl))
-              <> " " <> Text.pack (render $ pPrint sample)
-        refreshNodes sample
-      $(logDebugS) "bootstrapping"
-        $ "BOOTSTRAP finished iteration "
-          <> Text.pack (show (icnt,T.shape tbl,us,defaultBucketSize))
-      when (not (null us) && icnt < div (3*maxbuckets) 2)
-        $ loop (succ icnt)
-  $(logInfoS) "bootstrap" "Node bootstrapping finished"
-
--- | Check if this node is already bootstrapped.
---   @bootstrap [good_node] >> isBootstrapped@@ should always return 'True'.
---
---   This operation do not block.
---
-isBootstrapped :: Eq ip => DHT raw dht u ip Bool
-isBootstrapped = T.full <$> getTable
-
-{-----------------------------------------------------------------------
--- Initialization
------------------------------------------------------------------------}
-
--- | Serialize current DHT session to byte string.
---
---   This is blocking operation, use
--- 'Control.Concurrent.Async.Lifted.async' if needed.
-snapshot :: ( Address ip
-            , Ord (NodeId dht)
-            , Serialize u
-            , Serialize (NodeId dht)
-            ) => DHT raw dht u ip BS.ByteString
-snapshot = do
-    tbl <- getTable
-    return $ encode tbl
-
-{-----------------------------------------------------------------------
---  Operations
------------------------------------------------------------------------}
-
-#if 0
-
--- | Get list of peers which downloading this torrent.
---
---   This operation is incremental and do block.
---
-lookup :: Address ip => InfoHash -> DHT raw dht u ip `C.Source` [PeerAddr ip]
-lookup topic = do      -- TODO retry getClosest if bucket is empty
-  closest <- lift $ getClosest topic
-  C.sourceList [closest] $= search topic (getPeersQ topic)
-
-#endif
-
--- TODO do not republish if the topic is already in announceSet
-
--- | Announce that /this/ peer may have some pieces of the specified
--- torrent. DHT will reannounce this data periodically using
--- 'optReannounce' interval.
---
---   This operation is synchronous and do block, use
---   'Control.Concurrent.Async.Lifted.async' if needed.
---
-insert :: Address ip => InfoHash -> PortNumber -> DHT raw dht u ip ()
-insert ih p = do
-  publish ih p
-  insertTopic ih p
-
--- | Stop announcing /this/ peer for the specified torrent.
---
---   This operation is atomic and may block for a while.
---
-delete :: InfoHash -> PortNumber -> DHT raw dht u ip ()
-delete = deleteTopic
-{-# INLINE delete #-}