src/FuncTorrent/FileSystem.hs

   1 module FuncTorrent.FileSystem
   2        (startThread,
   3         MsgChannel,
   4         initFS,
   5         Msg(..),
   6         Piece(..),
   7         pieceMapFromFile
   8        )
   9        where
  10
  11 import           Control.Concurrent (ThreadId, forkIO)
  12 import           Control.Concurrent.Chan (Chan, newChan, readChan)
  13 import           Control.Concurrent.MVar (MVar, putMVar)
  14 import           Control.Monad (forever)
  15 import           Data.Map (traverseWithKey)
  16
  17 import qualified Data.ByteString as BS
  18 import           Data.Map ((!))
  19 import           System.IO (Handle, openFile, IOMode (ReadWriteMode))
  20
  21 import           FuncTorrent.PieceManager (PieceDlState(..), PieceData(..), PieceMap, pieceNumToOffset)
  22 import           FuncTorrent.Utils (readFileAtOffset, writeFileAtOffset, verifyHash)
  23
  24 type PieceNum = Integer
  25 data Piece = Piece PieceNum BS.ByteString
  26
  27 data Msg = ReadPiece PieceNum Integer (MVar Piece)
  28          | WritePiece Piece
  29          | VerifyPiece PieceNum (MVar Bool)
  30
  31 type MsgChannel = Chan Msg
  32
  33 -- init :: FileName -> IO (Handle, MsgChannel)
  34 initFS :: FilePath -> IO (Handle, MsgChannel)
  35 initFS filepath = do
  36   c <- newChan
  37   h <- openFile filepath ReadWriteMode
  38   return (h, c)
  39
  40 startThread :: Handle -> MsgChannel -> PieceMap -> IO ThreadId
  41 startThread handle c pieceMap = do
  42   forkIO $ forever $ recvMsg >>= sendResponse
  43   where
  44     recvMsg = readChan c
  45     sendResponse msg =
  46       case msg of
  47         ReadPiece n len' var -> do
  48           bs <- readPiece n len'
  49           putMVar var (Piece n bs)
  50         WritePiece (Piece n bs) -> do
  51           writePiece n bs
  52         VerifyPiece n var -> do
  53           isHashValid <- verifyPiece n
  54           putMVar var isHashValid
  55     readPiece n len' = do
  56       let offset = pieceNumToOffset pieceMap n
  57       readFileAtOffset handle offset len'
  58     writePiece n piece = do
  59       let offset = pieceNumToOffset pieceMap n
  60       writeFileAtOffset handle offset piece
  61     verifyPiece n = do
  62       let offset = pieceNumToOffset pieceMap n
  63           hash'  = hash (pieceMap ! n)
  64           len'   = len (pieceMap ! n)
  65       bs' <- readFileAtOffset handle offset len'
  66       return $ verifyHash bs' hash'
  67
  68 pieceMapFromFile :: Handle -> PieceMap -> IO PieceMap
  69 pieceMapFromFile handle pieceMap = do
  70   traverseWithKey f pieceMap
  71   where
  72     f k v = do
  73       let offset = pieceNumToOffset pieceMap k
  74       isHashValid <- flip verifyHash (hash v) <$> readFileAtOffset handle offset (len v)
  75       if isHashValid
  76         then return $ v { dlstate = Have }
  77         else return v