content: {-
      Copyright 2015,2017 Markus Ongyerth, Stephan Guenther
  
      This file is part of Monky.
  
      Monky is free software: you can redistribute it and/or modify
      it under the terms of the GNU Lesser General Public License as published by
      the Free Software Foundation, either version 3 of the License, or
      (at your option) any later version.
  
      Monky is distributed in the hope that it will be useful,
      but WITHOUT ANY WARRANTY; without even the implied warranty of
      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      GNU Lesser General Public License for more details.
  
      You should have received a copy of the GNU Lesser General Public License
      along with Monky.  If not, see <http://www.gnu.org/licenses/>.
  -}
  {-# LANGUAGE CPP #-}
  {-|
  Module      : Monky.Disk.Btrfs
  Description : Allows access to information about a btrfs pool
  Maintainer  : ongy
  Stability   : experimental
  Portability : Linux
  
  This module allows for some support for btrfs devices.
  This may be renamed in the future when a general block-device module appears.
  -}
  module Monky.Disk.Btrfs
    ( BtrfsHandle
    , getBtrfsHandle
    , getFSDevices
    )
  where
  
  import Monky.Utility
  import System.Directory (doesDirectoryExist)
  
  import Monky.Disk.Common
  
  #if MIN_VERSION_base(4,8,0)
  #else
  import Control.Applicative ((<$>))
  #endif
  
  
  -- Size data metadata system
  -- |The FsInfo exported by this module
  data BtrfsHandle = BtrfsH Integer File File File
  
  instance FsInfo BtrfsHandle where
    getFsSize = return . getSize
    getFsUsed = getUsed
  
  
  fsBasePath :: String
  fsBasePath = "/sys/fs/btrfs/"
  
  
  sectorSize :: Num a => a
  sectorSize = 512
  
  
  getSize :: BtrfsHandle -> Integer
  getSize (BtrfsH s _ _ _) = s
  
  
  getUsed :: BtrfsHandle -> IO Integer
  getUsed (BtrfsH _ d m s) = do
    dv <- readValueI d
    mv <- readValueI m
    sm <- readValueI s
    return $ dv + mv + sm
  
  -- | Get the block devices used by a btrfs FileSystem. This resolves mappers as far as possible
  getFSDevices :: String -> IO [Dev]
  getFSDevices fs = do
      let devP = fsBasePath ++ fs ++ "/devices/"
      devices <- map Label <$> listDirectory devP
      concat <$> mapM mapperToDev devices
  
  
  getBtrfsHandle' :: String -> IO BtrfsHandle
  getBtrfsHandle' fs = do
    devices <- getFSDevices fs
    sizes <- mapM (\(Dev dev) -> fmap read $ readFile (blBasePath ++ dev ++ "/size")) devices
    let size = sum sizes
    d <- fopen (fsBasePath ++ fs ++ "/allocation/data/bytes_used")
    m <- fopen (fsBasePath ++ fs ++ "/allocation/metadata/bytes_used")
    s <- fopen (fsBasePath ++ fs ++ "/allocation/system/bytes_used")
    return (BtrfsH (size*sectorSize) d m s)
  
  {-| Try to create a btfshanlde given the UUID
  
  This will create a 'BtrfsHandle' which is an instance of FsInfo and
  a list of block devices that are slaves of our file system.
  
  This allows the upper layer to monitor the read/write rates of all
  block devices that belong to our file system and report them as
  read/write rate for the file system.
  
  Due to compression and encryption the read/write rate on the block
  device may be quite different to the one that application see.
  -}
  getBtrfsHandle
    :: String -- ^The UUID of the file system to monitor
    -> IO (Maybe (BtrfsHandle, [Dev]))
  getBtrfsHandle fs = do
    e <- doesDirectoryExist (fsBasePath ++ fs)
    if e
      then do
        h <- getBtrfsHandle' fs
        devs <- getFSDevices fs
        return $ Just (h, devs)
      else return Nothing
  