-- | Dates a 'Day' cannot hold, such as 0000-00-00, which used to come back
-- clamped to a real date (0000-01-01) and were written back that way.
module ZeroDates (tests) where
import Data.Binary.Parser (parseOnly)
import Data.Binary.Put (runPut)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Time.Calendar (Day)
import Data.Time.LocalTime (TimeOfDay (..))
import Database.MySQL.Field
import Database.MySQL.Protocol.ColumnDef
import Database.MySQL.Protocol.MySQLValue
import Database.MySQL.Protocol.Packet (putLenEncBytes)
import Test.Tasty
import Test.Tasty.HUnit
tests :: TestTree
tests = testGroup "zero dates"
[ testCase "text DATE 0000-00-00" $
assertEqual "value" (Right (MySQLDateRaw (RawDate 0 0 0)))
(parseOnly (getTextField (column mySQLTypeDate)) (lenEnc "0000-00-00"))
, testCase "text DATETIME with a zero day" $
assertEqual "value" (Right (MySQLDateTimeRaw (RawDate 2024 5 0) (TimeOfDay 13 14 15)))
(parseOnly (getTextField (column mySQLTypeDateTime)) (lenEnc "2024-05-00 13:14:15"))
, testCase "binary TIMESTAMP of length 0" $
assertEqual "value" (Right (MySQLTimeStampRaw (RawDate 0 0 0) (TimeOfDay 0 0 0)))
(parseOnly (getBinaryField (column mySQLTypeTimestamp)) "\x00")
, testCase "binary DATE past the end of its month" $
assertEqual "value" (Right (MySQLDateRaw (RawDate 2024 2 30)))
(parseOnly (getBinaryField (column mySQLTypeDate)) "\x04\xE8\x07\x02\x1E")
, testCase "rendered back as the server stored it" $
assertEqual "SQL" "'2024-05-00 13:14:15'"
(runPut (putTextField (MySQLDateTimeRaw (RawDate 2024 5 0) (TimeOfDay 13 14 15))))
, testCase "sent back in binary as the server stored it" $
assertEqual "bytes" "\x04\x00\x00\x00\x00" (runPut (putBinaryField (MySQLDateRaw (RawDate 0 0 0))))
, testCase "decoding one as a Day fails" $
assertEqual "decoded"
(Left (DecodeUnrepresentableDate (ExpectedTypeName "Day") (MySQLDateRaw (RawDate 0 0 0))))
(fromField (MySQLDateRaw (RawDate 0 0 0)) :: Either DecodeError Day)
]
column :: FieldType -> ColumnDef
column fieldType = ColumnDef "" "" "" "" "" 63 0 fieldType 0 0
lenEnc :: B.ByteString -> B.ByteString
lenEnc value = L.toStrict (runPut (putLenEncBytes value))