src/FuncTorrent/Peer.hs

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