summaryrefslogtreecommitdiff
path: root/tests/test-suite.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/test-suite.hs')
-rw-r--r--tests/test-suite.hs163
1 files changed, 129 insertions, 34 deletions
diff --git a/tests/test-suite.hs b/tests/test-suite.hs
index e3de360..df5e258 100644
--- a/tests/test-suite.hs
+++ b/tests/test-suite.hs
@@ -5,22 +5,92 @@ import Control.Exception as E
import Control.Monad
import Control.Monad.Trans
import Data.Function
+import Data.Int
import Data.List (find)
import Data.Monoid
import Data.Text (Text)
import Data.Unique
+import Data.Word
import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
+import Test.HUnit.Lang (HUnitFailure(..))
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
+import Test.Tasty.QuickCheck
import qualified Network.HTTP.Client as HC
import Database.InfluxDB
+import qualified Database.InfluxDB.Stream as S
-main :: IO ()
-main = $defaultMainGenerator
+prop_fromValue_toValue_identity_Value :: Value -> Bool
+prop_fromValue_toValue_identity_Value = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Bool :: Bool -> Bool
+prop_fromValue_toValue_identity_Bool = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Int :: Int -> Bool
+prop_fromValue_toValue_identity_Int = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Int8 :: Int8 -> Bool
+prop_fromValue_toValue_identity_Int8 = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Int16 :: Int16 -> Bool
+prop_fromValue_toValue_identity_Int16 = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Int32 :: Int32 -> Bool
+prop_fromValue_toValue_identity_Int32 = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Int64 :: Int64 -> Bool
+prop_fromValue_toValue_identity_Int64 = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Word8 :: Word8 -> Bool
+prop_fromValue_toValue_identity_Word8 = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Word16 :: Word16 -> Bool
+prop_fromValue_toValue_identity_Word16 = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Word32 :: Word32 -> Bool
+prop_fromValue_toValue_identity_Word32 = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Double :: Double -> Bool
+prop_fromValue_toValue_identity_Double = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Text :: T.Text -> Bool
+prop_fromValue_toValue_identity_Text = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_LazyText :: TL.Text -> Bool
+prop_fromValue_toValue_identity_LazyText = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_String :: String -> Bool
+prop_fromValue_toValue_identity_String = fromValueToValueIdentity
+
+prop_fromValue_toValue_identity_Maybe_Int :: Maybe Int -> Bool
+prop_fromValue_toValue_identity_Maybe_Int = fromValueToValueIdentity
+
+-------------------------------------------------
+
+instance Arbitrary Value where
+ arbitrary = oneof
+ [ Int <$> arbitrary
+ , Float <$> arbitrary
+ , String <$> arbitrary
+ , Bool <$> arbitrary
+ , pure Null
+ ]
+
+instance Arbitrary T.Text where
+ arbitrary = T.pack <$> arbitrary
+
+instance Arbitrary TL.Text where
+ arbitrary = TL.pack <$> arbitrary
+
+fromValueToValueIdentity :: (Eq a, FromValue a, ToValue a) => a -> Bool
+fromValueToValueIdentity a = fromValue (toValue a) == Right a
+
+-------------------------------------------------
case_post :: Assertion
case_post = runTest $ \config ->
@@ -28,9 +98,10 @@ case_post = runTest $ \config ->
name <- liftIO newName
post config database $
writeSeries name $ Val 42
- [series] <- query config database $
- "select value from " <> name
- fromSeriesData series @=? Right [Val 42]
+ ss <- query config database $ "select value from " <> name
+ case ss of
+ [series] -> fromSeriesData series @=? Right [Val 42]
+ _ -> assertFailure $ "Expect one series, but got: " ++ show ss
case_post_multi_series :: Assertion
case_post_multi_series = runTest $ \config ->
@@ -40,9 +111,10 @@ case_post_multi_series = runTest $ \config ->
writeSeries name $ Val 42
writeSeries name $ Val 42
writeSeries name $ Val 42
- [series] <- query config database $
- "select value from " <> name
- fromSeriesData series @=? Right [Val 42, Val 42, Val 42]
+ ss <- query config database $ "select value from " <> name
+ case ss of
+ [series] -> fromSeriesData series @=? Right [Val 42, Val 42, Val 42]
+ _ -> assertFailure $ "Expect one series, but got: " ++ show ss
case_post_multi_points :: Assertion
case_post_multi_points = runTest $ \config ->
@@ -52,9 +124,26 @@ case_post_multi_points = runTest $ \config ->
writePoints $ Val 42
writePoints $ Val 42
writePoints $ Val 42
- [series] <- query config database $
- "select value from " <> name
- fromSeriesData series @=? Right [Val 42, Val 42, Val 42]
+ ss <- query config database $ "select value from " <> name
+ case ss of
+ [series] -> fromSeriesData series @=? Right [Val 42, Val 42, Val 42]
+ _ -> assertFailure $ "Expect one series, but got: " ++ show ss
+
+case_queryChunked :: Assertion
+case_queryChunked = runTest $ \config ->
+ withTestDatabase config $ \database -> do
+ name <- liftIO newName
+ post config database $ withSeries name $ do
+ writePoints $ Val 42
+ writePoints $ Val 42
+ writePoints $ Val 42
+ ss <- queryChunked config database ("select value from " <> name) $
+ S.fold step []
+ mapM fromSeriesData ss @=? Right [[Val 42], [Val 42], [Val 42]]
+ where
+ step xs series = case fromSeriesData series of
+ Left reason -> throwIO $ HUnitFailure reason
+ Right values -> return $ xs ++ values
case_post_with_precision :: Assertion
case_post_with_precision = runTest $ \config ->
@@ -62,9 +151,10 @@ case_post_with_precision = runTest $ \config ->
name <- liftIO newName
postWithPrecision config database SecondsPrecision $
writeSeries name $ Val 42
- [series] <- query config database $
- "select value from " <> name
- fromSeriesData series @=? Right [Val 42]
+ ss <- query config database $ "select value from " <> name
+ case ss of
+ [series] -> fromSeriesData series @=? Right [Val 42]
+ _ -> assertFailure $ "Expect one series, but got: " ++ show ss
case_listDatabases :: Assertion
case_listDatabases = runTest $ \config ->
@@ -78,13 +168,13 @@ case_create_then_drop_database = runTest $ \config -> do
name <- newName
dropDatabaseIfExists config name
createDatabase config name
- databases <- listDatabases config
- assertBool ("No such database: " ++ T.unpack name) $
- any ((name ==) . databaseName) databases
+ listDatabases config >>= \databases ->
+ assertBool ("No such database: " ++ T.unpack name) $
+ any ((name ==) . databaseName) databases
dropDatabase config name
- databases' <- listDatabases config
- assertBool ("Found a dropped database: " ++ T.unpack name) $
- all ((name /=) . databaseName) databases'
+ listDatabases config >>= \databases ->
+ assertBool ("Found a dropped database: " ++ T.unpack name) $
+ all ((name /=) . databaseName) databases
case_list_cluster_admins :: Assertion
case_list_cluster_admins = runTest $ \config -> do
@@ -96,13 +186,13 @@ case_add_then_delete_cluster_admin :: Assertion
case_add_then_delete_cluster_admin = runTest $ \config -> do
name <- newName
admin <- addClusterAdmin config name "somePassword"
- admins <- listClusterAdmins config
- assertBool ("No such admin: " ++ T.unpack name) $
- any ((name ==) . adminUsername) admins
+ listClusterAdmins config >>= \admins ->
+ assertBool ("No such admin: " ++ T.unpack name) $
+ any ((name ==) . adminUsername) admins
deleteClusterAdmin config admin
- admins' <- listClusterAdmins config
- assertBool ("Found a deleted admin: " ++ T.unpack name) $
- all ((name /=) . adminUsername) admins'
+ listClusterAdmins config >>= \admins ->
+ assertBool ("Found a deleted admin: " ++ T.unpack name) $
+ all ((name /=) . adminUsername) admins
case_update_cluster_admin_password :: Assertion
case_update_cluster_admin_password = runTest $ \config -> do
@@ -117,13 +207,13 @@ case_update_cluster_admin_password = runTest $ \config -> do
name <- newName
dropDatabaseIfExists config name
createDatabase newConfig name
- databases <- listDatabases newConfig
- assertBool ("No such database: " ++ T.unpack name) $
- any ((name ==) . databaseName) databases
+ listDatabases newConfig >>= \databases ->
+ assertBool ("No such database: " ++ T.unpack name) $
+ any ((name ==) . databaseName) databases
dropDatabase newConfig name
- databases' <- listDatabases newConfig
- assertBool ("Found a dropped database: " ++ T.unpack name) $
- all ((name /=) . databaseName) databases'
+ listDatabases newConfig >>= \databases ->
+ assertBool ("Found a dropped database: " ++ T.unpack name) $
+ all ((name /=) . databaseName) databases
case_add_then_delete_database_users :: Assertion
case_add_then_delete_database_users = runTest $ \config ->
@@ -160,14 +250,14 @@ case_grant_revoke_database_user = runTest $ \config ->
assertBool ("No such user: " <> T.unpack newUserName) $
any ((newUserName ==) . userName) users
grantAdminPrivilegeTo config name newUserName
- listDatabaseUsers config name >>= \users -> do
+ listDatabaseUsers config name >>= \users ->
case find ((newUserName ==) . userName) users of
Nothing -> assertFailure $ "No such user: " <> T.unpack newUserName
Just user -> assertBool
("User is not privileged: " <> T.unpack newUserName)
(userIsAdmin user)
revokeAdminPrivilegeFrom config name newUserName
- listDatabaseUsers config name >>= \users -> do
+ listDatabaseUsers config name >>= \users ->
case find ((newUserName ==) . userName) users of
Nothing -> assertFailure $ "No such user: " <> T.unpack newUserName
Just user -> assertBool
@@ -224,3 +314,8 @@ withTestDatabase config = bracket acquire release
catchAll :: IO a -> (SomeException -> IO a) -> IO a
catchAll = E.catch
+
+-------------------------------------------------
+
+main :: IO ()
+main = $defaultMainGenerator