xattr-0.6.0: tests/Tests.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Main (main) where

import Test.Framework (Test, defaultMain)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit hiding (Test)

import Data.List (sort)
import Control.Monad (forM_)
import Control.Exception (bracket)
import System.IO
import System.Directory
import System.Posix.Temp
import System.Xattr
import qualified Data.ByteString.Char8 as BC
import System.IO.Unsafe

main :: IO ()
main = defaultMain tests

name :: AttrName
name = "user.xattrName"

value :: AttrValue
value = "xattrValue\255\0\1\2Ends\42\43Here"

nrAttrs :: Int
nrAttrs = 10

tests :: [Test]
tests = [ 
    testCase "set_get_xattr"    test_set_get_xattr
  , testCase "fset_fget_xattr"  test_fset_fget_xattr
  , testCase "set_fget_xattr"   test_set_fget_xattr
  , testCase "fset_get_xattr"   test_fset_get_xattr
  , testCase "set_list_xattr"   test_set_list_xattr
  , testCase "fset_flist_xattr" test_fset_flist_xattr
  ]

test_set_get_xattr :: Assertion
{-# NOINLINE test_set_get_xattr #-}
test_set_get_xattr = unsafePerformIO $ do
  withTmpFile $ \(path,_) -> do
    setxattr path name value RegularMode
    value' <- getxattr path name
    return $ value' @?= value

test_fset_fget_xattr :: Assertion
{-# NOINLINE test_fset_fget_xattr #-}
test_fset_fget_xattr = unsafePerformIO $ do
  withTmpFile $ \(_,h) -> do
    fsetxattr h name value RegularMode
    value' <- fgetxattr h name
    return $ value' @?= value

test_set_fget_xattr :: Assertion
{-# NOINLINE test_set_fget_xattr #-}
test_set_fget_xattr = unsafePerformIO $ do
  withTmpFile $ \(path,h) -> do
    setxattr path name value RegularMode
    value' <- fgetxattr h name
    return $ value' @?= value

test_fset_get_xattr :: Assertion
{-# NOINLINE test_fset_get_xattr #-}
test_fset_get_xattr = unsafePerformIO $ do
  withTmpFile $ \(path,h) -> do
    fsetxattr h name value RegularMode
    value' <- getxattr path name
    return $ value' @?= value

test_set_list_xattr :: Assertion
{-# NOINLINE test_set_list_xattr #-}
test_set_list_xattr = unsafePerformIO $ do
  withTmpFile $ \(path,_) -> do
    let attrs = map (\x -> name ++ show x) [1..nrAttrs]
    forM_ attrs $ \namei -> 
        setxattr path namei value RegularMode
    attrs' <- listxattr path
    return $ sort attrs' @?= sort attrs
  
test_fset_flist_xattr :: Assertion
{-# NOINLINE test_fset_flist_xattr #-}
test_fset_flist_xattr = unsafePerformIO $ do
  withTmpFile $ \(_,h) -> do
    let attrs = map (\x -> name ++ show x) [1..nrAttrs]
    forM_ attrs $ \namei -> 
        fsetxattr h namei value RegularMode
    attrs' <- flistxattr h
    return $ sort attrs' @?= sort attrs

withTmpFile :: ((FilePath, Handle) -> IO Assertion) -> IO Assertion
withTmpFile io = do
  bracket (mkstemp "xattrXXXXXX")  -- works with old version of mkstemp
          (\(path,h) -> hClose h >> removeFile path)
          (\(path,h) -> BC.hPutStr h "testing xattr" >> io (path,h))