TestSuite.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Concurrent
import           Control.Exception
import           Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Char8 as S
import qualified Network.HTTP.Enumerator as HTTP
import           Snap.Http.Server.Config
import           Snap.Snaplet
import           System.Posix.Process
import           System.Posix.Types
--import           Test.Framework (defaultMain, Test)
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit hiding (Test, path)

import           Snap.Http.Server (simpleHttpServe)
import           Blackbox.App
import qualified Blackbox.Tests
import qualified Snap.Snaplet.Internal.Lensed.Tests
import qualified Snap.Snaplet.Internal.LensT.Tests
import qualified Snap.Snaplet.Internal.RST.Tests
import qualified Snap.Snaplet.Internal.Tests
import           Snap.TestCommon

import SafeCWD


------------------------------------------------------------------------------
main :: IO ()
main = do
    Blackbox.Tests.remove "non-cabal-appdir/templates/bad.tpl"
    Blackbox.Tests.remove "non-cabal-appdir/templates/good.tpl"
    Blackbox.Tests.removeDir "non-cabal-appdir/snaplets/foosnaplet"

    inDir False "non-cabal-appdir" startServer
    threadDelay $ 2*10^(6::Int)
    defaultMain tests

  where tests = [ internalServerTests
                , testDefault
                , testBarebones
                , testTutorial
                ]


internalServerTests :: Test
internalServerTests =
    testGroup "internal server tests"
        [ Blackbox.Tests.tests
        , Snap.Snaplet.Internal.Lensed.Tests.tests
        , Snap.Snaplet.Internal.LensT.Tests.tests
        , Snap.Snaplet.Internal.RST.Tests.tests
        , Snap.Snaplet.Internal.Tests.tests
        ]

startServer :: IO ProcessID
startServer = forkProcess $ serve (setPort 9753 defaultConfig) app
  where
    serve config initializer = do
        (_, handler, doCleanup) <- runSnaplet initializer
        (conf, site)            <- combineConfig config handler
        _ <- try $ simpleHttpServe conf $ site
             :: IO (Either SomeException ())
        doCleanup


testBarebones :: Test
testBarebones = testCase "snap/barebones" go
  where
    go = testGeneratedProject "barebonesTest"
                              "barebones"
                              ""
                              port
                              testIt
    port = 9990
    testIt = do
        body <- HTTP.simpleHttp $ "http://127.0.0.1:"++(show port)
        assertEqual "server not up" "hello world" body


testDefault :: Test
testDefault = testCase "snap/default" go
  where
    go = testGeneratedProject "defaultTest"
                              ""
                              ""
                              port
                              testIt
    port = 9991
    testIt = do
        body <- liftM (S.concat . L.toChunks) $
                HTTP.simpleHttp $ "http://127.0.0.1:"++(show port)
        assertBool "response contains phrase 'it works!'"
                   $ "It works!" `S.isInfixOf` body


testTutorial :: Test
testTutorial = testCase "snap/tutorial" go
  where
    go = testGeneratedProject "tutorialTest"
                              "tutorial"
                              ""
                              port
                              testIt
    port = 9992
    testIt = do
        body <- HTTP.simpleHttp $ "http://127.0.0.1:"++(show port)++"/hello"
        assertEqual "server not up" "hello world" body