diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,6 @@ +0.3.0: + * Add support for DATETIMEOFFSET + * Add support for text-2.0 0.2.6: * Add support for SQLSTATE * Fix copying issues for error messages diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# odbc [![Build Status](https://travis-ci.org/fpco/odbc.svg)](https://travis-ci.org/fpco/odbc) [![Build status](https://ci.appveyor.com/api/projects/status/vpn6a1pme25upbux?svg=true)](https://ci.appveyor.com/project/chrisdone/odbc-0os0b) +# odbc [![Build Status](https://github.com/fpco/odbc/actions/workflows/workflow.yml/badge.svg?branch=master)](https://github.com/fpco/odbc/actions) [![Build status](https://ci.appveyor.com/api/projects/status/vpn6a1pme25upbux?svg=true)](https://ci.appveyor.com/project/chrisdone/odbc-0os0b) Haskell binding to the ODBC API, with a strong emphasis on stability, testing and simplicity. @@ -7,15 +7,12 @@ The following database drivers are tested against in CI: -* Microsoft SQL Server 2017 +* Microsoft SQL Server 2019 The following operating systems are tested against in CI: * Windows [![Build status](https://ci.appveyor.com/api/projects/status/vpn6a1pme25upbux?svg=true)](https://ci.appveyor.com/project/chrisdone/odbc-0os0b) -* Linux [![Build Status](https://travis-ci.org/fpco/odbc.svg)](https://travis-ci.org/fpco/odbc) - -I develop and test this library on OS X, but currently do not have a -reliable way to run Microsoft SQL Server on Travis CI. +* Linux [![Build Status](https://github.com/fpco/odbc/actions/workflows/workflow.yml/badge.svg?branch=master)](https://github.com/fpco/odbc/actions) ## How ODBC works diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -5,6 +5,9 @@ module Main (main) where +import Data.List +import Data.Time.LocalTime (ZonedTime(..)) +import qualified Data.Text as T import qualified Data.Text.IO as T import Control.Exception import qualified Data.Text as T @@ -90,3 +93,4 @@ ODBC.ByteValue b -> show b ODBC.TimeOfDayValue v -> show v ODBC.LocalTimeValue v -> show v + ODBC.ZonedTimeValue lt tz -> show $ ZonedTime lt tz diff --git a/cbits/odbc.c b/cbits/odbc.c --- a/cbits/odbc.c +++ b/cbits/odbc.c @@ -347,3 +347,59 @@ SQLUINTEGER TIMESTAMP_STRUCT_fraction(TIMESTAMP_STRUCT *t){ return t->fraction; } + +//////////////////////////////////////////////////////////////////////////////// +// Definition and accessors for SQL_SS_TIMESTAMPOFFSET_STRUCT +// The strcut definition is from +// https://docs.microsoft.com/en-us/sql/relational-databases/native-client-odbc-date-time/data-type-support-for-odbc-date-and-time-improvements +typedef struct tagTIMESTAMPOFFSET_STRUCT { + SQLSMALLINT year; + SQLUSMALLINT month; + SQLUSMALLINT day; + SQLUSMALLINT hour; + SQLUSMALLINT minute; + SQLUSMALLINT second; + SQLUINTEGER fraction; + SQLSMALLINT timezone_hour; + SQLSMALLINT timezone_minute; +} TIMESTAMPOFFSET_STRUCT; + +#if (ODBCVER >= 0x0300) + typedef TIMESTAMPOFFSET_STRUCT SQL_SS_TIMESTAMPOFFSET_STRUCT; +#endif + +SQLSMALLINT TIMESTAMPOFFSET_STRUCT_year(TIMESTAMPOFFSET_STRUCT *t){ + return t->year; +} + +SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_month(TIMESTAMPOFFSET_STRUCT *t){ + return t->month; +} + +SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_day(TIMESTAMPOFFSET_STRUCT *t){ + return t->day; +} + +SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_hour(TIMESTAMPOFFSET_STRUCT *t){ + return t->hour; +} + +SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_minute(TIMESTAMPOFFSET_STRUCT *t){ + return t->minute; +} + +SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_second(TIMESTAMPOFFSET_STRUCT *t){ + return t->second; +} + +SQLUINTEGER TIMESTAMPOFFSET_STRUCT_fraction(TIMESTAMPOFFSET_STRUCT *t){ + return t->fraction; +} + +SQLSMALLINT TIMESTAMPOFFSET_STRUCT_timezone_hour(TIMESTAMPOFFSET_STRUCT *t){ + return t->timezone_hour; +} + +SQLSMALLINT TIMESTAMPOFFSET_STRUCT_timezone_minute(TIMESTAMPOFFSET_STRUCT *t){ + return t->timezone_minute; +} diff --git a/odbc.cabal b/odbc.cabal --- a/odbc.cabal +++ b/odbc.cabal @@ -5,7 +5,7 @@ suite runs on OS X, Windows and Linux. copyright: FP Complete 2018 maintainer: chrisdone@fpcomplete.com -version: 0.2.6 +version: 0.3.0 license: BSD3 license-file: LICENSE build-type: Simple @@ -56,6 +56,7 @@ odbc, bytestring, text, + time, optparse-applicative test-suite test diff --git a/src/Database/ODBC/Conversion.hs b/src/Database/ODBC/Conversion.hs --- a/src/Database/ODBC/Conversion.hs +++ b/src/Database/ODBC/Conversion.hs @@ -116,6 +116,12 @@ LocalTimeValue x -> pure (id x) v -> Left ("Expected LocalTime, but got: " ++ show v)) +instance FromValue ZonedTime where + fromValue = + (\case + ZonedTimeValue lt tz -> pure (ZonedTime lt tz) + v -> Left ("Expected ZonedTime, but got: " ++ show v)) + -------------------------------------------------------------------------------- -- Producing rows diff --git a/src/Database/ODBC/Internal.hs b/src/Database/ODBC/Internal.hs --- a/src/Database/ODBC/Internal.hs +++ b/src/Database/ODBC/Internal.hs @@ -11,6 +11,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CPP #-} -- | ODBC database API. -- @@ -62,7 +63,14 @@ import Data.String import Data.Text (Text) import qualified Data.Text as T +#if MIN_VERSION_text(2,0,0) +import qualified Data.ByteString.Internal as SI +import qualified Data.Text.Encoding.Error as T +import qualified Data.Text.Encoding as T +#else import qualified Data.Text.Foreign as T +import Data.Text.Foreign (I16) +#endif import Data.Time import Foreign hiding (void) import Foreign.C @@ -141,6 +149,8 @@ -- ^ Time of day (hh, mm, ss + fractional) values. | LocalTimeValue !LocalTime -- ^ Local date and time. + | ZonedTimeValue !LocalTime !TimeZone + -- ^ Date and time with time zone. | NullValue -- ^ SQL null value. deriving (Eq, Show, Typeable, Ord, Generic, Data) @@ -161,6 +171,7 @@ DayValue x -> hashWithSalt salt (show x) TimeOfDayValue !x -> hashWithSalt salt (show x) LocalTimeValue x -> hashWithSalt salt (show x) + ZonedTimeValue x y -> hashWithSalt salt (show (ZonedTime x y)) NullValue -> hashWithSalt salt () -- | A parameter to a query that corresponds to a ?. @@ -396,7 +407,7 @@ (assertSuccessOrNoData dbc "odbc_SQLExecDirectW" - (T.useAsPtr + (useAsPtrCompat string (\wstring len -> odbc_SQLExecDirectW @@ -446,7 +457,7 @@ go = \case TextParam text -> - T.useAsPtr -- Pass as wide char UTF-16. + useAsPtrCompat -- Pass as wide char UTF-16. text (\ptr len_in_chars -> runBind @@ -585,7 +596,7 @@ -- | Describe the given column by its integer index. describeColumn :: Ptr EnvAndDbc -> SQLHSTMT s -> Int16 -> IO Column describeColumn dbPtr stmt i = - T.useAsPtr + useAsPtrCompat (T.replicate 1000 (fromString "0")) (\namep namelen -> (withMalloc @@ -616,7 +627,7 @@ digits <- peek digitsp isnull <- peek nullp namelen' <- peek namelenp - name <- T.fromPtr namep (fromIntegral namelen') + name <- fromPtrCompat namep (fromIntegral namelen') evaluate Column { columnType = typ @@ -773,6 +784,43 @@ (fmap fromIntegral (odbc_TIME_STRUCT_hour datePtr)) <*> (fmap fromIntegral (odbc_TIME_STRUCT_minute datePtr)) <*> (fmap fromIntegral (odbc_TIME_STRUCT_second datePtr)))) + | colType == sql_ss_timestampoffset -> + withCallocBytes + 20 -- The TIMESTAMPOFFSET_STRUCT contains 3 SQLSMALLINTs, + -- 5 SQLUSMALLINTs, and 1 SQLUINTEGER. These correspond to 3 short + -- ints, 5 unsigned short ints, and 1 unsigned long int. That's + -- 3 * 2 bytes + 5 * 2 bytes + 1 * 4 bytes = 20 bytes. + (\datePtr -> do + mlen <- + getTypedData + dbc + stmt + sql_c_binary + i + (coerce datePtr) + (SQLLEN 20) + case mlen of + Nothing -> pure NullValue + Just {} -> + liftM2 + ZonedTimeValue + (LocalTime <$> + (fromGregorian <$> + (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_year datePtr)) <*> + (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_month datePtr)) <*> + (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_day datePtr))) <*> + (TimeOfDay <$> + (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_hour datePtr)) <*> + (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_minute datePtr)) <*> + (liftM2 (+) + (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_second datePtr)) + (fmap ((/ 1000000000) . fromIntegral) (odbc_TIMESTAMPOFFSET_STRUCT_fraction datePtr))))) + (TimeZone <$> + (liftM2 (+) + (fmap ((* 60) . fromIntegral) (odbc_TIMESTAMPOFFSET_STRUCT_timezone_hour datePtr)) + (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_timezone_minute datePtr))) <*> + pure False <*> + pure "")) | colType == sql_type_timestamp -> withMallocBytes 16 @@ -891,12 +939,13 @@ -- | Get the column's data as a text string. getTextData :: Ptr EnvAndDbc -> SQLHSTMT s -> SQLUSMALLINT -> IO Value getTextData dbc stmt column = do + -- We need to fetch as UTF-16LE (see callsite), then convert to Text mavailableChars <- getSize dbc stmt sql_c_wchar column case mavailableChars of Just 0 -> pure (TextValue mempty) Nothing -> pure NullValue Just availableBytes -> do - let allocBytes = availableBytes + 2 + let allocBytes = availableBytes + 2 -- room for NULL withMallocBytes (fromIntegral allocBytes) (\bufferp -> do @@ -908,7 +957,7 @@ column (coerce bufferp) (SQLLEN (fromIntegral allocBytes))) - t <- T.fromPtr bufferp (fromIntegral (div availableBytes 2)) + t <- fromPtrCompat bufferp (fromIntegral (div availableBytes 2)) let !v = TextValue t pure v) @@ -1073,6 +1122,9 @@ -- https://docs.microsoft.com/en-us/sql/odbc/reference/appendixes/c-data-types data TIMESTAMP_STRUCT +-- https://docs.microsoft.com/en-us/sql/relational-databases/native-client-odbc-date-time/data-type-support-for-odbc-date-and-time-improvements?view=sql-server-2017 +data TIMESTAMPOFFSET_STRUCT + -------------------------------------------------------------------------------- -- Foreign functions @@ -1180,6 +1232,33 @@ foreign import ccall "odbc TIMESTAMP_STRUCT_fraction" odbc_TIMESTAMP_STRUCT_fraction :: Ptr TIMESTAMP_STRUCT -> IO SQLUINTEGER +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_year" odbc_TIMESTAMPOFFSET_STRUCT_year + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLSMALLINT + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_month" odbc_TIMESTAMPOFFSET_STRUCT_month + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_day" odbc_TIMESTAMPOFFSET_STRUCT_day + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_hour" odbc_TIMESTAMPOFFSET_STRUCT_hour + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_minute" odbc_TIMESTAMPOFFSET_STRUCT_minute + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_second" odbc_TIMESTAMPOFFSET_STRUCT_second + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_fraction" odbc_TIMESTAMPOFFSET_STRUCT_fraction + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUINTEGER + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_timezone_hour" odbc_TIMESTAMPOFFSET_STRUCT_timezone_hour + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLSMALLINT + +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_timezone_minute" odbc_TIMESTAMPOFFSET_STRUCT_timezone_minute + :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLSMALLINT + -------------------------------------------------------------------------------- -- Foreign utils @@ -1255,6 +1334,10 @@ sql_ss_time2 :: SQLSMALLINT sql_ss_time2 = -154 +-- ibid. +sql_ss_timestampoffset :: SQLSMALLINT +sql_ss_timestampoffset = -155 + -- sql_datetime :: SQLSMALLINT -- sql_datetime = 9 @@ -1360,3 +1443,38 @@ -- sql_ss_length_unlimited :: SQLULEN sql_ss_length_unlimited = 0 + + +#if MIN_VERSION_text(2,0,0) +type I16 = Int +#endif + +-- FIXME fail with Randomized with seed 1862667972 +-- (on 9.2 as well) + +-------- 'T.fromPtr' but compatible with text v1 and v2 + +fromPtrCompat :: Ptr Word16 -> I16 -> IO Text +#if MIN_VERSION_text(2,0,0) +fromPtrCompat bufferp len16 = do + let lenBytes = len16 * 2 + noFinalizer = return () -- N.B. inner bufferp is 'free'd after this withMallocBytes block + -- invariant: this does no additional allocation + tempBS <- S.unsafePackCStringFinalizer (castPtr bufferp) lenBytes noFinalizer + -- invariant: this makes a copy: + return $! T.decodeUtf16LEWith T.strictDecode tempBS +#else +fromPtrCompat = T.fromPtr +#endif + +useAsPtrCompat :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a +#if MIN_VERSION_text(2,0,0) +useAsPtrCompat t cont16 = do + let (fp8, len8) = SI.toForeignPtr0 $ T.encodeUtf16LE t + fp16 = castForeignPtr fp8 + len16 = len8 `div` 2 + withForeignPtr fp16 $ \p16 -> + cont16 p16 (fromIntegral len16) +#else +useAsPtrCompat = T.useAsPtr +#endif diff --git a/src/Database/ODBC/SQLServer.hs b/src/Database/ODBC/SQLServer.hs --- a/src/Database/ODBC/SQLServer.hs +++ b/src/Database/ODBC/SQLServer.hs @@ -35,6 +35,7 @@ , Internal.Binary(..) , Datetime2(..) , Smalldatetime(..) + , Datetimeoffset(..) -- * Streaming results -- $streaming @@ -271,6 +272,26 @@ { unSmalldatetime :: LocalTime } deriving (Eq, Ord, Show, Typeable, Generic, Data, FromValue) +-- | Use this type to discard the 'timeZoneMinutes' and 'timeZoneName' +-- components of a 'ZonedTime'. +-- +-- +newtype Datetimeoffset = Datetimeoffset + { unDatetimeoffset :: ZonedTime + } deriving (Show, Typeable, Generic, Data, FromValue) + +-- | SQL Server considers two datetimeoffset values to be equal as long as they +-- represent the same instant in time; i.e. they are equavalent to the same UTC +-- time and date. This instance reproduces that behaviour. +instance Eq Datetimeoffset where + Datetimeoffset x == Datetimeoffset y = zonedTimeToUTC x == zonedTimeToUTC y + +-- | SQL Server considers datetimeoffset values to be ordered according to their +-- UTC equivalent values. This instance reproduces that behaviour. +instance Ord Datetimeoffset where + compare (Datetimeoffset x) (Datetimeoffset y) = + compare (zonedTimeToUTC x) (zonedTimeToUTC y) + -------------------------------------------------------------------------------- -- Conversion to SQL @@ -394,6 +415,12 @@ shrink (LocalTime dd (TimeOfDay hh mm _ss)) = LocalTime dd (TimeOfDay hh mm 0) +-- | Corresponds to DATETIMEOFFSET type of SQL Server. The +-- 'timeZoneSummerOnly' and 'timeZoneName' components will be lost when +-- serializing to SQL. +instance ToSql Datetimeoffset where + toSql (Datetimeoffset (ZonedTime lt tzone)) = toSql $ ZonedTimeValue lt tzone + -------------------------------------------------------------------------------- -- Top-level functions @@ -548,6 +575,19 @@ hh mm (renderFractional ss) + ZonedTimeValue (LocalTime d (TimeOfDay hh mm ss)) tzone -> + Formatting.sformat + ("'" % Formatting.dateDash % " " % Formatting.left 2 '0' % ":" % + Formatting.left 2 '0' % + ":" % + Formatting.string % + Formatting.string % + "'") + d + hh + mm + (renderFractional ss) + (renderTimeZone tzone) -- | Obviously, this is not fast. But it is correct. A faster version -- can be written later. @@ -558,6 +598,14 @@ reverse (case dropWhile (== '0') (reverse s) of s'@('.':_) -> '0' : s' s' -> s') + +renderTimeZone :: TimeZone -> String +renderTimeZone (TimeZone 0 _ _) = "Z" +renderTimeZone (TimeZone t _ _) | t < 0 = '-' : renderTimeZone' (negate t) +renderTimeZone (TimeZone t _ _) = '+' : renderTimeZone' t + +renderTimeZone' :: Int -> String +renderTimeZone' t = printf "%02d:%02d" (t `div` 60) (t `mod` 60) -- | A very conservative character escape. escapeChar8 :: Word8 -> Text diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -38,7 +38,7 @@ import Database.ODBC.Conversion (FromValue(..)) import Database.ODBC.Internal (Value (..), Connection, ODBCException(..), Step(..), Binary) import qualified Database.ODBC.Internal as Internal -import Database.ODBC.SQLServer (splitQueryParametrized, joinQueryParametrized, Datetime2(..), Smalldatetime(..), ToSql(..)) +import Database.ODBC.SQLServer (splitQueryParametrized, joinQueryParametrized, Datetime2(..), Datetimeoffset(..), Smalldatetime(..), ToSql(..)) import qualified Database.ODBC.SQLServer as SQLServer import Database.ODBC.TH (partsParser, Part(..)) import System.Environment @@ -149,6 +149,7 @@ quickCheckRoundtrip @Datetime2 "Datetime2" "datetime2" quickCheckRoundtrip @Smalldatetime "Smalldatetime" "smalldatetime" quickCheckRoundtrip @TestDateTime "TestDateTime" "datetime" + quickCheckRoundtrip @Datetimeoffset "Datetimeoffset" "datetimeoffset" quickCheckOneway @TimeOfDay "TimeOfDay" "time" quickCheckRoundtrip @TestTimeOfDay "TimeOfDay" "time" quickCheckRoundtrip @Float "Float" "real" @@ -743,3 +744,13 @@ pure (Smalldatetime (LocalTime day (timeToTimeOfDay (secondsToDiffTime (minutes * 60))))) + +instance Arbitrary Datetimeoffset where + arbitrary = do + lt <- arbitrary + -- Pick a time zone offset between -12 hours and +14 hours. According to + -- https://en.wikipedia.org/wiki/List_of_UTC_time_offsets the lowest offset + -- is -12 hours (at Baker Island and Howland Island), while the highest + -- offset is +14 hours (at Line Islands). + offset <- choose (-12 * 60, 14 * 60) + return $ Datetimeoffset $ ZonedTime lt $ TimeZone offset False ""