diff --git a/src/ATrade/MDS/Database.hs b/src/ATrade/MDS/Database.hs index 84e541d..33972f1 100644 --- a/src/ATrade/MDS/Database.hs +++ b/src/ATrade/MDS/Database.hs @@ -52,10 +52,12 @@ initDatabase config = do infoM "DB" $ "Initializing DB" conn <- connectSqlite3 (T.unpack $ dbPath config) makeSchema conn + makeIndex conn infoM "DB" $ "Schema updated" return conn where makeSchema conn = runRaw conn "CREATE TABLE IF NOT EXISTS bars (id SERIAL PRIMARY KEY, ticker TEXT, timestamp BIGINT, timeframe INTEGER, open NUMERIC(20, 10), high NUMERIC(20, 10), low NUMERIC(20, 10), close NUMERIC(20,10), volume BIGINT);" + makeIndex conn = runRaw conn "CREATE INDEX IF NOT EXISTS idx_bars ON bars (ticker, timeframe);" closeDatabase :: MdsHandle -> IO () closeDatabase = disconnect diff --git a/test/Integration/Database.hs b/test/Integration/Database.hs index bfe644b..dcf880d 100644 --- a/test/Integration/Database.hs +++ b/test/Integration/Database.hs @@ -3,34 +3,45 @@ module Integration.Database ( testDatabase ) where -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty +import Test.Tasty.HUnit -import ATrade.MDS.Database +import ATrade.MDS.Database -import ATrade.Types -import Control.Exception -import Data.DateTime -import Data.Time.Clock -import qualified Data.Text as T -import qualified Data.Vector as V -import System.IO.Temp +import ATrade.Types +import Control.Exception +import Data.DateTime +import qualified Data.Text as T +import Data.Time.Clock +import qualified Data.Vector as V +import System.IO.Temp testDatabase :: TestTree -testDatabase = testGroup "Database tests" [ testOpenClose +testDatabase = testGroup "Database tests" [ + testOpenClose + , testOpenCloseTwice , testPutGet , testGetReturnsSorted ] testOpenClose :: TestTree -testOpenClose = testCase "Open/Close" $ +testOpenClose = testCase "Open/Close" $ withSystemTempDirectory "test" $ \fp -> do - let dbConfig = DatabaseConfig (T.pack $ fp ++ "/test.db") T.empty T.empty T.empty + let dbConfig = DatabaseConfig (T.pack $ fp ++ "/test.db") T.empty T.empty T.empty db <- initDatabase dbConfig closeDatabase db +testOpenCloseTwice :: TestTree +testOpenCloseTwice = testCase "Open/Close twice" $ + withSystemTempDirectory "test" $ \fp -> do + let dbConfig = DatabaseConfig (T.pack $ fp ++ "/test.db") T.empty T.empty T.empty + db <- initDatabase dbConfig + closeDatabase db + db2 <- initDatabase dbConfig + closeDatabase db2 + bar :: UTCTime -> Price -> Price -> Price -> Price -> Integer -> Bar -bar dt o h l c v = Bar { barSecurity = "FOO", +bar dt o h l c v = Bar { barSecurity = "FOO", barTimestamp = dt, barOpen = o, barHigh = h, @@ -39,9 +50,9 @@ bar dt o h l c v = Bar { barSecurity = "FOO", barVolume = v } testPutGet :: TestTree -testPutGet = testCase "Put/Get" $ +testPutGet = testCase "Put/Get" $ withSystemTempDirectory "test" $ \fp -> do - let dbConfig = DatabaseConfig (T.pack $ fp ++ "/test.db") T.empty T.empty T.empty + let dbConfig = DatabaseConfig (T.pack $ fp ++ "/test.db") T.empty T.empty T.empty bracket (initDatabase dbConfig) closeDatabase $ \db -> do putData db "FOO" interval (timeframeMinute 1) bars retrievedBars <- (snd . head) <$> getData db "FOO" interval (timeframeMinute 1) @@ -56,9 +67,9 @@ testPutGet = testCase "Put/Get" $ ] testGetReturnsSorted :: TestTree -testGetReturnsSorted = testCase "Get returns sorted vector" $ +testGetReturnsSorted = testCase "Get returns sorted vector" $ withSystemTempDirectory "test" $ \fp -> do - let dbConfig = DatabaseConfig (T.pack $ fp ++ "/test.db") T.empty T.empty T.empty + let dbConfig = DatabaseConfig (T.pack $ fp ++ "/test.db") T.empty T.empty T.empty bracket (initDatabase dbConfig) closeDatabase $ \db -> do putData db "FOO" interval (timeframeMinute 1) bars retrievedBars <- (snd . head) <$> getData db "FOO" interval (timeframeMinute 1)