/
VolatileDB.hs
47 lines (41 loc) · 1.72 KB
/
VolatileDB.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Test.Ouroboros.Storage.VolatileDB (tests) where
import Control.Tracer (nullTracer)
import Test.QuickCheck
import Test.QuickCheck.Monadic
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck (testProperty)
import qualified Ouroboros.Storage.Util.ErrorHandling as EH
import Ouroboros.Storage.VolatileDB.API
import qualified Ouroboros.Storage.VolatileDB.Impl as Internal hiding (openDB)
import Test.Ouroboros.Storage.Util
import qualified Test.Ouroboros.Storage.VolatileDB.StateMachine as StateMachine
tests :: HasCallStack => TestTree
tests = testGroup "VolatileDB"
[ testProperty "Invalid argument" prop_VolatileInvalidArg
, StateMachine.tests
]
prop_VolatileInvalidArg :: HasCallStack => Property
prop_VolatileInvalidArg = monadicIO $
run $ apiEquivalenceVolDB fExpected (\hasFS err -> do
_ <- Internal.openDBFull hasFS err (EH.throwCantCatch EH.monadCatch) dummyParser nullTracer 0
return ()
)
where
dummyParser :: Parser String IO Int
dummyParser = Parser {
parse = \_ -> return ([], Nothing)
}
fExpected = \case
Left (UserError (InvalidArgumentsError _str)) -> return ()
somethingElse -> fail $ "IO returned " <> show somethingElse <> " instead of InvalidArgumentsError"