-- allows automatic derivation from Entity type class
{-# LANGUAGE DeriveAnyClass #-}
module ExceptionsSpec
( test,
spec,
)
where
import Database.GP.GenericPersistenceSafe
import Database.HDBC.Sqlite3
import GHC.Generics
import Test.Hspec
import Database.HDBC
import Control.Exception
-- `test` is here so that this module can be run from GHCi on its own. It is
-- not needed for automatic spec discovery.
-- (start up stack repl --test to bring up ghci and have access to all the test functions)
test :: IO ()
test = hspec spec
prepareDB :: IO Conn
prepareDB = do
conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
setupTableFor @Article SQLite conn
return conn
data Article = Article
{ articleID :: Int,
title :: String,
year :: Int
}
deriving (Generic, Show, Eq)
instance Entity Article where
autoIncrement = False
data Bogus = Bogus
{ bogusID :: Int,
bogusTitle :: String,
bogusYear :: Int
}
deriving (Generic, Show, Eq)
instance Entity Bogus where
tableName = "Article"
fieldsToColumns :: [(String, String)] -- ommitting the articles field,
fieldsToColumns = -- as this can not be mapped to a single column
[ ("bogusID", "articleID"),
("bogusTitle", "title"),
("bogusYear", "year")
]
fromRow :: Conn -> [SqlValue] -> IO Bogus
fromRow _conn _row = throw $ DatabaseError "can't create bogus"
yearField :: Field
yearField = field "year"
article :: Article
article = Article 1 "The Hitchhiker's Guide to the Galaxy" 1979
expectationSuccess :: IO ()
expectationSuccess = return ()
spec :: Spec
spec = do
describe "Exception Handling" $ do
it "detects duplicate inserts" $ do
conn <- prepareDB
_ <- insert conn article
eitherExRes <- insert conn article :: IO (Either PersistenceException Article)
case eitherExRes of
Left di@(DuplicateInsert _msg) -> show di `shouldContain` "Entity already exists"
_ -> expectationFailure "Expected DuplicateInsert exception"
it "detects duplicate inserts in insertMany" $ do
conn <- prepareDB
_ <- insert conn article
eitherExRes <- insertMany conn [article,article] :: IO (Either PersistenceException ())
case eitherExRes of
Left (DuplicateInsert msg) -> msg `shouldContain` "Entity already exists"
_ -> expectationFailure "Expected DuplicateInsert exception"
it "detects duplicate inserts in persist" $ do
conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
runRaw conn "CREATE TABLE article (articleID INTEGER, title TEXT, year INTEGER)"
_ <- insert conn article
_ <- insert conn article{title="another title"}
eitherExRes <- persist conn article :: IO (Either PersistenceException ())
case eitherExRes of
Left (NoUniqueKey msg) -> msg `shouldContain` "More than one entity found for id SqlInt64 1"
Left pe -> expectationFailure $ "Expected NoUniqueKey exception, got " ++ show pe
_ -> expectationFailure "Expected NoUniqueKey exception"
it "detects missing entities in selectById" $ do
conn <- prepareDB
eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Article)
case eitherExRes of
Left (EntityNotFound msg) -> msg `shouldContain` "not found"
_ -> expectationFailure "Expected EntityNotFound exception"
it "detects non unique entities in selectById" $ do
conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
runRaw conn "CREATE TABLE article (articleID INTEGER, title TEXT, year INTEGER)"
_ <- insert conn article
_ <- insert conn article{title="another title"}
eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Article)
case eitherExRes of
Left (NoUniqueKey msg) -> msg `shouldContain` "More than one Article found for id SqlString \"1\""
_ -> expectationFailure "Expected DuplicateEntity exception"
it "detects bogus data in selectById" $ do
conn <- prepareDB
_ <- insert conn article
eitherExRes <- selectById conn "1" :: IO (Either PersistenceException Bogus)
case eitherExRes of
Left (DatabaseError msg) -> msg `shouldContain` "can't create bogus"
Left pe -> expectationFailure $ "Expected DatabaseError exception, got " ++ show pe
_ -> expectationFailure "Expected DatabaseError exception"
it "detects missing entities in update" $ do
conn <- prepareDB
eitherExRes <- update conn article :: IO (Either PersistenceException ())
case eitherExRes of
Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"
_ -> expectationFailure "Expected EntityNotFound exception"
it "detects missing entities in delete" $ do
conn <- prepareDB
eitherExRes <- delete conn article :: IO (Either PersistenceException ())
case eitherExRes of
Left (EntityNotFound msg) -> msg `shouldContain` "does not exist"
_ -> expectationFailure "Right: Expected EntityNotFound exception"
it "detects general backend issues" $ do
conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
eitherExRes <- update conn article :: IO (Either PersistenceException ())
case eitherExRes of
Left (DatabaseError msg) -> msg `shouldContain` "SqlError"
_ -> expectationFailure "Expected DatabaseError exception"
it "has no leaking backend exceptions" $ do
conn <- connect AutoCommit <$> connectSqlite3 ":memory:"
_ <- update conn article :: IO (Either PersistenceException ())
_ <- insert conn article :: IO (Either PersistenceException Article)
_ <- persist conn article :: IO (Either PersistenceException ())
_ <- delete conn article :: IO (Either PersistenceException ())
_ <- selectById conn "1" :: IO (Either PersistenceException Article)
_ <- select conn allEntries :: IO (Either PersistenceException [Article])
_ <- select conn (yearField =. "2023") :: IO (Either PersistenceException [Article])
_ <- insertMany conn [article] :: IO (Either PersistenceException ())
_ <- updateMany conn [article] :: IO (Either PersistenceException ())
_ <- deleteMany conn [article] :: IO (Either PersistenceException ())
expectationSuccess
it "can find column names" $ do
let columnName = columnNameFor @Article "articleID"
columnName `shouldBe` "articleID"
it "throws an exception when column name is not found" $ do
let columnName = columnNameFor @Article "unknown"
print columnName `shouldThrow` errorCall "columnNameFor: Article has no column mapping for unknown"
it "reports unknown fields" $ do
let index = fieldIndex @Article "unknown"
print index `shouldThrow` errorCall "expectJust Field unknown is not present in type Article"
it "handles duplicate insert exceptions" $ do
handleDuplicateInsert (toException $ EntityNotFound "24" ) `shouldBe` DatabaseError "EntityNotFound \"24\""