VaultHandlerSpec.hs

{-# LANGUAGE NamedFieldPuns #-}

module Festung.Vault.VaultHandlerSpec (spec) where


import Test.Hspec


import Control.Exception (finally)
import System.FilePath   ((</>))

import Festung.Vault.VaultHandler
import qualified Festung.Vault.Persistence as P
import qualified Festung.Concurrency.Job   as J

import TestUtils


defaultPassword :: P.Password
defaultPassword = [0xDE, 0xAD, 0xBE, 0xEE, 0xEE, 0xEE, 0xEF]


invalidPassword :: P.Password
invalidPassword = [0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00]


-- | Create a new VaultHandler in a temporary directory
withHandler :: Int -> (VaultOpener -> Vault -> IO a) -> IO a
withHandler timeout action = withConfig timeout $ \ config@Config{dataDirectory} ->
    let vaultPath = dataDirectory </> defaultVaultName
        params    = P.VaultParameters { P.kdfIter = Nothing }
        opener    = (vaultPath, defaultPassword, params)
    in newHandler config opener >>= action' opener
           where action' o (Left err) = fail' $ expectationFailure ("Could not open handler: " ++ show err)
                 action' o (Right  v) = finally (action o v) (stopHandler v)
                 stopHandler v = return ()  -- TODO: Really stop the handler
                 fail' action = action >> fail "Failed"


withHandler_ :: (VaultOpener -> Vault -> IO a) -> IO a
withHandler_ = withHandler defaultTimeout


couldNotReach :: Show a => Either VaultError a -> Expectation
couldNotReach (Right _  ) = expectationFailure "Expected an error"
couldNotReach (Left  err) = case err of
                                CouldNotReach -> return ()
                                _             -> expectationFailure "Expected CouldNotReach"


spec :: Spec
spec = do
    describe "newHandler" $ do
        it "Can handle many queries" $ withHandler_ $ \ opener vault -> do
            let query' = query opener vault
            query' "CREATE TABLE foo(bar int)"
            query' "INSERT INTO foo(bar) VALUES (1), (2)"

            dat <- noError =<< query' "SELECT bar AS baz FROM foo ORDER BY 1"
            P.headers dat `shouldBe` [("baz", Just "int")]
            P.rows    dat `shouldBe` [[P.IntValue 1], [P.IntValue 2]]

            dat <- noError =<< query' "SELECT * FROM foo WHERE bar < 0"
            P.rows    dat `shouldBe` []

        it "queries don't block when stopped" $ withHandler_ $ \ opener vault -> do
            J.killJob vault
            couldNotReach =<< query opener vault "SELECT 1"

        it "It verifies password" $ withHandler_ $ \ opener vault -> do
            let (path, password, parameters) = opener
                opener' = (path, invalidPassword, parameters)
                query' = query opener' vault

            ret <- query' "SELECT 1"
            case ret of
                Left  CouldNotOpen -> return ()
                Left  _            -> expectationFailure "is not CouldNotOpen"
                Right _            -> expectationFailure "is not an error"

    describe "parametrizedQuery" $
        it "Parametrizes the query" $ withHandler_ $ \ opener vault -> do
            let query' = query opener vault
                parametrizedQuery' = parametrizedQuery opener vault

            query' "CREATE TABLE foo(bar int)"
            parametrizedQuery' "INSERT INTO foo(bar) VALUES (?), (?)" [P.IntValue 1, P.IntValue 2]
            dat <- noError =<< parametrizedQuery' "SELECT bar FROM foo WHERE bar < ?" [P.IntValue 2]
            P.headers dat `shouldBe` [("bar", Just "int")]
            P.rows    dat `shouldBe` [[P.IntValue 1]]