FileSystem: add read/write stats

[functorrent.git] / src / main / Main.hs

diff --git a/src/main/Main.hs b/src/main/Main.hs
index a75f01c122df050615e645c4ba9f0fb4f55563da..c641fa065aa81e084ba5201510a4924050a177ef 100644 (file)
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -3,18 +3,19 @@ module Main where
 
 import           Prelude hiding (log, length, readFile, getContents)
 
-import           Control.Concurrent (forkIO)
+import           Control.Concurrent (forkIO, killThread)
+import           Control.Monad.State (liftIO)
 import           Control.Concurrent.MVar (readMVar)
 import           Data.ByteString.Char8 (ByteString, getContents, readFile)
-import qualified FuncTorrent.FileSystem as FS (initFS, pieceMapFromFile, startThread)
+import qualified FuncTorrent.FileSystem as FS (createMsgChannel, pieceMapFromFile, run)
 import           FuncTorrent.Logger (initLogger, logMessage, logStop)
 import           FuncTorrent.Metainfo (Info(..), Metainfo(..), torrentToMetainfo)
 import           FuncTorrent.Peer (handlePeerMsgs)
 import           FuncTorrent.PieceManager (initPieceMap)
 import qualified FuncTorrent.Server as Server
 import           FuncTorrent.Tracker (connectedPeers, initialTrackerState, trackerLoop, udpTrackerLoop)
-import           FuncTorrent.Utils (createDummyFile)
 import           Network (PortID (PortNumber))
+import           System.IO (withFile, IOMode (ReadWriteMode))
 import           System.Directory (doesFileExist)
 import           System.Environment (getArgs)
 import           System.Exit (exitSuccess)
@@ -71,18 +72,11 @@ main = do
            pLen = pieceLength (info m)
            defaultPieceMap = initPieceMap pieceHash fileLen pLen
        log $ "create FS msg channel"
-       (handle, fsMsgChannel) <- FS.initFS filePath
+       fsMsgChannel <- FS.createMsgChannel
        log $ "Downloading file : " ++ filePath
-       dfe <- doesFileExist filePath
-       pieceMap <- if dfe
-                   then
-                     FS.pieceMapFromFile handle defaultPieceMap
-                   else do
-                     -- create a dummy file
-                     createDummyFile filePath (fromIntegral fileLen) >>
-                       return defaultPieceMap
+       pieceMap <- FS.pieceMapFromFile filePath fileLen defaultPieceMap
        log $ "start filesystem manager thread"
-       FS.startThread handle fsMsgChannel pieceMap
+       fsTid <- forkIO $ withFile filePath ReadWriteMode (FS.run pieceMap fsMsgChannel)
        log $ "starting server"
        (serverSock, (PortNumber portnum)) <- Server.start
        log $ "server started on " ++ show portnum
@@ -97,3 +91,4 @@ main = do
        let p1 = head ps
        handlePeerMsgs p1 peerId m pieceMap True fsMsgChannel
        logStop logR
+       killThread fsTid