src/FuncTorrent/Peer.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module FuncTorrent.Peer
   3     (Peer(..),
   4      PeerResp(..),
   5      mkPeerResp,
   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)
  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, Eq)
  28
  29 data PeerResp = PeerResp { interval :: Maybe Integer
  30                          , peers :: [Peer]
  31                          , complete :: Maybe Integer
  32                          , incomplete :: Maybe Integer
  33                          } deriving (Show, Eq)
  34
  35 toInt :: String -> Integer
  36 toInt = read
  37
  38 mkPeerResp :: BVal -> Either ByteString PeerResp
  39 mkPeerResp resp =
  40     case lookup "failure reason" body of
  41       Just (Bstr err) -> Left err
  42       Just _ -> Left "Unknown failure"
  43       Nothing ->
  44           let (Just (Bint i)) = lookup "interval" body
  45               (Bstr peersBS) = body ! "peers"
  46               pl = map (\peer -> let (ip', port') = splitAt 4 peer
  47                                  in Peer (toIPNum ip') (toPortNum port'))
  48                    (splitN 6 peersBS)
  49           in Right PeerResp {
  50                    interval = Just i
  51                  , peers = pl
  52                  , complete = Nothing
  53                  , incomplete = Nothing
  54                  }
  55     where
  56       (Bdict body) = resp
  57       toPortNum = read . ("0x" ++) . unpack . B16.encode
  58       toIPNum = intercalate "." .
  59                 map (show . toInt . ("0x" ++) . unpack) .
  60                     splitN 2 . B16.encode
  61
  62
  63 handShakeMsg :: InfoDict -> String -> ByteString
  64 handShakeMsg m peer_id = let pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8)
  65                              pstr = pack "BitTorrent protocol"
  66                              reserved = replicate 8 '\0'
  67                              infoH = infoHash m
  68                              peerID = pack peer_id
  69                          in concat [pstrlen, pstr, reserved, infoH, peerID]