src/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import Prelude hiding (log, length, readFile, writeFile)
   5 import Data.ByteString.Char8 (ByteString, readFile, writeFile, 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)
  12 import FuncTorrent.Logger (initLogger, logMessage, logStop)
  13 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
  14 import FuncTorrent.Peer (handShake, msgLoop)
  15 import FuncTorrent.Tracker (tracker, peers, mkTrackerResponse)
  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 log = logMessage logR
  43     log "Starting up functorrent"
  44     log $ "Parsing input file " ++ concat args
  45     torrentStr <- parse args
  46     case decode torrentStr of
  47       Right d ->
  48           case mkMetaInfo d of
  49             Nothing -> log "Unable to make meta info file"
  50             Just m -> do
  51               log "Input File OK"
  52               log $ "Downloading file : " ++ name (info m)
  53               log "Trying to fetch peers"
  54
  55               log $ "Trackers: " ++ head (announceList m)
  56               response <- tracker m peerId
  57
  58               -- TODO: Write to ~/.functorrent/caches
  59               writeFile (name (info m) ++ ".cache") response
  60
  61               case decode response of
  62                 Right trackerInfo ->
  63                     case mkTrackerResponse trackerInfo of
  64                       Right peerResp -> do
  65                           log $ "Peers List : " ++ (show . peers $ peerResp)
  66                           let p1 = head (peers peerResp)
  67                           h <- handShake p1 (infoHash m) peerId
  68                           log $ "handshake"
  69                           msgLoop h
  70                       Left e -> log $ "Error" ++ unpack e
  71                 Left e -> logError e log
  72
  73       Left e -> logError e log
  74     logStop logR