diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# hpqtypes-extras-1.10.0.0 (2019-11-05) +* Implement `UuidT` Column Type ([#28](https://github.com/scrive/hpqtypes-extras/pull/28)). +* Fix sqlValidateCheck and sqlValidateFK + # hpqtypes-extras-1.9.0.1 (2019-06-04) * Create composite types automatically only if database is empty. diff --git a/hpqtypes-extras.cabal b/hpqtypes-extras.cabal --- a/hpqtypes-extras.cabal +++ b/hpqtypes-extras.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: hpqtypes-extras -version: 1.9.0.1 +version: 1.10.0.0 synopsis: Extra utilities for hpqtypes library description: The following extras for hpqtypes library: . @@ -51,14 +51,14 @@ , Database.PostgreSQL.PQTypes.Utils.NubList build-depends: base >= 4.9 && < 4.13 - , hpqtypes >= 1.7.0.0 && < 1.8.0.0 + , hpqtypes >= 1.8.0.0 && < 1.9.0.0 , base16-bytestring >= 0.1 && < 0.2 , bytestring >= 0.10 && < 0.11 , containers >= 0.5 && < 0.7 , cryptohash >= 0.11 && < 0.12 , exceptions >= 0.10 && < 0.11 , mtl >= 2.2 && < 2.3 - , fields-json >= 0.2 && < 0.3 + , fields-json >= 0.4 && < 0.5 , text >= 1.2 && < 1.3 , lifted-base >= 0.2 && < 0.3 , monad-control >= 1.0 && < 1.1 @@ -109,4 +109,5 @@ tasty, tasty-hunit, text, - transformers + transformers, + uuid-types diff --git a/src/Database/PostgreSQL/PQTypes/Model/Check.hs b/src/Database/PostgreSQL/PQTypes/Model/Check.hs --- a/src/Database/PostgreSQL/PQTypes/Model/Check.hs +++ b/src/Database/PostgreSQL/PQTypes/Model/Check.hs @@ -46,7 +46,7 @@ -- | Validate check previously created as NOT VALID. sqlValidateCheck :: Check -> RawSQL () -sqlValidateCheck Check{..} = "VALIDATE" <+> chkName +sqlValidateCheck Check{..} = "VALIDATE CONSTRAINT" <+> chkName sqlAddCheck_ :: Bool -> Check -> RawSQL () sqlAddCheck_ valid Check{..} = smconcat [ diff --git a/src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs b/src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs --- a/src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs +++ b/src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs @@ -18,6 +18,7 @@ | DateT | DoubleT | IntegerT + | UuidT | IntervalT | JsonT | JsonbT @@ -44,6 +45,7 @@ "date" -> DateT "double precision" -> DoubleT "integer" -> IntegerT + "uuid" -> UuidT "interval" -> IntervalT "json" -> JsonT "jsonb" -> JsonbT @@ -64,6 +66,7 @@ columnTypeToSQL DateT = "DATE" columnTypeToSQL DoubleT = "DOUBLE PRECISION" columnTypeToSQL IntegerT = "INTEGER" +columnTypeToSQL UuidT = "UUID" columnTypeToSQL IntervalT = "INTERVAL" columnTypeToSQL JsonT = "JSON" columnTypeToSQL JsonbT = "JSONB" diff --git a/src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs b/src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs --- a/src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs +++ b/src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs @@ -87,7 +87,7 @@ -- | Validate foreign key previously created as NOT VALID. sqlValidateFK :: RawSQL () -> ForeignKey -> RawSQL () -sqlValidateFK tname fk = "VALIDATE" <+> fkName tname fk +sqlValidateFK tname fk = "VALIDATE CONSTRAINT" <+> fkName tname fk sqlAddFK_ :: Bool -> RawSQL () -> ForeignKey -> RawSQL () sqlAddFK_ valid tname fk@ForeignKey{..} = mconcat [ diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -7,9 +7,9 @@ import Data.Monoid import Prelude -import Data.Int import qualified Data.Text as T import Data.Typeable +import Data.UUID.Types import Database.PostgreSQL.PQTypes import Database.PostgreSQL.PQTypes.Checks @@ -39,7 +39,7 @@ optionHelp = return "Postgres connection string" -- Simple example schemata inspired by the one in --- +-- < http://www.databaseanswers.org/data_models/bank_robberies/index.htm> -- -- Schema 1: Bank robberies, tables: -- bank, bad_guy, robbery, participated_in_robbery, witness, @@ -63,8 +63,9 @@ { tblName = "bank" , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "id", colType = BigSerialT - , colNullable = False } + [ tblColumn { colName = "id", colType = UuidT + , colNullable = False + , colDefault = Just "gen_random_uuid()" } , tblColumn { colName = "name", colType = TextT , colNullable = False } , tblColumn { colName = "location", colType = TextT @@ -140,8 +141,9 @@ { tblName = "bad_guy" , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "id", colType = BigSerialT - , colNullable = False } + [ tblColumn { colName = "id", colType = UuidT + , colNullable = False + , colDefault = Just "gen_random_uuid()" } , tblColumn { colName = "firstname", colType = TextT , colNullable = False } , tblColumn { colName = "lastname", colType = TextT @@ -167,9 +169,10 @@ { tblName = "robbery" , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "id", colType = BigSerialT - , colNullable = False } - , tblColumn { colName = "bank_id", colType = BigIntT + [ tblColumn { colName = "id", colType = UuidT + , colNullable = False + , colDefault = Just "gen_random_uuid()" } + , tblColumn { colName = "bank_id", colType = UuidT , colNullable = False } , tblColumn { colName = "date", colType = DateT , colNullable = False, colDefault = Just "now()" } @@ -195,9 +198,9 @@ { tblName = "participated_in_robbery" , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "bad_guy_id", colType = BigIntT + [ tblColumn { colName = "bad_guy_id", colType = UuidT , colNullable = False } - , tblColumn { colName = "robbery_id", colType = BigIntT + , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } ] , tblPrimaryKey = pkOnColumns ["bad_guy_id", "robbery_id"] @@ -225,8 +228,9 @@ { tblName = tableWitnessName , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "id", colType = BigSerialT - , colNullable = False } + [ tblColumn { colName = "id", colType = UuidT + , colNullable = False + , colDefault = Just "gen_random_uuid()" } , tblColumn { colName = "firstname", colType = TextT , colNullable = False } , tblColumn { colName = "lastname", colType = TextT @@ -243,9 +247,9 @@ { tblName = tableWitnessedRobberyName , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "witness_id", colType = BigIntT + [ tblColumn { colName = "witness_id", colType = UuidT , colNullable = False } - , tblColumn { colName = "robbery_id", colType = BigIntT + , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } ] , tblPrimaryKey = pkOnColumns ["witness_id", "robbery_id"] @@ -261,9 +265,9 @@ { tblName = tableUnderArrestName , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "bad_guy_id", colType = BigIntT + [ tblColumn { colName = "bad_guy_id", colType = UuidT , colNullable = False } - , tblColumn { colName = "robbery_id", colType = BigIntT + , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } , tblColumn { colName = "court_date", colType = DateT , colNullable = False @@ -282,9 +286,9 @@ { tblName = tablePrisonSentenceName , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "bad_guy_id", colType = BigIntT + [ tblColumn { colName = "bad_guy_id", colType = UuidT , colNullable = False } - , tblColumn { colName = "robbery_id", colType = BigIntT + , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } , tblColumn { colName = "sentence_start" , colType = DateT @@ -317,7 +321,7 @@ { tblName = tableFlashName , tblVersion = 1 , tblColumns = - [ tblColumn { colName = "flash_id", colType = BigIntT, colNullable = False } + [ tblColumn { colName = "flash_id", colType = UuidT, colNullable = False } ] } @@ -438,7 +442,7 @@ createTablesSchema1 :: (String -> TestM ()) -> TestM () createTablesSchema1 step = do - let extensions = [] + let extensions = ["pgcrypto"] composites = [] domains = [] step "Creating the database (schema version 1)..." @@ -446,7 +450,7 @@ composites schema1Tables schema1Migrations checkDatabase defaultExtrasOptions composites domains schema1Tables -testDBSchema1 :: (String -> TestM ()) -> TestM ([Int64], [Int64]) +testDBSchema1 :: (String -> TestM ()) -> TestM ([UUID], [UUID]) testDBSchema1 step = do step "Running test queries (schema version 1)..." @@ -460,7 +464,7 @@ , "2/3 Quux Ave., Milton Keynes, UK" , "6600 Sunset Blvd., Los Angeles, CA, USA"] sqlResult "id" - (bankIds :: [Int64]) <- fetchMany runIdentity + (bankIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'bank' table" 5 (length bankIds) -- Populate the 'bad_guy' table. @@ -470,14 +474,14 @@ sqlSetList "lastname" ["Hetzel"::T.Text, "Murray", "Foreman", "Fraser" ,"Crosbie", "Shaw"] sqlResult "id" - (badGuyIds :: [Int64]) <- fetchMany runIdentity + (badGuyIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'bad_guy' table" 6 (length badGuyIds) -- Populate the 'robbery' table. runQuery_ . sqlInsert "robbery" $ do sqlSetList "bank_id" [bankIds !! idx | idx <- [0,3]] sqlResult "id" - (robberyIds :: [Int64]) <- fetchMany runIdentity + (robberyIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'robbery' table" 2 (length robberyIds) -- Populate the 'participated_in_robbery' table. @@ -485,7 +489,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [0,2]] sqlSet "robbery_id" (robberyIds !! 0) sqlResult "bad_guy_id" - (participatorIds :: [Int64]) <- fetchMany runIdentity + (participatorIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'participated_in_robbery' table" 2 (length participatorIds) @@ -493,7 +497,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [3,4]] sqlSet "robbery_id" (robberyIds !! 1) sqlResult "bad_guy_id" - (participatorIds' :: [Int64]) <- fetchMany runIdentity + (participatorIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'participated_in_robbery' table" 2 (length participatorIds') @@ -504,7 +508,7 @@ sqlSetList "lastname" ["Vickers"::T.Text, "Holloway", "Weyland", "Eliott" ,"Wong"] sqlResult "id" - (witnessIds :: [Int64]) <- fetchMany runIdentity + (witnessIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'witness' table" 5 (length witnessIds) -- Populate the 'witnessed_robbery' table. @@ -512,7 +516,7 @@ sqlSetList "witness_id" [witnessIds !! idx | idx <- [0,1]] sqlSet "robbery_id" (robberyIds !! 0) sqlResult "witness_id" - (robberyWitnessIds :: [Int64]) <- fetchMany runIdentity + (robberyWitnessIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'witnessed_robbery' table" 2 (length robberyWitnessIds) @@ -520,7 +524,7 @@ sqlSetList "witness_id" [witnessIds !! idx | idx <- [2,3,4]] sqlSet "robbery_id" (robberyIds !! 1) sqlResult "witness_id" - (robberyWitnessIds' :: [Int64]) <- fetchMany runIdentity + (robberyWitnessIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'witnessed_robbery' table" 3 (length robberyWitnessIds') @@ -528,7 +532,7 @@ migrateDBToSchema2 :: (String -> TestM ()) -> TestM () migrateDBToSchema2 step = do - let extensions = [] + let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 1 -> schema version 2)..." @@ -539,7 +543,7 @@ -- | Hacky version of 'migrateDBToSchema2' used by 'migrationTest3'. migrateDBToSchema2Hacky :: (String -> TestM ()) -> TestM () migrateDBToSchema2Hacky step = do - let extensions = [] + let extensions = ["pgcrypto"] composites = [] domains = [] step "Hackily migrating the database (schema version 1 \ @@ -550,7 +554,7 @@ where schema2Migrations' = createTableMigration tableFlash : schema2Migrations -testDBSchema2 :: (String -> TestM ()) -> [Int64] -> [Int64] -> TestM () +testDBSchema2 :: (String -> TestM ()) -> [UUID] -> [UUID] -> TestM () testDBSchema2 step badGuyIds robberyIds = do step "Running test queries (schema version 2)..." @@ -572,7 +576,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [0,2]] sqlSet "robbery_id" (robberyIds !! 0) sqlResult "bad_guy_id" - (arrestedIds :: [Int64]) <- fetchMany runIdentity + (arrestedIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'under_arrest' table" 2 (length arrestedIds) @@ -580,7 +584,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [3,4]] sqlSet "robbery_id" (robberyIds !! 1) sqlResult "bad_guy_id" - (arrestedIds' :: [Int64]) <- fetchMany runIdentity + (arrestedIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'under_arrest' table" 2 (length arrestedIds') @@ -588,7 +592,7 @@ migrateDBToSchema3 :: (String -> TestM ()) -> TestM () migrateDBToSchema3 step = do - let extensions = [] + let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 2 -> schema version 3)..." @@ -596,7 +600,7 @@ schema3Tables schema3Migrations checkDatabase defaultExtrasOptions composites domains schema3Tables -testDBSchema3 :: (String -> TestM ()) -> [Int64] -> [Int64] -> TestM () +testDBSchema3 :: (String -> TestM ()) -> [UUID] -> [UUID] -> TestM () testDBSchema3 step badGuyIds robberyIds = do step "Running test queries (schema version 3)..." @@ -621,7 +625,7 @@ sqlSet "sentence_length" (12::Int) sqlSet "prison_name" ("Long Kesh"::T.Text) sqlResult "bad_guy_id" - (sentencedIds :: [Int64]) <- fetchMany runIdentity + (sentencedIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'prison_sentence' table" 2 (length sentencedIds) @@ -631,7 +635,7 @@ sqlSet "sentence_length" (9::Int) sqlSet "prison_name" ("Wormwood Scrubs"::T.Text) sqlResult "bad_guy_id" - (sentencedIds' :: [Int64]) <- fetchMany runIdentity + (sentencedIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'prison_sentence' table" 2 (length sentencedIds') @@ -639,7 +643,7 @@ migrateDBToSchema4 :: (String -> TestM ()) -> TestM () migrateDBToSchema4 step = do - let extensions = [] + let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 3 -> schema version 4)..." @@ -664,7 +668,7 @@ migrateDBToSchema5 :: (String -> TestM ()) -> TestM () migrateDBToSchema5 step = do - let extensions = [] + let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 4 -> schema version 5)..." @@ -728,7 +732,7 @@ migrationTest1Body step - freshTestDB step + -- freshTestDB step -- | Test for behaviour of 'checkDatabase' and 'checkDatabaseAllowUnknownObjects' migrationTest2 :: ConnectionSourceM (LogT IO) -> TestTree @@ -741,7 +745,7 @@ let composite = CompositeType { ctName = "composite" , ctColumns = - [ CompositeColumn { ccName = "cint", ccType = BigIntT } + [ CompositeColumn { ccName = "cint", ccType = UuidT } , CompositeColumn { ccName = "ctext", ccType = TextT } ] } @@ -802,7 +806,7 @@ step "Recreating the database (schema version 1, one table is missing PK)..." - migrateDatabase optionsNoPKCheck [] [] [] + migrateDatabase optionsNoPKCheck ["pgcrypto"] [] [] schema1TablesWithMissingPK [schema1MigrationsWithMissingPK] checkDatabase optionsNoPKCheck [] [] withMissingPKSchema