persistent-sqlite 2.13.3.1 can serialize UTCTime values that are not lexicographically ordered

[jonschoning]

since persistent-sqlite 2.13.3.1 serializes UTCTime using %FT%T%QZ, lexicographic ordering becomes incorrect when timestamps are identical up to the second but differ in fractional precision:

a)  2018-12-31T23:47:07Z
b)  2018-12-31T23:47:07.002Z
                       ^

This produces unexpected results when querying UTCTime columns; SQLite compares Z vs ., so it treats a) as greater, even though chronologically it is lesser.

In this case, mixed presence of the fractional part (Z vs .xxxZ) is what breaks ordering, but it can also happen anytime Z is compared with another value, such as

a) 2018-12-31T23:47:07.1Z
b) 2018-12-31T23:47:07.102Z
                        ^

would also exhibit incorrect lexicographic ordering

related: #1585

suggestion: avoid storing the time zone specifier Z, to restore lexicographic ordering. According to https://www.sqlite.org/datatype3.html#date_and_time_datatype , an example ISO8601 string is ("YYYY-MM-DD HH:MM:SS.SSS"), therefore emitting with UTCTime format %FT%T%Q (no Z), should be sufficient. (alternatively, use a fixed-length encoding)

demo below:

cabal-version:       2.4
name:                demo
version:             0.1.0.0
build-type:          Simple

executable demo
  main-is:             Main.hs
  hs-source-dirs:      .
  default-language:    Haskell2010

  build-depends: base >= 4.14 && < 5, persistent, persistent-sqlite == 2.13.3.1, time, text, HUnit

{-# LANGUAGE GHC2024, OverloadedStrings, QuasiQuotes, TemplateHaskell, TypeFamilies, UndecidableInstances #-}

module Main where

import Control.Monad.IO.Class
import Data.Maybe (fromJust)
import Data.Text (Text)
import Data.Time (UTCTime, parseTimeM, defaultTimeLocale, addUTCTime) 
import Database.Persist
import Database.Persist.Sql
import Database.Persist.Sqlite (runSqlite)
import Database.Persist.TH
import Test.HUnit (assertEqual, assertBool)

share
    [mkPersist sqlSettings, mkMigrate "migrateAll"]
    [persistLowerCase|
Thing
    time UTCTime
    deriving Show
|]

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

    let time0 = fromJust $ parseTimeM True defaultTimeLocale "%FT%T%QZ" "2018-12-31T23:47:07Z" :: UTCTime
    let time0plus2ms = addUTCTime 0.002 time0
    liftIO $ putStrLn $ "time0        = " ++ show time0
    liftIO $ putStrLn $ "time0plus2ms = " ++ show time0plus2ms

    _ <- insert (Thing time0)
    _ <- insert (Thing time0plus2ms)
    stored <- rawSql
        "SELECT time FROM thing ORDER BY rowid"
        []
    liftIO $ do
        putStrLn "Stored SQLite values:"
        mapM_ print (stored :: [Single Text])
        putStrLn ""

    liftIO $ putStrLn $ "rowsLtTime0plus2ms <- selectList [ThingTime <. time0plus2ms] []"
    rowsLtTime0plus2ms <- selectList [ThingTime <. time0plus2ms] []
    liftIO $ do
        putStrLn $ "Rows where ThingTime < time0plus2ms: " ++ show (length rowsLtTime0plus2ms)
        mapM_ print rowsLtTime0plus2ms  

    liftIO $ assertBool "(time0 < time0plus2ms)" (time0 < time0plus2ms)
    liftIO $ assertEqual "Expected one row earlier than time0plus2ms" 1 (length rowsLtTime0plus2ms)

$ stack build && stack exec demo
demo> build (exe) with ghc-9.10.3
Preprocessing executable 'demo' for demo-0.1.0.0...
Building executable 'demo' for demo-0.1.0.0...
[1 of 1] Compiling Main [Source file changed]
[2 of 2] Linking .stack-work\dist\1a191874\build\demo\demo.exe [Objects changed]
demo> copy/register
Installing executable demo in C:\dev\repro2\.stack-work\install\b4648b89\bin
Migrating: CREATE TABLE "thing"("id" INTEGER PRIMARY KEY,"time" TIMESTAMP NOT NULL)
time0        = 2018-12-31 23:47:07 UTC
time0plus2ms = 2018-12-31 23:47:07.002 UTC
Stored SQLite values:
Single {unSingle = "2018-12-31T23:47:07Z"}
Single {unSingle = "2018-12-31T23:47:07.002Z"}

ltrows <- selectList [ThingTime <. time0plus2ms] []
Rows where ThingTime < time0plus2ms: 0
demo.EXE: HUnitFailure (Just (SrcLoc {srcLocPackage = "demo-0.1.0.0-HlclNsrU49f7ZwMNbAJYlP-demo", srcLocModule = "Main", srcLocFile = "Main.hs", srcLocStartLine = 61, srcLocStartCol = 14, srcLocEndLine = 61, srcLocEndCol = 25})) (ExpectedButGot (Just "Expected one row earlier than time0plus2ms") "1" "0")