Untested announce-peer command for bittorrent dht.

2 files changed, 16 insertions, 0 deletions

diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs
index 756b5a98..3da59c53 100644
--- a/src/Network/BitTorrent/DHT/Token.hs
+++ b/src/Network/BitTorrent/DHT/Token.hs
@@ -44,6 +44,7 @@ module Network.BitTorrent.DHT.Token
        , Network.BitTorrent.DHT.Token.update
        ) where
 
+import Control.Arrow
 import Control.Monad.State
 #ifdef VERSION_bencoding
 import Data.BEncode (BEncode)
@@ -75,6 +76,9 @@ newtype Token = Token BS.ByteString
 instance Show Token where
     show (Token bs) = B8.unpack $ Base16.encode bs
 
+instance Read Token where
+    readsPrec i s = pure $ (Token *** B8.unpack) $ Base16.decode (B8.pack s)
+
 -- | Meaningless token, for testing purposes only.
 instance Default Token where
   def = makeToken (0::Int) 0
diff --git a/src/Network/BitTorrent/MainlineDHT.hs b/src/Network/BitTorrent/MainlineDHT.hs
index f4ce4019..a7359bda 100644
--- a/src/Network/BitTorrent/MainlineDHT.hs
+++ b/src/Network/BitTorrent/MainlineDHT.hs
@@ -906,6 +906,15 @@ data Announce = Announce
 
   } deriving (Show, Eq, Typeable)
 
+mkAnnounce :: PortNumber -> InfoHash -> Token -> Announce
+mkAnnounce portnum info token = Announce
+    { topic = info
+    , port = portnum
+    , sessionToken = token
+    , announcedName = Nothing
+    , impliedPort = False
+    }
+
 peer_ip_key   = "ip"
 peer_id_key   = "peer id"
 peer_port_key = "port"
@@ -1078,3 +1087,6 @@ resolve want hostAndPort = do
         return $ addrAddress info
 
 
+announce :: MainlineClient -> Announce -> NodeInfo -> IO (Maybe Announced)
+announce client msg addr = do
+    mainlineSend (Method "announce_peer") id (\() -> msg) client () addr