src/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import Prelude hiding (length, readFile, writeFile)
   5 import Data.ByteString.Char8 (ByteString, readFile, writeFile, length, unpack)
   6 import System.Environment (getArgs)
   7 import System.Exit (exitSuccess)
   8 import System.Directory (doesFileExist)
   9 import Text.ParserCombinators.Parsec (ParseError)
  10
  11 import FuncTorrent.Bencode (decode, BVal(..))
  12 import FuncTorrent.Logger (initLogger, logMessage, logStop)
  13 import FuncTorrent.Metainfo (lengthInBytes, mkMetaInfo, info, name, announceList)
  14 import FuncTorrent.Peer (peers, mkPeerResp, handShakeMsg)
  15 import FuncTorrent.Tracker (connect, prepareRequest)
  16
  17 logError :: ParseError -> (String -> IO ()) -> IO ()
  18 logError e logMsg = logMsg $ "parse error: \n" ++ show e
  19
  20 peerId :: String
  21 peerId = "-HS0001-*-*-20150215"
  22
  23 exit :: IO ByteString
  24 exit = exitSuccess
  25
  26 usage :: IO ()
  27 usage = putStrLn "usage: functorrent torrent-file"
  28
  29 parse :: [String] -> IO ByteString
  30 parse [] = usage >> exit
  31 parse [a] = do
  32   fileExist <- doesFileExist a
  33   if fileExist
  34     then readFile a
  35     else error "file does not exist"
  36 parse _ = exit
  37
  38 main :: IO ()
  39 main = do
  40     args <- getArgs
  41     logR <- initLogger
  42     let logMsg = logMessage logR
  43     logMsg $ "Parsing input file: " ++ concat args
  44     torrentStr <- parse args
  45     case decode torrentStr of
  46       Right d ->
  47           case mkMetaInfo d of
  48             Nothing -> logMsg "parse error"
  49             Just m -> do
  50               logMsg "Input File OK"
  51
  52               let len = lengthInBytes $ info m
  53                   (Bdict d') = d
  54                   trackers = announceList m
  55
  56               logMsg "Trying to fetch peers: "
  57               response <- connect (head trackers) (prepareRequest d' peerId len)
  58
  59               let hsMsgLen = show $ length $ handShakeMsg d' peerId
  60               logMsg $ "Hand-shake message length : " ++ hsMsgLen
  61
  62               -- TODO: Write to ~/.functorrent/caches
  63               writeFile (name (info m) ++ ".cache") response
  64
  65               case decode response of
  66                 Right trackerInfo ->
  67                     case mkPeerResp trackerInfo of
  68                       Right peerResp ->
  69                           logMsg $ "Peers List : " ++ (show . peers $ peerResp)
  70                       Left e -> logMsg $ "Error" ++ unpack e
  71                 Left e -> logError e logMsg
  72
  73       Left e -> logError e logMsg
  74     logStop logR