yesodweb / persistent

Persistence interface for Haskell allowing multiple storage methods.
MIT License
465 stars 294 forks source link

"Foreign key mismatch" when using a foreign key referencing a composite primary key #1190

Open anka-213 opened 3 years ago

anka-213 commented 3 years ago

This example gives me an error "foreign key mismatch" at runtime. Have I misinterpreted how to use composite keys or is this a thing one shouldn't do at all?

#!/usr/bin/env stack
-- stack --resolver lts-17.2 script
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

module Main where
import           Control.Monad.IO.Class  (liftIO)
import           Database.Persist
import           Database.Persist.Sqlite
import           Database.Persist.TH

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
    firstName String
    lastName String
    age Int Maybe
    Primary firstName lastName
    deriving Show
BlogPost
    title String
    authorId PersonId
    deriving Show
|]

main :: IO ()
main = runSqlite ":memory:" $ do
    runMigration migrateAll

    johnId <- insert $ Person "John" "Doe" $ Just 35
    insert $ BlogPost "My fr1st p0st" johnId

    return ()

The code above generates the following error when running:

Migrating: CREATE TABLE "person"("name" VARCHAR NOT NULL,"last_name" VARCHAR NOT NULL,"age" INTEGER NULL, PRIMARY KEY ("name","last_name"))
Migrating: CREATE TABLE "blog_post"("id" INTEGER PRIMARY KEY,"title" VARCHAR NOT NULL,"author_id" Composite Reference NOT NULL REFERENCES "person")
persistent-experiments: SQLite3 returned ErrorError while attempting to perform prepare "INSERT INTO \"blog_post\"(\"title\",\"author_id\") VALUES(?,?)": foreign key mismatch - "blog_post" referencing "person"

System info ``` /usr/bin/sw_vers ProductName: Mac OS X ProductVersion: 10.15.7 BuildVersion: 19H2 /Users/anka/.nix-profile/bin/uname Darwin Vingspegeln.local 19.6.0 Darwin Kernel Version 19.6.0: Mon Aug 31 22:12:52 PDT 2020; root:xnu-6153.141.2~1/RELEASE_X86_64 x86_64 i386 MacBookPro16,1 Darwin /Users/anka/.nix-profile/bin/stack Version 2.5.1, Git revision d6ab861544918185236cf826cb2028abb266d6d5 x86_64 hpack-0.33.0 /Users/anka/.nix-profile/bin/stack The Glorious Glasgow Haskell Compilation System, version 8.8.4 /Users/anka/.nix-profile/bin/stack Cabal 3.0.1.0 aeson 1.4.7.1 array 0.5.4.0 async 2.2.2 attoparsec 0.13.2.4 attoparsec-iso8601 1.0.2.0 auto-update 0.1.6 base 4.13.0.0 base-compat 0.11.2 base-compat-batteries 0.11.2 base-orphans 0.8.4 base64-bytestring 1.0.0.3 binary 0.8.7.0 blaze-builder 0.4.1.0 blaze-html 0.9.1.2 blaze-markup 0.8.2.7 bytestring 0.10.10.1 case-insensitive 1.2.1.0 conduit 1.3.4 conduit-extra 1.3.5 containers 0.6.2.1 cookie 0.4.5 data-default-class 0.1.2.0 deepseq 1.4.4.0 directory 1.3.6.0 dlist 0.8.0.8 easy-file 0.2.2 exceptions 0.10.4 fast-logger 3.0.2 filepath 1.4.2.1 ghc-boot-th 8.8.4 ghc-prim 0.5.3 hashable 1.3.0.0 http-api-data 0.4.1.1 http-types 0.12.3 integer-gmp 1.0.2.0 integer-logarithms 1.0.3.1 lifted-base 0.2.3.12 microlens 0.4.11.2 microlens-th 0.4.3.6 monad-control 1.0.2.3 monad-logger 0.3.36 monad-loops 0.4.3 mono-traversable 1.0.15.1 mtl 2.2.2 network 3.1.1.1 old-locale 1.0.0.7 old-time 1.1.0.3 parsec 3.1.14.0 path-pieces 0.2.1 persistent 2.10.5.3 persistent-experiments 0.1.0.0 persistent-sqlite 2.10.6.2 persistent-template 2.8.2.3 pretty 1.1.3.6 primitive 0.7.0.1 process 1.6.9.0 random 1.1 resource-pool 0.2.3.2 resourcet 1.2.4.2 rts 1.0 scientific 0.3.6.2 silently 1.2.5.1 split 0.2.3.4 stm 2.5.0.0 stm-chans 3.0.0.4 streaming-commons 0.2.2.1 tagged 0.8.6.1 template-haskell 2.15.0.0 text 1.2.4.0 th-abstraction 0.3.2.0 th-lift 0.8.2 th-lift-instances 0.1.18 time 1.9.3 time-compat 1.9.5 transformers 0.5.6.2 transformers-base 0.4.5.2 transformers-compat 0.6.6 typed-process 0.2.6.0 unix 2.7.2.2 unix-compat 0.5.2 unix-time 0.4.7 unliftio 0.2.13.1 unliftio-core 0.1.2.0 unordered-containers 0.2.10.0 uuid-types 1.0.3 vector 0.12.1.2 vector-algorithms 0.8.0.4 zlib 0.6.2.2 /usr/bin/sqlite3 3.28.0 2019-04-15 14:49:49 378230ae7f4b721c8b8d83c8ceb891449685cd23b1702a57841f1be40b5daapl ```

As a side note, stack list-dependencies (which is referenced in the issue template) is deprecated and replaced with stack ls dependencies.

anka-213 commented 3 years ago

I managed to solve it with this code. So I guess the only problem is that it wasn't a compile-time error, but I'm not sure how much of a goal that is for this library.

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

module Main where
import           Control.Monad.IO.Class  (liftIO)
import           Database.Persist
import           Database.Persist.Sqlite
import           Database.Persist.TH

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
    firstName String
    lastName String
    age Int Maybe
    Primary firstName lastName
    deriving Show
BlogPost
    title String
    authorFirst String
    authorLast String
    Foreign Person fk_user_email authorFirst authorLast
    deriving Show
|]

main :: IO ()
main = runSqlite ":memory:" $ do
    runMigration migrateAll

    johnId <- insert $ Person "John" "Doe" $ Just 35
    insert $ BlogPost "My fr1st p0st" (personKeyfirstName johnId) (personKeylastName johnId)
    oneJohnPost <- selectList [BlogPostAuthorFirst ==. personKeyfirstName johnId, BlogPostAuthorLast ==. personKeylastName johnId] [LimitTo 1]
    liftIO $ print (oneJohnPost :: [Entity BlogPost])

    john <- get johnId
    liftIO $ print (john :: Maybe Person)

Output:

Migrating: CREATE TABLE "person"("first_name" VARCHAR NOT NULL,"last_name" VARCHAR NOT NULL,"age" INTEGER NULL, PRIMARY KEY ("first_name","last_name"))
Migrating: CREATE TABLE "blog_post"("id" INTEGER PRIMARY KEY,"title" VARCHAR NOT NULL,"author_first" VARCHAR NOT NULL,"author_last" VARCHAR NOT NULL, CONSTRAINT "blog_postfk_user_email" FOREIGN KEY("author_first","author_last") REFERENCES "person"("first_name","last_name"))
[Entity {entityKey = BlogPostKey {unBlogPostKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = BlogPost {blogPostTitle = "My fr1st p0st", blogPostAuthorFirst = "John", blogPostAuthorLast = "Doe"}}]
Just (Person {personFirstName = "John", personLastName = "Doe", personAge = Just 35})