src/Peer.hs

   1 module Peer where
   2
   3 import qualified Utils as U
   4 import qualified Bencode as Benc
   5 import qualified Tracker as T
   6 import qualified Data.Map as M
   7 import qualified Data.ByteString.Char8 as BC
   8 import qualified Data.ByteString.Base16 as B16
   9 import qualified Data.ByteString.Lazy as BL
  10 import qualified Data.List as L
  11 import qualified Data.Binary as Bin
  12 import qualified Data.Int as DI
  13
  14 data Peer = Peer { ip :: String
  15                  , port :: Integer
  16                  } deriving (Show)
  17
  18 data PeerResp = PeerResponse { interval :: Maybe Integer
  19                              , peers :: [Peer]
  20                              , complete :: Maybe Integer
  21                              , incomplete :: Maybe Integer
  22                              } deriving (Show)
  23
  24 toInt :: String -> Integer
  25 toInt = read
  26
  27 getPeers :: PeerResp -> [Peer]
  28 getPeers = peers
  29
  30 getPeerResponse :: BC.ByteString -> PeerResp
  31 getPeerResponse body = case Benc.decode body of
  32                         Right (Benc.Bdict peerM) ->
  33                           let (Just (Benc.Bint i)) = M.lookup (Benc.Bstr (BC.pack "lookup")) peerM
  34                               (Benc.Bstr peersBS) = peerM M.! Benc.Bstr (BC.pack "peers")
  35                               pl = map (\peer -> let (ip', port') = BC.splitAt 4 peer
  36                                                  in Peer { ip = toIPNum ip'
  37                                                          , port =  toPortNum port'
  38                                                          })
  39                                    (U.splitN 6 peersBS)
  40                           in PeerResponse { interval = Just i
  41                                           , peers = pl
  42                                           , complete = Nothing
  43                                           , incomplete = Nothing
  44                                           }
  45                           where toPortNum = read . ("0x" ++) . BC.unpack . B16.encode
  46                                 toIPNum = L.intercalate "." .
  47                                           map (show . toInt . ("0x" ++) . BC.unpack) .
  48                                           U.splitN 2 . B16.encode
  49                         _ -> PeerResponse { interval = Nothing
  50                                           , peers = []
  51                                           , complete = Nothing
  52                                           , incomplete = Nothing
  53                                           }
  54
  55
  56 handShakeMsg :: M.Map Benc.BVal Benc.BVal -> String -> BC.ByteString
  57 handShakeMsg m peer_id = let pstrlen = BC.concat $ BL.toChunks $ Bin.encode (19 :: DI.Int8)
  58                              pstr = BC.pack "BitTorrent protocol"
  59                              reserved = BC.replicate 8 '\0'
  60                              infoH = T.infoHash m
  61                              peerID = BC.pack peer_id
  62                          in
  63                           BC.concat [pstrlen, pstr, reserved, infoH, peerID]