src/FuncTorrent/Filesystem.hs

   1 {-
   2  - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
   3  -
   4  - This file is part of FuncTorrent.
   5  -
   6  - FuncTorrent is free software; you can redistribute it and/or modify
   7  - it under the terms of the GNU General Public License as published by
   8  - the Free Software Foundation; either version 3 of the License, or
   9  - (at your option) any later version.
  10  -
  11  - FuncTorrent is distributed in the hope that it will be useful,
  12  - but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  - GNU General Public License for more details.
  15  -
  16  - You should have received a copy of the GNU General Public License
  17  - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
  18  -}
  19 {-# LANGUAGE OverloadedStrings #-}
  20
  21 module FuncTorrent.Filesystem
  22        (new
  23        , FilesystemState
  24        , getStats
  25        ) where
  26
  27 import Data.ByteString (ByteString)
  28 import qualified Data.ByteString.Char8 as BC (take, drop, null)
  29 import Control.Concurrent.MVar (MVar, newMVar, readMVar)
  30 import System.IO (FilePath)
  31 import System.Environment (getEnv)
  32
  33 import FuncTorrent.Metainfo (Metainfo(..), Info(..), FileInfo(..))
  34
  35 data Filesystem = Filesystem { fs :: [File]
  36                              , stats :: Stats
  37                              }
  38
  39 newtype FilesystemState = FilesystemState (MVar Filesystem)
  40
  41 data File = File { name :: FilePath
  42                  , ps :: [Piece]
  43                  }
  44
  45 data Piece = Piece { hash :: ByteString
  46                    }
  47
  48 data Block = Block { offset :: Integer
  49                    , len :: Integer
  50                    }
  51
  52 data Stats = Stats { read :: Integer
  53                    , written :: Integer
  54                    }
  55
  56 new :: Metainfo -> IO FilesystemState
  57 new m = do
  58   home <- getEnv "HOME"
  59   let baseDir = home ++ "/Downloads/"
  60       files' = files (info m)
  61       pieceLen = pieceLength (info m)
  62       h = infoHash m
  63       numPiecesList = map (\f -> numPieces (lengthInBytes f) pieceLen) files'
  64       hashes    = snd $ foldl (\(bs, b) a -> (BC.drop (fromIntegral a) bs, b ++ [BC.take (fromIntegral a) bs])) (h, [] :: [ByteString]) (map (* 20) numPiecesList)
  65       hss = map (splitN 20) hashes
  66       newFile p hs = File { name = p, ps = map Piece hs }
  67       fs = map (\(f, hs) -> let p = baseDir ++ (path f)
  68                       in newFile p hs) (zip files' hss)
  69   v <- newMVar (Filesystem fs (Stats 0 0))
  70   return (FilesystemState v)
  71
  72 getStats :: FilesystemState -> IO Stats
  73 getStats (FilesystemState fsState) = do
  74   (Filesystem _ stats') <- readMVar fsState
  75   return stats'
  76
  77 numPieces :: Integer -> Integer -> Integer
  78 numPieces fileLen pieceLen | fileLen `mod` pieceLen == 0 = (fileLen `div` pieceLen)
  79                            | otherwise = (fileLen `div` pieceLen) + 1
  80
  81 splitN :: Int -> ByteString -> [ByteString]
  82 splitN n bs | BC.null bs = []
  83             | otherwise = BC.take n bs : splitN n (BC.drop n bs)
  84