@@ -6,16 +6,21 @@ import Data.Date (canonicalDate)
66import Data.DateTime (DateTime(..))
77import Data.Enum (toEnum)
88import Data.UUID as UUID
9+import JS.BigInt (BigInt)
910import JS.BigInt as JS.BigInt
11+import Data.Number as Number
1012import Data.Maybe (Maybe(..), fromJust, isNothing)
1113import Data.Newtype (class Newtype, un)
1214import Data.Array as Array
1315import Data.Tuple.Nested ((/\))
1416import Data.Time (Time(..))
17+import Data.Time.Duration (Milliseconds(..))
1518import Effect (Effect)
16−import Effect.Aff (Aff, launchAff_)
19+import Effect.Aff (Aff, delay, forkAff, killFiber, launchAff_)
1720import Effect.Class (liftEffect)
18−import Foreign (unsafeToForeign)
21+import Effect.Exception (error)
22+import Effect.Ref as Ref
23+import Foreign (Foreign, unsafeToForeign)
1924import Partial.Unsafe (unsafePartial)
2025import Prim.Boolean (True)
2126import Test.Spec (Spec, around, before, describe, it)
@@ -30,6 +35,8 @@ import Yoga.JSON (class ReadForeign, readImpl, unsafeStringify)
3035import Yoga.SQLite.SQLite as SQLite
3136import Yoga.SQLite.Schema
3237
38+foreign import undefinedValue :: Foreign
39+
3340-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
3441-- Table type definitions
3542-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -61,6 +68,14 @@ type EventsTable = Table "events"
6168eventsTable :: Proxy EventsTable
6269eventsTable = Proxy
6370
71+type NullableJsonTable = Table "nullable_json"
72+ ( id :: Int # PrimaryKey # AutoIncrement
73+ , metadata :: Maybe Json
74+ )
75+
76+nullableJsonTable :: Proxy NullableJsonTable
77+nullableJsonTable = Proxy
78+
6479type PostsTable = Table "posts"
6580 ( id :: Int # PrimaryKey # AutoIncrement
6681 , user_id :: Int # ForeignKey "users" References "id"
@@ -141,11 +156,33 @@ type NullableEverythingTable = Table "nullable_everything"
141156 , active :: Maybe SQLiteBool
142157 )
143158
159+type ScalarBindingsTable = Table "scalar_bindings"
160+ ( id :: Int # PrimaryKey # AutoIncrement
161+ , text_value :: String
162+ , int_value :: Int
163+ , real_value :: Number
164+ , bool_value :: SQLiteBool
165+ , datetime_value :: DateTime
166+ , nullable_value :: Maybe String
167+ )
168+
169+scalarBindingsTable :: Proxy ScalarBindingsTable
170+scalarBindingsTable = Proxy
171+
172+type BigIntBindingsTable = Table "bigint_bindings"
173+ ( id :: Int # PrimaryKey # AutoIncrement
174+ , value :: BigInt
175+ )
176+
177+bigIntBindingsTable :: Proxy BigIntBindingsTable
178+bigIntBindingsTable = Proxy
179+
144180newtype Code = Code String
145181
146182derive instance Newtype Code _
147183derive newtype instance Eq Code
148184derive newtype instance Show Code
185+derive newtype instance SQLite.ToSQLiteValue Code
149186
150187instance SQLiteTypeName Code where
151188 sqliteTypeName _ = "TEXT"
@@ -460,6 +497,9 @@ mkDateTime y m d h mi s = unsafePartial do
460497 let ms = fromJust (toEnum 0)
461498 DateTime (canonicalDate year month day) (Time hour minute second ms)
462499
500+renderJson :: Json -> String
501+renderJson (Json value) = unsafeStringify value
502+
463503-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
464504-- Spec
465505-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -666,6 +706,35 @@ spec = before setupConn do
666706 names `shouldEqual` []
667707 SQLite.close conn # liftEffect
668708
709+ it "rolls back a cancelled transaction and leaves the connection usable" \_ -> do
710+ conn <- withTempDb
711+ SQLite.executeSimple (SQLite.SQL (createTableDDL @UsersTable)) conn # void
712+ wrote <- liftEffect $ Ref.new false
713+ fiber <- forkAff $ SQLite.transaction
714+ (\txn -> do
715+ runExecuteTx txn {}
716+ (from usersTable # insert { name: "Cancelled", email: "cancelled@test.com" })
717+ # void
718+ liftEffect $ Ref.write true wrote
719+ delay (Milliseconds 10000.0)
720+ )
721+ conn
722+ delay (Milliseconds 50.0)
723+ didWrite <- liftEffect $ Ref.read wrote
724+ didWrite `shouldEqual` true
725+ killFiber (error "cancel transaction") fiber
726+ rows <- runQuery conn {} (from usersTable # selectAll)
727+ let names = map (_.name) (rows :: Array { id :: Int, name :: String, email :: String, age :: Maybe Int })
728+ names `shouldEqual` []
729+ SQLite.executeSimple
730+ (SQLite.SQL "INSERT INTO users (name, email) VALUES ('Healthy', 'healthy@test.com')")
731+ conn
732+ # void
733+ healthyRows <- runQuery conn {} (from usersTable # selectAll)
734+ map (_.name) (healthyRows :: Array { id :: Int, name :: String, email :: String, age :: Maybe Int })
735+ `shouldEqual` [ "Healthy" ]
736+ SQLite.close conn # liftEffect
737+
669738 it "queryOne returns Maybe" \conn -> do
670739 SQLite.executeSimple (SQLite.SQL (createTableDDL @UsersTable)) conn # void
671740 runExecute conn {} (from usersTable # insert { name: "Solo", email: "solo@test.com" }) # void
@@ -896,8 +965,169 @@ spec = before setupConn do
896965 it "ForeignKey wrapped newtype survives selectAll typing" \_ -> do
897966 toSQL typedForeignKeyNewtypeSelectAll `shouldEqual` "SELECT * FROM linked_codes"
898967
899− describe "Edge cases" do
900− it "Maybe Just as SQLiteValue passes the inner value" \conn -> do
968+ describe "How to bind values consistently" do
969+ it "uses the same scalar encoding for positional, batch, and migrate statements" \conn -> do
970+ SQLite.executeSimple (SQLite.SQL (createTableDDL @ScalarBindingsTable)) conn # void
971+ let dt1 = mkDateTime 2024 1 2 3 4 5
972+ let dt2 = mkDateTime 2024 2 3 4 5 6
973+ let dt3 = mkDateTime 2024 3 4 5 6 7
974+ SQLite.execute
975+ (SQLite.SQL "INSERT INTO scalar_bindings (text_value, int_value, real_value, bool_value, datetime_value, nullable_value) VALUES (?1, ?2, ?3, ?4, ?5, ?6)")
976+ [ SQLite.toSQLiteValue "positional"
977+ , SQLite.toSQLiteValue 42
978+ , SQLite.toSQLiteValue 1.25
979+ , SQLite.toSQLiteValue true
980+ , SQLite.toSQLiteValue dt1
981+ , SQLite.toSQLiteValue (Just (Just "nested") :: Maybe (Maybe String))
982+ ]
983+ conn # void
984+ SQLite.batch SQLite.Write
985+ [ { sql: "INSERT INTO scalar_bindings (text_value, int_value, real_value, bool_value, datetime_value, nullable_value) VALUES (?1, ?2, ?3, ?4, ?5, ?6)"
986+ , args:
987+ [ SQLite.toSQLiteValue "batch"
988+ , SQLite.toSQLiteValue (-7)
989+ , SQLite.toSQLiteValue 2.5
990+ , SQLite.toSQLiteValue false
991+ , SQLite.toSQLiteValue dt2
992+ , SQLite.toSQLiteValue (Nothing :: Maybe String)
993+ ]
994+ }
995+ ]
996+ conn # void
997+ SQLite.migrate
998+ [ { sql: "INSERT INTO scalar_bindings (text_value, int_value, real_value, bool_value, datetime_value, nullable_value) VALUES (?1, ?2, ?3, ?4, ?5, ?6)"
999+ , args:
1000+ [ SQLite.toSQLiteValue "migrate"
1001+ , SQLite.toSQLiteValue 0
1002+ , SQLite.toSQLiteValue (-3.75)
1003+ , SQLite.toSQLiteValue true
1004+ , SQLite.toSQLiteValue dt3
1005+ , SQLite.toSQLiteValue (Just "value")
1006+ ]
1007+ }
1008+ ]
1009+ conn # void
1010+ rows <- runQuery conn {} (from scalarBindingsTable # selectAll # orderBy @"id")
1011+ let actual = rows :: Array
1012+ { id :: Int
1013+ , text_value :: String
1014+ , int_value :: Int
1015+ , real_value :: Number
1016+ , bool_value :: SQLiteBool
1017+ , datetime_value :: DateTime
1018+ , nullable_value :: Maybe String
1019+ }
1020+ map (_.text_value) actual `shouldEqual` ["positional", "batch", "migrate"]
1021+ map (_.bool_value) actual `shouldEqual` [SQLiteBool true, SQLiteBool false, SQLiteBool true]
1022+ map (_.datetime_value) actual `shouldEqual` [dt1, dt2, dt3]
1023+ map (_.nullable_value) actual `shouldEqual` [Just "nested", Nothing, Just "value"]
1024+
1025+ it "converts typed SET values and named DateTime and Json parameters before binding" \conn -> do
1026+ SQLite.executeSimple (SQLite.SQL (createTableDDL @EventsTable)) conn # void
1027+ let before = mkDateTime 2024 4 5 6 7 8
1028+ let after = mkDateTime 2025 5 6 7 8 9
1029+ let original = unsafeToForeign { version: 1, nested: { ok: false } }
1030+ let replacement = unsafeToForeign { version: 2, nested: { ok: true } }
1031+ runExecute conn {}
1032+ (from eventsTable # insert { title: "before", metadata: Json original, created_at: before }) # void
1033+ changed <- runExecute conn { created_at: before }
1034+ ( from eventsTable
1035+ # set { title: "after", metadata: Json replacement, created_at: after }
1036+ # where_ @"created_at = $created_at"
1037+ )
1038+ changed `shouldEqual` 1
1039+ rows <- runQuery conn { metadata: Json replacement, created_at: after }
1040+ ( from eventsTable
1041+ # select @"title, metadata, created_at"
1042+ # where_ @"metadata = $metadata AND created_at = $created_at"
1043+ )
1044+ let actual = rows :: Array { title :: String, metadata :: Json, created_at :: DateTime }
1045+ map (_.title) actual `shouldEqual` ["after"]
1046+ map (_.created_at) actual `shouldEqual` [after]
1047+ let Json stored = unsafePartial $ fromJust $ map (_.metadata) actual # Array.head
1048+ unsafeStringify stored `shouldEqual` unsafeStringify replacement
1049+ SQLite.executeSimple (SQLite.SQL (createTableDDL @DateTimeTable)) conn # void
1050+ let sqlDate = unsafePartial do
1051+ let year = fromJust (toEnum 2025)
1052+ let month = fromJust (toEnum 5)
1053+ let day = fromJust (toEnum 6)
1054+ SQLDate (canonicalDate year month day)
1055+ let sqlTime = unsafePartial do
1056+ let hour = fromJust (toEnum 7)
1057+ let minute = fromJust (toEnum 8)
1058+ let second = fromJust (toEnum 9)
1059+ let millisecond = fromJust (toEnum 0)
1060+ SQLTime (Time hour minute second millisecond)
1061+ runExecute conn {}
1062+ (from (Proxy :: Proxy DateTimeTable) # insert { date_col: sqlDate, time_col: sqlTime, dt_col: after }) # void
1063+ dateRows <- runQuery conn { date_col: sqlDate, time_col: sqlTime }
1064+ ( from (Proxy :: Proxy DateTimeTable)
1065+ # select @"date_col, time_col"
1066+ # where_ @"date_col = $date_col AND time_col = $time_col"
1067+ )
1068+ let dateValues = dateRows :: Array { date_col :: SQLDate, time_col :: SQLTime }
1069+ map (_.date_col) dateValues `shouldEqual` [sqlDate]
1070+ map (_.time_col) dateValues `shouldEqual` [sqlTime]
1071+
1072+ it "use one ToSQLiteValue instance for typed, named, and positional Maybe Json values" \conn -> do
1073+ SQLite.executeSimple (SQLite.SQL (createTableDDL @NullableJsonTable)) conn # void
1074+ let obj = unsafeToForeign { source: "nested", depth: 2 }
1075+ runExecute conn {} (from nullableJsonTable # insert { metadata: Just (Json obj) }) # void
1076+ SQLite.execute
1077+ (SQLite.SQL "INSERT INTO nullable_json (metadata) VALUES (?1)")
1078+ [ SQLite.toSQLiteValue (Just (Just (Json obj)) :: Maybe (Maybe Json)) ]
1079+ conn # void
1080+ matching <- runQuery conn { metadata: Just (Json obj) }
1081+ (from nullableJsonTable # select @"metadata" # whereRaw @"metadata = $metadata" @(metadata :: Maybe Json) # orderBy @"id")
1082+ let values = map (_.metadata) (matching :: Array { metadata :: Maybe Json })
1083+ Array.length values `shouldEqual` 2
1084+ let serialized = values <#> \value -> case value of
1085+ Nothing -> ""
1086+ Just (Json json) -> unsafeStringify json
1087+ serialized `shouldEqual` [unsafeStringify obj, unsafeStringify obj]
1088+
1089+ it "uses the typed named conversion invariant inside transactions" \_ -> do
1090+ conn <- withTempDb
1091+ SQLite.executeSimple (SQLite.SQL (createTableDDL @EventsTable)) conn # void
1092+ let dt = mkDateTime 2026 6 7 8 9 10
1093+ let obj = unsafeToForeign { transaction: true }
1094+ runExecute conn {} (from eventsTable # insert { title: "tx", metadata: Json obj, created_at: dt }) # void
1095+ txn <- SQLite.begin conn
1096+ changed <- runExecuteTx txn { created_at: dt }
1097+ (from eventsTable # set { title: "updated" } # where_ @"created_at = $created_at")
1098+ changed `shouldEqual` 1
1099+ rows <- runQueryTx txn { metadata: Json obj }
1100+ (from eventsTable # select @"title" # where_ @"metadata = $metadata")
1101+ map (_.title) (rows :: Array { title :: String }) `shouldEqual` ["updated"]
1102+ one <- SQLite.txQueryOne
1103+ (SQLite.SQL "SELECT title FROM events WHERE created_at = ?1")
1104+ [SQLite.toSQLiteValue dt]
1105+ txn
1106+ isNothing one `shouldEqual` false
1107+ SQLite.commit txn
1108+ SQLite.close conn # liftEffect
1109+
1110+ it "accepts signed 64-bit BigInt limits and rejects invalid driver values" \_ -> do
1111+ conn <- liftEffect $ SQLite.sqlite { url: ":memory:", intMode: "bigint" }
1112+ SQLite.executeSimple (SQLite.SQL (createTableDDL @BigIntBindingsTable)) conn # void
1113+ let minInt64 = unsafePartial $ fromJust $ JS.BigInt.fromString "-9223372036854775808"
1114+ let maxInt64 = unsafePartial $ fromJust $ JS.BigInt.fromString "9223372036854775807"
1115+ let belowMin = unsafePartial $ fromJust $ JS.BigInt.fromString "-9223372036854775809"
1116+ let aboveMax = unsafePartial $ fromJust $ JS.BigInt.fromString "9223372036854775808"
1117+ SQLite.execute (SQLite.SQL "INSERT INTO bigint_bindings (value) VALUES (?1), (?2)")
1118+ [SQLite.toSQLiteValue minInt64, SQLite.toSQLiteValue maxInt64] conn # void
1119+ rows <- runQuery conn {} (from bigIntBindingsTable # select @"value" # orderBy @"id")
1120+ map (_.value) (rows :: Array { value :: BigInt }) `shouldEqual` [minInt64, maxInt64]
1121+ expectError $ SQLite.execute (SQLite.SQL "SELECT ?1") [SQLite.toSQLiteValue belowMin] conn
1122+ expectError $ SQLite.execute (SQLite.SQL "SELECT ?1") [SQLite.toSQLiteValue aboveMax] conn
1123+ expectError $ SQLite.execute (SQLite.SQL "SELECT ?1") [SQLite.toSQLiteValue Number.nan] conn
1124+ expectError $ SQLite.execute (SQLite.SQL "SELECT ?1") [SQLite.toSQLiteValue Number.infinity] conn
1125+ expectError $ SQLite.execute (SQLite.SQL "SELECT ?1") [SQLite.toSQLiteValue undefinedValue] conn
1126+ expectError $ SQLite.execute (SQLite.SQL "SELECT ?1") [SQLite.toSQLiteValue (unsafeToForeign { invalid: true })] conn
1127+ SQLite.close conn # liftEffect
1128+
1129+ describe "How to bind application values" do
1130+ it "bind Just through its inner ToSQLiteValue instance" \conn -> do
9011131 SQLite.executeSimple (SQLite.SQL (createTableDDL @UsersTable)) conn # void
9021132 SQLite.execute
9031133 (SQLite.SQL "INSERT INTO users (name, email, age) VALUES (?1, ?2, ?3)")
@@ -910,7 +1140,17 @@ spec = before setupConn do
9101140 let ages = map (_.age) (rows :: Array { id :: Int, name :: String, email :: String, age :: Maybe Int })
9111141 ages `shouldEqual` [Just 42]
9121142
913− it "Boolean round-trip via ToSQLiteValue uses 0/1" \conn -> do
1143+ it "Maybe Json: Just → JSON; Nothing → SQL NULL" \conn -> do
1144+ SQLite.executeSimple (SQLite.SQL (createTableDDL @NullableJsonTable)) conn # void
1145+ let profile = Json $ unsafeToForeign { name: "Ada", roles: [ "admin" ] }
1146+ runExecute conn {} (from nullableJsonTable # insert { metadata: Just profile }) # void
1147+ runExecute conn {} (from nullableJsonTable # insert { metadata: Nothing }) # void
1148+
1149+ rows <- runQuery conn {} (from nullableJsonTable # select @"metadata" # orderBy @"id")
1150+ let metadata = rows <#> \row -> renderJson <$> row.metadata
1151+ metadata `shouldEqual` [ Just (renderJson profile), Nothing ]
1152+
1153+ it "bind Boolean as SQLite integers and decode it as SQLiteBool" \conn -> do
9141154 SQLite.executeSimple (SQLite.SQL (createTableDDL @ConfigTable)) conn # void
9151155 SQLite.execute (SQLite.SQL "INSERT INTO config (active) VALUES (?1)") [ SQLite.toSQLiteValue true ] conn # void
9161156 SQLite.execute (SQLite.SQL "INSERT INTO config (active) VALUES (?1)") [ SQLite.toSQLiteValue false ] conn # void
@@ -949,7 +1189,7 @@ spec = before setupConn do
9491189 r1.lastInsertRowid `shouldEqual` Just (JS.BigInt.fromInt 1)
9501190 r2.lastInsertRowid `shouldEqual` Just (JS.BigInt.fromInt 2)
9511191
952− describe "Evil edge cases" do
1192+ describe "How parameter binding protects SQL and preserves values" do
9531193 it "single quotes in string values don't corrupt SQL" \conn -> do
9541194 SQLite.executeSimple (SQLite.SQL (createTableDDL @UsersTable)) conn # void
9551195 runExecute conn {} (from usersTable # insert { name: "O'Brien", email: "o@b.com" }) # void
@@ -1074,7 +1314,7 @@ spec = before setupConn do
10741314 let lengths = map Array.length (results :: Array (Array { id :: Int, name :: String, email :: String, age :: Maybe Int }))
10751315 lengths `shouldEqual` [1, 1]
10761316
1077− describe "More evil edge cases" do
1317+ describe "Boundary-value behavior" do
10781318 it "MAX_SAFE_INTEGER round-trips as Number" \conn -> do
10791319 SQLite.executeSimple (SQLite.SQL "CREATE TABLE bigints (id INTEGER PRIMARY KEY, val INTEGER NOT NULL)") conn # void
10801320 SQLite.execute (SQLite.SQL "INSERT INTO bigints (val) VALUES (?1)") [SQLite.toSQLiteValue 9007199254740991.0] conn # void
@@ -1305,7 +1545,7 @@ spec = before setupConn do
13051545 let dts = map (_.created_at) (rows :: Array { created_at :: DateTime })
13061546 dts `shouldEqual` [dt]
13071547
1308− it "ForeignKey newtype round-trips without wrapper workaround" \conn -> do
1548+ it "define ToSQLiteValue once for newtypes used as foreign keys" \conn -> do
13091549 SQLite.executeSimple (SQLite.SQL (createTableDDL @CodesTable)) conn # void
13101550 SQLite.executeSimple (SQLite.SQL (createTableDDL @LinkedCodesTable)) conn # void
13111551 runExecute conn {} (from (Proxy :: Proxy CodesTable) # insert { code: Code "alpha" }) # void