src/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import Prelude hiding (log, length, readFile)
   5 import Data.ByteString.Char8 (ByteString, readFile, unpack)
   6 import System.Environment (getArgs)
   7 import System.Exit (exitSuccess)
   8 import System.Directory (doesFileExist)
   9
  10 import FuncTorrent.Bencode (decode)
  11 import FuncTorrent.Logger (initLogger, logMessage, logStop)
  12 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
  13 import FuncTorrent.Peer (handShake, msgLoop)
  14 import FuncTorrent.Tracker (peers, getTrackerResponse)
  15
  16 logError :: String -> (String -> IO ()) -> IO ()
  17 logError e logMsg = logMsg $ "parse error: \n" ++ e
  18
  19 peerId :: String
  20 peerId = "-HS0001-*-*-20150215"
  21
  22 exit :: IO ByteString
  23 exit = exitSuccess
  24
  25 usage :: IO ()
  26 usage = putStrLn "usage: functorrent torrent-file"
  27
  28 parse :: [String] -> IO ByteString
  29 parse [] = usage >> exit
  30 parse [a] = do
  31   fileExist <- doesFileExist a
  32   if fileExist
  33     then readFile a
  34     else error "file does not exist"
  35 parse _ = exit
  36
  37 torrentToMetaInfo :: ByteString -> Either String Metainfo
  38 torrentToMetaInfo s =
  39   case (decode s) of
  40    Right d ->
  41      mkMetaInfo d
  42    Left e ->
  43      Left $ show e
  44
  45 main :: IO ()
  46 main = do
  47     args <- getArgs
  48     logR <- initLogger
  49     let log = logMessage logR
  50     log "Starting up functorrent"
  51     log $ "Parsing arguments " ++ concat args
  52     torrentStr <- parse args
  53     case (torrentToMetaInfo torrentStr) of
  54      Right m -> do
  55        log "Input File OK"
  56        log $ "Downloading file : " ++ name (info m)
  57        log "Trying to fetch peers"
  58
  59        log $ "Trackers: " ++ head (announceList m)
  60        trackerResp <- getTrackerResponse m peerId
  61        case  trackerResp of
  62         Right peerList -> do
  63           log $ "Peers List : " ++ (show . peers $ peerList)
  64           let p1 = head (peers peerList)
  65           h <- handShake p1 (infoHash m) peerId
  66           log $ "handshake"
  67           msgLoop h (pieces (info m))
  68         Left e -> log $ "Error" ++ unpack e
  69      Left e -> logError e log
  70     logStop logR