From 27fccae52521d6b0d0502708d737c3b6eb908941 Mon Sep 17 00:00:00 2001
From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Thu, 3 Aug 2017 13:29:20 +0530
Subject: [PATCH] Basic infrastructure for Extension messages (BEP 0010)

---
 src/FuncTorrent/PeerMsgs.hs | 18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)

diff --git a/src/FuncTorrent/PeerMsgs.hs b/src/FuncTorrent/PeerMsgs.hs
index f597ed8..d6bbdcf 100644
--- a/src/FuncTorrent/PeerMsgs.hs
+++ b/src/FuncTorrent/PeerMsgs.hs
@@ -35,7 +35,7 @@ import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton)
 import Data.ByteString.Lazy (fromStrict, fromChunks, toStrict)
 import Data.ByteString.Char8 as BC (splitAt)
 import qualified Data.ByteString.Char8 as BC (replicate, pack)
-import Control.Monad (replicateM, liftM)
+import Control.Monad (replicateM)
 import Control.Applicative (liftA3)
 
 import Data.Binary (Binary(..), decode, encode)
@@ -63,6 +63,7 @@ data PeerMsg = KeepAliveMsg
              | PieceMsg Integer Integer ByteString
              | CancelMsg Integer Integer Integer
              | PortMsg Port
+             | ExtendedMsg Integer ByteString
              deriving (Show)
 
 instance Binary PeerMsg where
@@ -100,6 +101,15 @@ instance Binary PeerMsg where
              PortMsg p -> do putWord32be 3
                              putWord8 9
                              putWord16be (fromIntegral p)
+             ExtendedHandshakeMsg t b-> do putWord32be msgLen
+                                           putWord8 20
+                                           putWord8 t -- 0 => handshake msg
+                                           -- actual extension msg follows
+                                           mapM_ putWord8 blockList
+                                             where blockList = unpack b
+                                                   blockLen  = length blockList
+
+
     where putIndexOffsetLength i o l = do
             putWord32be (fromIntegral i)
             putWord32be (fromIntegral o)
@@ -139,10 +149,12 @@ sendMsg h msg = hPut h bsMsg
   where bsMsg = toStrict $ encode msg
 
 genHandshakeMsg :: ByteString -> String -> ByteString
-genHandshakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved, infoHash, peerID]
+genHandshakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved1, reserved2, reserved3, infoHash, peerID]
   where pstrlen = singleton 19
         pstr = BC.pack "BitTorrent protocol"
-        reserved = BC.replicate 8 '\0'
+        reserved1 = BC.replicate 4 '\0'
+        reserved2 = singleton 0x10 -- support extension protocol
+        reserved3 = BC.replicate 3 '\0'
         peerID = BC.pack peer_id
 
 bsToInt :: ByteString -> Int
-- 
2.37.2