Skip to content

Schema generation is broken for composite foreign keys #647

@rdnetto

Description

@rdnetto

Summary

When attempting to use composite foreign keys, persistent will allocate only one column in the table instead of two.

For Sqlite, migration succeeds and entries can be inserted only because foreign key constraints are disabled by default. Once #646 has been merged, it will not be possible to insert anything into the table.

For Postgres, migration fails with the following:

Migrating: CREATe TABLE "person"( PRIMARY KEY ("first_name","surname"),"first_name" VARCHAR NOT NULL,"surname" VARCHAR NOT NULL,"height" DOUBLE PRECISION NOT NULL)
[Debug#SQL] CREATe TABLE "person"( PRIMARY KEY ("first_name","surname"),"first_name" VARCHAR NOT NULL,"surname" VARCHAR NOT NULL,"height" DOUBLE PRECISION NOT NULL); []
Migrating: CREATe TABLE "posession"("id" SERIAL8  PRIMARY KEY UNIQUE,"owner" Composite Reference NOT NULL,"description" VARCHAR NOT NULL)
[Debug#SQL] CREATe TABLE "posession"("id" SERIAL8  PRIMARY KEY UNIQUE,"owner" Composite Reference NOT NULL,"description" VARCHAR NOT NULL); []
PersistentBug.hs: SqlError {sqlState = "42601", sqlExecStatus = FatalError, sqlErrorMsg = "syntax error at or near \"Reference\"", sqlErrorDetail = "", sqlErrorHint = ""}

Expected behaviour

The correct solution for SQL databases would be to allocate a column for each column in the composite key with its own foreign key constraint.

The documentation for the schema syntax says:

Composite key (using multiple columns) can also be defined using Primary (see Primary and Foreign keys.

which suggests to me that this is intended to work.

Workaround

Define a unique constraint over the composite key. This provides the same invariants, but means that retrieving records by the composite key is a bit more involved.

Test case

#!/usr/bin/env stack
-- stack --install-ghc runghc --package persistent --package persistent-sqlite --package persistent-postgresql --package persistent-template

{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStderrLoggingT)
import Database.Persist.TH
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.Postgresql
import Data.Text


connStr = "host=localhost dbname=test user=user123 password=pass123 port=5432"

share [
        mkPersist sqlSettings,
        mkMigrate "migrateAll"
      ] [persistLowerCase|

    Person
        firstName     Text
        surname       Text
        height        Double
        Primary firstName surname
        deriving Eq Show

    Posession
        owner         PersonId
        description   Text
        deriving Eq Show
|]

main2 :: IO ()
main2 = runSqlite "temp.db" $ do
    runMigration migrateAll
    -- TODO: enable FK constraint

    insert_ $ Person "John" "Smith" 123
    insert_ $ Posession (PersonKey "John" "Smith") "Pen"


main :: IO ()
main = runStderrLoggingT $ withPostgresqlPool connStr 1 $ \pool -> liftIO $ do
    flip runSqlPersistMPool pool $ do
        runMigration migrateAll

        insert_ $ Person "John" "Smith" 123
        insert_ $ Posession (PersonKey "John" "Smith") "Pen"

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions