src/FuncTorrent/Peer.hs

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