-
Notifications
You must be signed in to change notification settings - Fork 5
/
Properties.hs
72 lines (62 loc) · 2.51 KB
/
Properties.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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
import FoundationDB
import Control.Monad
import Data.ByteString.Char8 (ByteString)
import System.Environment (lookupEnv)
import Test.Hspec
-- | Prefix for all test keys, to reduce the chance of a user accidentally
-- wiping something important.
prefix :: ByteString
prefix = "foundationdb-haskell-test-"
cleanup :: Database -> IO ()
cleanup db = runTransaction db $ do
let begin = prefix <> "a"
let end = prefix <> "z"
fut <- getRange $ Range { rangeBegin = FirstGreaterOrEq begin
, rangeEnd = LastLessOrEq end
, rangeLimit = Nothing
, rangeReverse = False
}
res <- await fut
go res
where go (RangeDone kvs) = forM_ (map fst kvs) clear
go (RangeMore kvs more) = do
forM_ (map fst kvs) clear
res <- await more
go res
main :: IO ()
main = withFoundationDB currentAPIVersion $ do
mdbPath <- lookupEnv "FDB_HASKELL_TEST_CLUSTER_FILE"
case mdbPath of
Nothing -> error "tests require FDB_HASKELL_TEST_CLUSTER_FILE to be set."
Just _ -> withDatabase mdbPath $ \case
Left e -> error $ "error starting DB: " ++ show e
Right db -> do
hspec $ after_ (cleanup db) $ do
describe "set and get" $ do
it "should round trip" $ do
let k = prefix <> "foo"
runTransaction db $ set k "bar"
v <- runTransaction db $ do f <- get k
await f
v `shouldBe` Just "bar"
it "returns Nothing after clearing" $ do
let k = prefix <> "cleartest"
runTransaction db $ set k "test"
runTransaction db $ clear k
v <- runTransaction db $ get k >>= await
v `shouldBe` Nothing
it "round trips when both commands are in one transaction" $ do
let k = prefix <> "onetrans"
v <- runTransaction db $ do set k "x"
get k >>= await
putStrLn "finished transaction"
v `shouldBe` Just "x"
describe "transaction cancellation" $ do
it "should not commit cancelled transactions" $ do
let k = prefix <> "neverCommitted"
runTransaction db (set k "test" >> cancel)
`shouldThrow` (== TransactionCanceled)
v <- runTransaction db $ get k >>= await
v `shouldBe` Nothing