beam
beam copied to clipboard
haskell-beam
Postgres migrations aren't idempotent
We've been trying to get migrations working with our beam based project and ran into a problem where initialising an empty database using a CheckedDatabaseSettings based migration and then immediately running the migration a second time causes Beam to try to delete and re-add all the columns:
We have (roughly) the following schema (I've edited it by hand from our app so it may not compile directly - the output from the migration below was produced by our actual app)
V0001.hs
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Database.Schema.V0001 where
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Time (LocalTime)
import Data.UUID (UUID)
import Database.Beam as B
import Database.Beam.Migrate.SQL (DataType)
import Database.Beam.Migrate.SQL.Tables
import Database.Beam.Migrate.Types
import Database.Beam.Postgres
import Database.Beam.Postgres.Syntax (PgDataTypeSyntax)
import Data.Aeson
import Data.Swagger
defaultFieldMaxLength :: Word
defaultFieldMaxLength = 120
type PrimaryKeyType = UUID
pkSerialType :: DataType PgDataTypeSyntax UUID
pkSerialType = uuid
data TheDB f = TheDB
{ _users :: f (TableEntity UserT)
, _businesses :: f (TableEntity BusinessT)
, _keys :: f (TableEntity KeyT)
}
deriving Generic
instance Database anybackend TheDB
migration :: () -> Migration PgCommandSyntax (CheckedDatabaseSettings Postgres TheDB)
migration () = TheDB
<$> createTable "users"
( UserT
(field "user_id" pkSerialType)
(BizId (field "user_biz_id" pkSerialType))
(field "first_name" (varchar (Just defaultFieldMaxLength)) notNull)
(field "last_name" (varchar (Just defaultFieldMaxLength)) notNull)
(field "phone_number" (varchar (Just defaultFieldMaxLength)) notNull)
(field "password_hash" binaryLargeObject notNull)
(field "email_address" (varchar (Just defaultFieldMaxLength)) unique notNull)
)
<*> createTable "businesses"
( BusinessT
(field "business_id" pkSerialType)
(field "biz_name" (varchar (Just defaultFieldMaxLength)) notNull)
(field "biz_function" (varchar (Just defaultFieldMaxLength)) notNull)
(field "biz_site_name" (varchar (Just defaultFieldMaxLength)) notNull)
(field "biz_address" (varchar (Just defaultFieldMaxLength)) notNull)
)
<*> createTable "keys"
( KeyT
(field "key_id" pkSerialType)
(UserId (field "key_user_id" pkSerialType))
(field "key_info" text)
(field "creation_time" timestamptz)
(field "revocation_time" (maybeType timestamptz))
(field "expiration_time" (maybeType timestamptz))
)
type User = UserT Identity
deriving instance Show User
data UserT f = UserT
{ user_id :: C f PrimaryKeyType
, user_biz_id :: PrimaryKey BusinessT f
, first_name :: C f Text
, last_name :: C f Text
, phone_number :: C f Text
, password_hash :: C f ByteString
, email_address :: C f Text
} deriving Generic
type UserID = PrimaryKey UserT Identity
deriving instance Show (PrimaryKey UserT Identity)
instance Beamable UserT
instance Beamable (PrimaryKey UserT)
instance Table UserT where
data PrimaryKey UserT f = UserId (C f PrimaryKeyType)
deriving Generic
primaryKey = UserId . user_id
deriving instance Eq (PrimaryKey UserT Identity)
type Business = BusinessT Identity
deriving instance Show Business
data BusinessT f = BusinessT
{ business_id :: C f PrimaryKeyType
, biz_name :: C f Text
, biz_function :: C f Text
, biz_site_name :: C f Text
, biz_address :: C f Text
} deriving Generic
type BizId = PrimaryKey BusinessT Identity
deriving instance Show (PrimaryKey BusinessT Identity)
instance Beamable BusinessT
instance Beamable (PrimaryKey BusinessT)
instance Table BusinessT where
data PrimaryKey BusinessT f = BizId (C f PrimaryKeyType)
deriving Generic
primaryKey = BizId . business_id
deriving instance Eq (PrimaryKey BusinessT Identity)
type Key = KeyT Identity
deriving instance Show Key
data KeyT f = KeyT
{ key_id :: C f PrimaryKeyType
, key_user_id :: PrimaryKey UserT f
, key_info :: C f Text
, creation_time :: C f LocalTime
, revocation_time :: C f (Maybe LocalTime)
, expiration_time :: C f (Maybe LocalTime)
} deriving Generic
type KeyId = PrimaryKey KeyT Identity
deriving instance Show (PrimaryKey KeyT Identity)
instance Beamable KeyT
instance Beamable (PrimaryKey KeyT)
instance Table KeyT where
data PrimaryKey KeyT f = KeyId (C f PrimaryKeyType)
deriving Generic
primaryKey = KeyId . key_id
deriving instance Eq (PrimaryKey KeyT Identity)
And the following migration:
Schema.hs
module Database.Schema
( module Current
, migration
, db
, checkedDB ) where
-- import Control.Arrow ((>>>))
import Database.Beam (DatabaseSettings)
import Database.Beam.Migrate.Types hiding (migrateScript)
import Database.Beam.Postgres (PgCommandSyntax, Postgres)
import Database.Schema.V0001 as Current hiding (migration)
import qualified Database.Schema.V0001 as V0001 (migration)
-- import qualified Database.Schema.V0002 as V0002 (db, migration)
migration :: MigrationSteps PgCommandSyntax () (CheckedDatabaseSettings Postgres Current.TheDB)
migration = migrationStep "Initial commit" V0001.migration
-- >>> migrationStep """todo comment""" V0002.migration
db :: DatabaseSettings Postgres Current.TheDB
db = unCheckDatabase checkedDB
checkedDB :: CheckedDatabaseSettings Postgres Current.TheDB
checkedDB = evaluateDatabase migration
And the following code to run the migration:
Interactive.hs
{-# LANGUAGE TypeApplications #-}
module Interactive
(runMigrationInteractive) where
import Common.Types
import Database.Schema
import qualified Data.ByteString.Lazy.Char8 as BSL
import Control.Monad.IO.Class (liftIO)
import Control.Lens (view, _1)
import Database.Beam.Migrate.Simple (runSimpleMigration,
simpleMigration)
import Database.Beam.Postgres (Pg, PgCommandSyntax, Postgres)
import Database.Beam.Postgres.Migrate (migrationBackend)
import Database.Beam.Postgres.Syntax (fromPgCommand,
pgRenderSyntaxScript)
runMigrationInteractive ::
(HasConnPool context
, AsSqlError err)
=> context -> IO (Either err ())
runMigrationInteractive context = runAppM context $ runDb $ do
conn <- view _1
liftIO $ do
mcommands <- simpleMigration migrationBackend conn checkedDB
case mcommands of
Nothing -> fail "Something went wrong constructing migration"
Just [] -> putStrLn "Already up to date"
Just commands -> do
mapM_ (BSL.putStrLn . pgRenderSyntaxScript . fromPgCommand) commands
putStrLn "type YES to confirm applying this migration:"
confirm <- getLine
case confirm of
"YES" -> runSimpleMigration
@PgCommandSyntax
@Postgres @_ @Pg
conn commands
_ -> putStrLn "Nothing done."
When executing the migration as follows, I get this output (cleaned for readability):
$ createdb beamBug
$ stack exec theApp -- --conn 'postgresql:///beamBug' initdb
CREATE TABLE "users"
( "user_id" UUID
, "user_biz_id" UUID
, "first_name" VARCHAR(120) NOT NULL
, "last_name" VARCHAR(120) NOT NULL
, "phone_number" VARCHAR(120) NOT NULL
, "password_hash" BYTEA NOT NULL
, "email_address" VARCHAR(120) UNIQUE NOT NULL
, PRIMARY KEY("user_id"))
CREATE TABLE "businesses"
( "business_id" UUID
, "biz_name" VARCHAR(120) NOT NULL
, "biz_function" VARCHAR(120) NOT NULL
, "biz_site_name" VARCHAR(120) NOT NULL
, "biz_address" VARCHAR(120) NOT NULL
, PRIMARY KEY("business_id"))
CREATE TABLE "keys"
( "key_id" UUID
, "key_user_id" UUID
, "key_info" TEXT
, "creation_time" TIMESTAMP WITH TIME ZONE
, "revocation_time" TIMESTAMP WITH TIME ZONE
, "expiration_time" TIMESTAMP WITH TIME ZONE
, PRIMARY KEY("key_id"))
type YES to confirm applying this migration:
YES
Right ()
Running it a second time I get:
stack exec theApp -- -c 'postgresql:///beamBug' initdb
ALTER TABLE "users" ALTER COLUMN "email_address" SET NOT NULL
ALTER TABLE "keys" ALTER COLUMN "key_id" DROP NOT NULL
ALTER TABLE "users" ALTER COLUMN "user_id" DROP NOT NULL
ALTER TABLE "businesses" ALTER COLUMN "business_id" DROP NOT NULL
ALTER TABLE "users" DROP COLUMN "phone_number"
ALTER TABLE "users" ADD COLUMN "phone_number" VARCHAR(120)
ALTER TABLE "users" ALTER COLUMN "phone_number" SET NOT NULL
ALTER TABLE "users" DROP COLUMN "first_name"
ALTER TABLE "users" ADD COLUMN "first_name" VARCHAR(120)
ALTER TABLE "users" ALTER COLUMN "first_name" SET NOT NULL
ALTER TABLE "businesses" DROP COLUMN "biz_site_name"
ALTER TABLE "businesses" ADD COLUMN "biz_site_name" VARCHAR(120)
ALTER TABLE "businesses" ALTER COLUMN "biz_site_name" SET NOT NULL
ALTER TABLE "businesses" DROP COLUMN "biz_function"
ALTER TABLE "businesses" ADD COLUMN "biz_function" VARCHAR(120)
ALTER TABLE "businesses" ALTER COLUMN "biz_function" SET NOT NULL
ALTER TABLE "businesses" DROP COLUMN "biz_name"
ALTER TABLE "businesses" ADD COLUMN "biz_name" VARCHAR(120)
ALTER TABLE "businesses" ALTER COLUMN "biz_name" SET NOT NULL
ALTER TABLE "businesses" DROP COLUMN "biz_address"
ALTER TABLE "businesses" ADD COLUMN "biz_address" VARCHAR(120)
ALTER TABLE "businesses" ALTER COLUMN "biz_address" SET NOT NULL
ALTER TABLE "users" DROP COLUMN "last_name"
ALTER TABLE "users" ADD COLUMN "last_name" VARCHAR(120)
ALTER TABLE "users" ALTER COLUMN "last_name" SET NOT NULL
ALTER TABLE "users" DROP COLUMN "email_address"
ALTER TABLE "users" ADD COLUMN "email_address" VARCHAR(120)
ALTER TABLE "users" ALTER COLUMN "email_address" SET NOT NULL
ALTER TABLE "users" ALTER COLUMN "email_address" SET NOT NULL
type YES to confirm applying this migration:
YES
Left (SqlError {sqlState = "42P16", sqlExecStatus = FatalError
, sqlErrorMsg = "column \"key_id\" is in a primary key"
, sqlErrorDetail = "", sqlErrorHint = ""})
The error from the database seems reasonable to me, what's worrying is that beam isn't recognising that the database should already be exactly the same as what exists. Any help you can offer would be great, we'd like to avoid having to write migrations by hand but it's looking like our best options at the moment.
Yeah, the issue here is that the run* commands in beam-migrate literally run all the commands in the migration. You want beam-migrate to note which migration it left off at and continue from there. This idea is captured in the bringUpToDate functions: https://hackage.haskell.org/package/beam-migrate-0.3.2.1/docs/Database-Beam-Migrate-Simple.html#v:bringUpToDate .
You can see an example in beam-migrate-cli
Argh, I never responses do this... we tried several things and didn't manage to get any of them to work; Beam seemed unable to teak that it didn't actually need to change any of the columns in our tables, so it would always try to make modifications to the database even if the current schema matched the one described.
So I finally had some time to try this out, and have no idea what I'm doing wrong, but bringUpToDate doesn't seem to be that helpful; when I run it on an empty database and give it a MigrationSteps with two steps in it, all it does is add the two beam tables and return Nothing (the docs don't tell me what I should expect in return from bringUpToDate, I was expecting that Just db' would be the CheckedDatabaseSettings i then needed to pass to simpleMigration... or something
@axman6 You might not be running bringUpToDate with the necessary hook to get it to work.
I'm not sure if this is the intended semantics for migrations that create tables, but I had to set runIrreversableHook to return true before mine would work.
@tathougies Could you shed some light on this or am I mistaken?
let upToDateHooks = defaultUpToDateHooks {
runIrreversibleHook = pure True
}
@mrehayden1 Hmm, I'm not in a position to try that out now, but I don't believe that'll fix it. The problem comes from Beam trying to make changes which it should never make, for example this one of the primary key for this table:
ALTER TABLE "businesses" DROP COLUMN "biz_site_name"
ALTER TABLE "businesses" ADD COLUMN "biz_site_name" VARCHAR(120)
which Postgres returns an error for and the migration fails.
You should run bringUpToDate on an empty database. It sounds like you're trying to use it on a database with already existing tables?
What we were trying to do is create a system which could perform migrations, either from an empty database or from one at a previous version.