festung-0.9.1.1: tests/TestUtils.hs

module TestUtils 
    ( Config(..)
    , defaultTimeout
    , defaultVaultName
    , isError
    , noError
    , unwrap
    , withConfig
    , withConfig_
    , withTmp
    , withVaultName
    ) where

import Control.Monad.Catch    (MonadMask)
import Control.Monad.IO.Class (MonadIO)
import System.FilePath        ((</>))
import System.IO.Temp         (withSystemTempDirectory)
import Test.Hspec             (expectationFailure)

import Festung.Config (Config(..))


withTmp :: (MonadIO m, MonadMask m) => (FilePath -> m a) -> m a
withTmp = withSystemTempDirectory "tmp.test.festung."


defaultVaultName :: FilePath
defaultVaultName = "vault.sqlcipher"


withVaultName :: (MonadIO m, MonadMask m) => (FilePath -> m a) -> m a
withVaultName action = withTmp action'
    where action' tmpDir = action $ tmpDir </> defaultVaultName


unwrap :: Show e => Either e a -> a
unwrap (Left  e) = error $ "unwrap: object is an error: " ++ show e
unwrap (Right r) = r


defaultTimeout :: Int
defaultTimeout = 15 * 1000 * 1000


-- | Build a temporary configuration
withConfig :: Int -> (Config -> IO a) -> IO a
withConfig timeout action = withTmp $ \ tmpDir ->
    let port   = -1 -- Yesod is not running. Port can be anything since it is ignored
        config = Config
            { dataDirectory = tmpDir
            , vaultTimeout  = timeout
            , port          = port
            }
     in action config


withConfig_ :: (Config -> IO a) -> IO a
withConfig_ = withConfig defaultTimeout


noError :: Show a => Either a b -> IO b
noError (Left  err) = expectationFailure ("isLeft: " ++ show err) >> fail "Failed"
noError (Right val) = return val


isError :: Either a b -> IO a
isError (Left err)  = return err
isError (Right _) = expectationFailure "isRight" >> fail "Failed"