snap-server-1.1.2.1: test/System/SendFile/Tests.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
module System.SendFile.Tests (tests) where
------------------------------------------------------------------------------
import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar, readMVar)
import Control.Exception (evaluate)
import Data.ByteString.Builder (byteString)
import qualified Data.ByteString.Char8 as S
import Foreign.C.Error (Errno (..), eAGAIN, eCONNRESET, eOK)
import Foreign.C.Types (CChar, CInt (..), CSize)
import Foreign.Storable (peek)
import Test.Framework (Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertEqual)
------------------------------------------------------------------------------
import Snap.Test.Common (expectException)
import qualified System.SendFile as SF
#if defined(LINUX)
import Control.Monad (void)
import Foreign.Ptr (Ptr, nullPtr)
import System.Posix.Types (COff, CSsize, Fd)
import qualified System.SendFile.Linux as SFI
#elif defined(FREEBSD)
import Control.Monad (void)
import Foreign.Ptr (Ptr)
import Foreign.Storable
import System.Posix.Types (COff, Fd)
import qualified System.SendFile.FreeBSD as SFI
#elif defined(OSX)
import Control.Monad (void, when)
import Foreign.Ptr (Ptr)
import Foreign.Storable (poke)
import System.Posix.Types (COff, Fd)
import qualified System.SendFile.Darwin as SFI
#endif
------------------------------------------------------------------------------
tests :: [Test]
tests = [ testSendHeaders
, testSendHeaderCrash
, testSendFile
, testSendFileCrash
, testSendFileZero
, testTrivials
]
------------------------------------------------------------------------------
testSendHeaders :: Test
testSendHeaders = testCase "sendfile/sendHeaders" $ do
callLog <- newMVar []
sampleData <- newMVar sampleActions
nWaits <- newMVar (0 :: Int)
let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1))
SF.sendHeadersImpl (sendHeadersMockSendFunc sampleData callLog) bumpWaits
builder 100
[c1, c2, c3] <- readMVar callLog
assertEqual "sendHeaders1" c1 c2
assertEqual "sendHeaders2" 8 (_sz c3)
readMVar nWaits >>= assertEqual "sendHeaders3" 1
where
builder = byteString $ S.replicate 10 ' '
sampleActions = [ c_set_errno eAGAIN >> return (-1)
, return 2
, return 8
]
------------------------------------------------------------------------------
testSendHeaderCrash :: Test
testSendHeaderCrash = testCase "sendfile/sendHeaders/crash" $ do
callLog <- newMVar []
sampleData <- newMVar sampleActions
nWaits <- newMVar (0 :: Int)
let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1))
expectException $
SF.sendHeadersImpl (sendHeadersMockSendFunc sampleData callLog) bumpWaits
builder 100
where
builder = byteString $ S.replicate 10 ' '
sampleActions = [ c_set_errno eCONNRESET >> return (-1) ]
------------------------------------------------------------------------------
testTrivials :: Test
testTrivials = testCase "sendfile/trivials" $
void (evaluate $ length SF.sendFileMode)
------------------------------------------------------------------------------
data SendHeadersCallLog = SendHeadersCallLog {
_fd :: Fd
, _str :: Ptr CChar
, _sz :: CSize
, _flags :: CInt
}
deriving (Eq, Show, Ord)
------------------------------------------------------------------------------
sendHeadersMockSendFunc :: MVar [IO CSize] -- ^ sample outputs
-> MVar [SendHeadersCallLog] -- ^ log of calls
-> Fd -> Ptr CChar -> CSize -> CInt -> IO CSize
sendHeadersMockSendFunc sampleData callLog !fd !cstr !clen !flags = do
modifyMVar_ callLog (return . (++ [SendHeadersCallLog fd cstr clen flags]))
x <- modifyMVar sampleData $ \xs -> return $!
if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs)
x >>= maybe (c_set_errno eCONNRESET >> return (-1))
(return)
foreign import ccall unsafe "set_errno" c_set_errno :: Errno -> IO ()
------------------------------------------------------------------------------
-- Testing for internal sendfile via dep injection
#if defined(LINUX)
data SendFileCallLog = SendFileCallLog {
_sf_fd1 :: Fd
, _sf_fd2 :: Fd
, _sf_off :: COff
, _sf_sz :: CSize
}
deriving (Eq, Show, Ord)
------------------------------------------------------------------------------
sendFileMockSendFunc :: MVar [IO CSize] -- ^ sample outputs
-> MVar [SendFileCallLog] -- ^ log of calls
-> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
sendFileMockSendFunc sampleData callLog !fd1 !fd2 !cstr !clen = do
cp <- if cstr == nullPtr then return (-1) else peek cstr
modifyMVar_ callLog (return . (++ [SendFileCallLog fd1 fd2 cp clen]))
x <- modifyMVar sampleData $ \xs -> return $!
if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs)
x >>= maybe (c_set_errno eCONNRESET >> return (-1))
(return . fromIntegral)
#elif defined(FREEBSD)
data SendFileCallLog = SendFileCallLog {
_sf_fd1 :: Fd
, _sf_fd2 :: Fd
, _sf_off :: COff
, _sf_sz :: CSize
}
deriving (Eq, Show, Ord)
------------------------------------------------------------------------------
sendFileMockSendFunc :: MVar [IO CInt] -- ^ sample outputs
-> MVar [SendFileCallLog] -- ^ log of calls
-> Fd -> Fd -> COff -> CSize -> Ptr () -> Ptr COff
-> CInt -> IO CInt
sendFileMockSendFunc sampleData callLog !fd1 !fd2 !off !clen !_ !pbytes !_ = do
modifyMVar_ callLog (return . (++ [SendFileCallLog fd1 fd2 off clen]))
x <- modifyMVar sampleData $ \xs -> return $!
if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs)
x >>= maybe (c_set_errno eCONNRESET >> return (-1)) return
#elif defined(OSX)
data SendFileCallLog = SendFileCallLog {
_sf_fd1 :: Fd
, _sf_fd2 :: Fd
, _sf_off :: COff
, _sf_sz :: COff
}
deriving (Eq, Show, Ord)
------------------------------------------------------------------------------
sendFileMockSendFunc :: MVar [IO CInt] -- ^ sample outputs
-> MVar [SendFileCallLog] -- ^ log of calls
-> Fd -> Fd -> COff -> Ptr COff -> IO CInt
sendFileMockSendFunc sampleData callLog !fd1 !fd2 !off !pnbytes = do
!clen <- peek pnbytes
modifyMVar_ callLog (return . (++ [SendFileCallLog fd1 fd2 off clen]))
x <- modifyMVar sampleData $ \xs -> return $!
if null xs then ([], return Nothing) else (tail xs, fmap Just $! head xs)
x >>= maybe (c_set_errno eCONNRESET >> return (-1))
(\l -> do when (l > 0) (poke pnbytes (fromIntegral l))
return l)
#endif
------------------------------------------------------------------------------
testSendFile :: Test
testSendFile = testCase "sendfile/sendfile-impl" $ do
callLog <- newMVar []
sampleData <- newMVar sampleActions
nWaits <- newMVar (0 :: Int)
let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1))
SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits
100 101 0 10
[c1, c2] <- readMVar callLog
assertEqual "sendFile1" c1 c2
assertEqual "sendFile2" 10 (_sf_sz c2)
readMVar nWaits >>= assertEqual "sendFile3" 1
modifyMVar_ callLog $ const $ return []
modifyMVar_ nWaits $ const $ return 0
modifyMVar_ sampleData $ const $ return sampleActions2
SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits
100 101 1 9
[_, c4] <- readMVar callLog
readMVar nWaits >>= assertEqual "nwaits-2" 1
assertEqual "sendFile3" 9 (_sf_sz c4)
assertEqual "sendFile3-off" 1 (_sf_off c4)
where
sampleActions = [ c_set_errno eAGAIN >> return (-1)
, c_set_errno eOK >> return 2
]
sampleActions2 = [ c_set_errno eAGAIN >> return (-1)
, c_set_errno eOK >> return 2
]
------------------------------------------------------------------------------
testSendFileZero :: Test
testSendFileZero = testCase "sendfile/sendfile-zero" $ do
callLog <- newMVar []
sampleData <- newMVar sampleActions
nWaits <- newMVar (0 :: Int)
let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1))
c <- SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits
100 101 0 0
readMVar callLog >>= assertEqual "empty call log" []
readMVar nWaits >>= assertEqual "no waits" 0
assertEqual "no bytes read" 0 c
where
sampleActions = [ c_set_errno eAGAIN >> return (-1)
, c_set_errno eOK >> return 2
]
------------------------------------------------------------------------------
testSendFileCrash :: Test
testSendFileCrash = testCase "sendfile/sendFile/crash" $ do
callLog <- newMVar []
sampleData <- newMVar sampleActions
nWaits <- newMVar (0 :: Int)
let bumpWaits = \x -> x `seq` modifyMVar_ nWaits (return . (+1))
expectException $
SFI.sendFileImpl (sendFileMockSendFunc sampleData callLog) bumpWaits
100 101 0 10
where
sampleActions = [ c_set_errno eCONNRESET >> return (-1) ]