content: {-# 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) ]
  