{-
    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.Device
Description : Allows access to information about generic block device
Maintainer  : ongy
Stability   : experimental
Portability : Linux

This module allows to read generic information about a block device
and its file system.

It only works if the file system is mounted when the handle is created
since it needs to *find* the mount point to get information about the
file system
-}
module Monky.Disk.Device
  ( BlockHandle(..)
  , getBlockHandle
  , getBlockHandleTag

  , devToMount
  )
where

import System.Posix.StatVFS
import Data.Maybe (listToMaybe)
import Data.List (isSuffixOf)

import Monky.Blkid
import Monky.Disk.Common

#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>))
#endif


{- |Get "the" mountpoint of a device. 

Returns a mointpoint of a device. If there are multiple mountpoints, this will
return the first one found.
First one is mostly determined by order in /proc/mounts and should be the one
that was mounted first (time since boot).
-}
devToMount :: Dev -> IO (Maybe String)
devToMount dev = do
  masters <- devToMapper dev
  mounts <- map (take 2 . words) . lines <$> readFile "/proc/mounts"
  return . listToMaybe . map (!! 1) $ filter (isDev masters) mounts
  where
    isDev masters [x, _] = any (\(Label master) -> ('/':master) `isSuffixOf` x) masters
    isDev _ _ = error "devToMount: How does take 2 not match [_, _]?"


-- Size data metadata system
-- |The FsInfo handle exported by this module
data BlockHandle = BlockH FilePath

instance FsInfo BlockHandle where
  getFsSize = getSize
  getFsFree = getFree


getSize :: BlockHandle -> IO Integer
getSize (BlockH path) = do
  fstat <- statVFS path
  return $ (fromIntegral $ statVFS_blocks fstat) * (fromIntegral $ statVFS_frsize fstat)


getFree :: BlockHandle -> IO Integer
getFree (BlockH path) = do
  fstat <- statVFS path
  return $ (fromIntegral $ statVFS_bavail fstat) * (fromIntegral $ statVFS_frsize fstat)


getBlockHandle' :: Dev -> IO (Maybe (BlockHandle, Dev))
getBlockHandle' dev = do
  path <- devToMount dev
  case path of
        Just x -> return $Just (BlockH x, dev)
        Nothing -> return Nothing

{- |Get a fs handle for 'normal' devices

This uses fsStat to get file system information.

fsStat takes the mount point of the file system, so we need to find the mount point.

In case of mapper devices, this is done by going through the chain of slaves.
-}
getBlockHandle :: String -> IO (Maybe (BlockHandle, Dev))
getBlockHandle = getBlockHandleTag "UUID"

-- | Same as 'getBlockHandle' but allow to pass the tag for libblkid
getBlockHandleTag :: String -> String -> IO (Maybe (BlockHandle, Dev))
getBlockHandleTag t fs = do
  dev <- evaluateTag t fs
  case dev of
    Just x -> do
        y <- labelToDev (Label . reverse . takeWhile (/= '/') . reverse $ x)
        getBlockHandle' y
    Nothing -> return Nothing