{-# LANGUAGE MagicHash #-}
{-# LANGUAGE QualifiedDo #-}
-- | Server tokens expressed as sequential reading recipes.
module Hmssql.Tds.Token
  ( Token (..), ColumnInfo (..), columnIsNullable, columnIsLong
  , ResultSetInfo, rsColumns, rsColumnArray, rsColumnCount, rsCells, compileResultSet
  , tokenSizeLimit, lobAllocAhead
  , Done (..), doneMore, doneError, doneInTransaction, doneHasCount
  , doneAttention, doneServerError, EnvChange (..), RoutingInfo (..)
  , ServerMessage (..), LoginAck (..), ReturnValue (..), FeatureAck (..)
  , readToken, readTokenWith, readTokenSkipping, doneOf, isFinalDone, failedDoneOf
  ) where

import Control.Monad (unless, when)
import Data.Bits (testBit, (.&.))
import qualified Data.ByteString as B
import Data.Int (Int32)
import Data.Primitive.SmallArray (SmallArray, smallArrayFromList, sizeofSmallArray)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import Data.Word (Word8, Word16, Word32, Word64)
import Text.Printf (printf)
import GHC.Exts (noinline)
import Hmssql.Internal.Derived
import Hmssql.Tds.Context
import Hmssql.Tds.TypeInfo
import qualified Hmssql.Tds.Parser as P
import qualified Hmssql.Tds.Parser.OutOfLine as O
import qualified Hmssql.Tds.Value as V

-- | A column of a result set, as its COLMETADATA describes it.
data ColumnInfo = ColumnInfo
  { ColumnInfo -> Text
columnName :: !Text
    -- ^ The name, or empty for an unnamed expression.
  , ColumnInfo -> TypeInfo
columnType :: !TypeInfo
    -- ^ The wire type; 'Hmssql.SqlType.columnSqlType' names the SQL type.
  , ColumnInfo -> Word16
columnFlags :: !Word16
    -- ^ MS-TDS 2.2.7.4 Flags: nullable ('columnIsNullable'),
    -- identity, updatable and the rest.
  , ColumnInfo -> Word32
columnUserType :: !Word32
    -- ^ The @UserType@ field: 0x50 for @rowversion@, greater than 0xFF
    -- for alias types, and 0 for other types. An alias ID does not carry
    -- its name; 'columnType' describes its underlying storage type.
  , ColumnInfo -> Maybe [Text]
columnTableName :: !(Maybe [Text])
    -- ^ Only present for @text@, @ntext@ and @image@ columns.
  }

instance Show ColumnInfo where
  showsPrec :: Int -> ColumnInfo -> ShowS
showsPrec Int
p (ColumnInfo Text
a TypeInfo
b Word16
c Word32
e Maybe [Text]
f) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ColumnInfo"#
    [ Addr#
"columnName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"columnType"# Addr# -> TypeInfo -> Field
forall a. Show a => Addr# -> a -> Field
:= TypeInfo
b, Addr#
"columnFlags"# Addr# -> Word16 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word16
c, Addr#
"columnUserType"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
e
    , Addr#
"columnTableName"# Addr# -> Maybe [Text] -> Field
forall a. Show a => Addr# -> a -> Field
:= Maybe [Text]
f
    ]
  {-# OPAQUE showsPrec #-}

instance Eq ColumnInfo where
  ColumnInfo Text
a TypeInfo
b Word16
c Word32
e Maybe [Text]
f == :: ColumnInfo -> ColumnInfo -> Bool
== ColumnInfo Text
a' TypeInfo
b' Word16
c' Word32
e' Maybe [Text]
f' =
    Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& TypeInfo -> TypeInfo -> Bool
forall a. Eq a => a -> a -> Bool
eq TypeInfo
b TypeInfo
b' Bool -> Bool -> Bool
&& Word16
c Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
c' Bool -> Bool -> Bool
&& Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
e' Bool -> Bool -> Bool
&& Maybe [Text] -> Maybe [Text] -> Bool
forall a. Eq a => a -> a -> Bool
eq Maybe [Text]
f Maybe [Text]
f'
  {-# OPAQUE (==) #-}

-- | Whether the column may hold NULL.
columnIsNullable :: ColumnInfo -> Bool
columnIsNullable :: ColumnInfo -> Bool
columnIsNullable ColumnInfo
c = ColumnInfo -> Word16
columnFlags ColumnInfo
c Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x0001 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0

-- | Whether a column's values may be of any length: a @max@ type, @xml@, @json@, a
-- CLR type, or a legacy @text@, @ntext@ or @image@, which arrive in pieces rather
-- than behind a length of at most 8,000 bytes.  Such a column is the one to read
-- with a 'Hmssql.Decoding.FoldingCell' or 'Hmssql.Decoding.streamField'.
columnIsLong :: ColumnInfo -> Bool
columnIsLong :: ColumnInfo -> Bool
columnIsLong ColumnInfo
c = case TypeInfo -> LengthKind
lengthKind (ColumnInfo -> TypeInfo
columnType ColumnInfo
c) of
  LengthKind
Plp -> Bool
True
  LengthKind
LongLen -> Bool
True
  LengthKind
_ -> Bool
False

-- | A result set's columns, prepared once for the rows that follow.
data ResultSetInfo = ResultSetInfo
  { ResultSetInfo -> [ColumnInfo]
rsColumns :: ![ColumnInfo]
    -- ^ The columns, in order.
  , ResultSetInfo -> SmallArray ColumnInfo
rsColumnArray :: !(SmallArray ColumnInfo)
    -- ^ The same, for indexing.
  , ResultSetInfo -> [(Int, ColumnShape)]
rsCells :: ![(Int, V.ColumnShape)]
    -- ^ Each column's index, and how its values are delimited.
  }

-- | How many columns the result set has.
rsColumnCount :: ResultSetInfo -> Int
rsColumnCount :: ResultSetInfo -> Int
rsColumnCount = SmallArray ColumnInfo -> Int
forall a. SmallArray a -> Int
sizeofSmallArray (SmallArray ColumnInfo -> Int)
-> (ResultSetInfo -> SmallArray ColumnInfo) -> ResultSetInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultSetInfo -> SmallArray ColumnInfo
rsColumnArray

-- | Prepare a result set's columns for its rows.
compileResultSet :: [ColumnInfo] -> ResultSetInfo
compileResultSet :: [ColumnInfo] -> ResultSetInfo
compileResultSet [ColumnInfo]
cols = [ColumnInfo]
-> SmallArray ColumnInfo -> [(Int, ColumnShape)] -> ResultSetInfo
ResultSetInfo [ColumnInfo]
cols ([ColumnInfo] -> SmallArray ColumnInfo
forall a. [a] -> SmallArray a
smallArrayFromList [ColumnInfo]
cols) ([Int] -> [ColumnShape] -> [(Int, ColumnShape)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ((ColumnInfo -> ColumnShape) -> [ColumnInfo] -> [ColumnShape]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInfo -> ColumnShape
V.rowShape (TypeInfo -> ColumnShape)
-> (ColumnInfo -> TypeInfo) -> ColumnInfo -> ColumnShape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo -> TypeInfo
columnType) [ColumnInfo]
cols))

-- | Maximum size of metadata tokens, which must not buffer unbounded input.
-- Rows and output parameter values aren't bound by it: they cost their size.
tokenSizeLimit :: Int
tokenSizeLimit :: Int
tokenSizeLimit = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

-- | Default maximum allocation ahead of received value bytes.  A server that
-- declares a value it doesn't send costs this much, not what it declared.
lobAllocAhead :: Int
lobAllocAhead :: Int
lobAllocAhead = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

-- | A DONE, DONEPROC or DONEINPROC token: its status bits, which 'doneMore'
-- and the functions beside it read, the current command, and the row count.
data Done = Done
  { Done -> Word16
doneStatus :: !Word16
  , Done -> Word16
doneCurCmd :: !Word16
  , Done -> Word64
doneRowCount :: !Word64
    -- ^ Only meaningful when 'doneHasCount'.
  }

instance Show Done where
  showsPrec :: Int -> Done -> ShowS
showsPrec Int
p (Done Word16
a Word16
b Word64
c) =
    Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"Done"# [Addr#
"doneStatus"# Addr# -> Word16 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word16
a, Addr#
"doneCurCmd"# Addr# -> Word16 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word16
b, Addr#
"doneRowCount"# Addr# -> Word64 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word64
c]
  {-# OPAQUE showsPrec #-}

instance Eq Done where
  Done Word16
a Word16
b Word64
c == :: Done -> Done -> Bool
== Done Word16
a' Word16
b' Word64
c' = Word16
a Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
a' Bool -> Bool -> Bool
&& Word16
b Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
b' Bool -> Bool -> Bool
&& Word64
c Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
c'
  {-# OPAQUE (==) #-}

-- | The status bits: more results follow; the statement failed; a transaction
-- is open; the row count is meaningful; the statement was canceled by an
-- Attention; and the server failed the request.
doneMore, doneError, doneInTransaction, doneHasCount, doneAttention, doneServerError :: Done -> Bool
doneMore :: Done -> Bool
doneMore Done
d = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Done -> Word16
doneStatus Done
d) Int
0
doneError :: Done -> Bool
doneError Done
d = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Done -> Word16
doneStatus Done
d) Int
1
doneInTransaction :: Done -> Bool
doneInTransaction Done
d = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Done -> Word16
doneStatus Done
d) Int
2
doneHasCount :: Done -> Bool
doneHasCount Done
d = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Done -> Word16
doneStatus Done
d) Int
4
doneAttention :: Done -> Bool
doneAttention Done
d = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Done -> Word16
doneStatus Done
d) Int
5
doneServerError :: Done -> Bool
doneServerError Done
d = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Done -> Word16
doneStatus Done
d) Int
8

-- | Where a routing ENVCHANGE sends the login: the protocol (0 is TCP), the
-- port and the server.
data RoutingInfo = RoutingInfo
  { RoutingInfo -> Word8
routingProtocol :: !Word8
  , RoutingInfo -> Word16
routingPort :: !Word16
  , RoutingInfo -> Text
routingServer :: !Text
  }

instance Show RoutingInfo where
  showsPrec :: Int -> RoutingInfo -> ShowS
showsPrec Int
p (RoutingInfo Word8
a Word16
b Text
c) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"RoutingInfo"#
    [ Addr#
"routingProtocol"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
a, Addr#
"routingPort"# Addr# -> Word16 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word16
b, Addr#
"routingServer"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
c ]
  {-# OPAQUE showsPrec #-}

instance Eq RoutingInfo where
  RoutingInfo Word8
a Word16
b Text
c == :: RoutingInfo -> RoutingInfo -> Bool
== RoutingInfo Word8
a' Word16
b' Text
c' = Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
a' Bool -> Bool -> Bool
&& Word16
b Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
b' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
c Text
c'
  {-# OPAQUE (==) #-}

-- | An ENVCHANGE token: what changed in the session, with the old and the new
-- value where the token carries both.
data EnvChange
  = ECDatabase { EnvChange -> Text
oldValue :: !Text, EnvChange -> Text
newValue :: !Text }
  | ECLanguage { oldValue :: !Text, newValue :: !Text }
  | ECCharacterSet { oldValue :: !Text, newValue :: !Text }
  | ECPacketSize { EnvChange -> Word32
oldSize :: !Word32, EnvChange -> Word32
newSize :: !Word32 }
  | ECUnicodeSortingLocale { newValue :: !Text }
  | ECUnicodeComparisonFlags { newValue :: !Text }
  | ECSqlCollation { EnvChange -> ByteString
oldBytes :: !B.ByteString, EnvChange -> ByteString
newBytes :: !B.ByteString }
  | ECBeginTransaction { EnvChange -> TransactionDescriptor
transaction :: !TransactionDescriptor }
  | ECCommitTransaction { transaction :: !TransactionDescriptor }
  | ECRollbackTransaction { transaction :: !TransactionDescriptor }
  | ECEnlistDtcTransaction { transaction :: !TransactionDescriptor }
  | ECDefectTransaction { transaction :: !TransactionDescriptor }
  | ECMirroringPartner { newValue :: !Text }
  | ECPromoteTransaction { EnvChange -> ByteString
dtcToken :: !B.ByteString }
  | ECTransactionManagerAddress { newBytes :: !B.ByteString }
  | ECTransactionEnded { transaction :: !TransactionDescriptor }
  | ECResetConnectionAck
  | ECUserInstance { newValue :: !Text }
  | ECRouting { EnvChange -> RoutingInfo
routing :: !RoutingInfo }
  | ECUnknown { EnvChange -> Word8
envChangeType :: !Word8, EnvChange -> ByteString
payload :: !B.ByteString }

instance Show EnvChange where
  showsPrec :: Int -> EnvChange -> ShowS
showsPrec Int
p = \case
    ECDatabase Text
a Text
b -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECDatabase"# [Addr#
"oldValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"newValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
b]
    ECLanguage Text
a Text
b -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECLanguage"# [Addr#
"oldValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"newValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
b]
    ECCharacterSet Text
a Text
b -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECCharacterSet"# [Addr#
"oldValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"newValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
b]
    ECPacketSize Word32
a Word32
b -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECPacketSize"# [Addr#
"oldSize"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
a, Addr#
"newSize"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
b]
    ECUnicodeSortingLocale Text
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECUnicodeSortingLocale"# [Addr#
"newValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a]
    ECUnicodeComparisonFlags Text
a ->
      Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECUnicodeComparisonFlags"# [Addr#
"newValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a]
    ECSqlCollation ByteString
a ByteString
b -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECSqlCollation"# [Addr#
"oldBytes"# Addr# -> ByteString -> Field
forall a. Show a => Addr# -> a -> Field
:= ByteString
a, Addr#
"newBytes"# Addr# -> ByteString -> Field
forall a. Show a => Addr# -> a -> Field
:= ByteString
b]
    ECBeginTransaction TransactionDescriptor
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECBeginTransaction"# [Addr#
"transaction"# Addr# -> TransactionDescriptor -> Field
forall a. Show a => Addr# -> a -> Field
:= TransactionDescriptor
a]
    ECCommitTransaction TransactionDescriptor
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECCommitTransaction"# [Addr#
"transaction"# Addr# -> TransactionDescriptor -> Field
forall a. Show a => Addr# -> a -> Field
:= TransactionDescriptor
a]
    ECRollbackTransaction TransactionDescriptor
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECRollbackTransaction"# [Addr#
"transaction"# Addr# -> TransactionDescriptor -> Field
forall a. Show a => Addr# -> a -> Field
:= TransactionDescriptor
a]
    ECEnlistDtcTransaction TransactionDescriptor
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECEnlistDtcTransaction"# [Addr#
"transaction"# Addr# -> TransactionDescriptor -> Field
forall a. Show a => Addr# -> a -> Field
:= TransactionDescriptor
a]
    ECDefectTransaction TransactionDescriptor
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECDefectTransaction"# [Addr#
"transaction"# Addr# -> TransactionDescriptor -> Field
forall a. Show a => Addr# -> a -> Field
:= TransactionDescriptor
a]
    ECMirroringPartner Text
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECMirroringPartner"# [Addr#
"newValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a]
    ECPromoteTransaction ByteString
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECPromoteTransaction"# [Addr#
"dtcToken"# Addr# -> ByteString -> Field
forall a. Show a => Addr# -> a -> Field
:= ByteString
a]
    ECTransactionManagerAddress ByteString
a ->
      Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECTransactionManagerAddress"# [Addr#
"newBytes"# Addr# -> ByteString -> Field
forall a. Show a => Addr# -> a -> Field
:= ByteString
a]
    ECTransactionEnded TransactionDescriptor
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECTransactionEnded"# [Addr#
"transaction"# Addr# -> TransactionDescriptor -> Field
forall a. Show a => Addr# -> a -> Field
:= TransactionDescriptor
a]
    EnvChange
ECResetConnectionAck -> [Char] -> ShowS
showString [Char]
"ECResetConnectionAck"
    ECUserInstance Text
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECUserInstance"# [Addr#
"newValue"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a]
    ECRouting RoutingInfo
a -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECRouting"# [Addr#
"routing"# Addr# -> RoutingInfo -> Field
forall a. Show a => Addr# -> a -> Field
:= RoutingInfo
a]
    ECUnknown Word8
a ByteString
b -> Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ECUnknown"# [Addr#
"envChangeType"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
a, Addr#
"payload"# Addr# -> ByteString -> Field
forall a. Show a => Addr# -> a -> Field
:= ByteString
b]
  {-# OPAQUE showsPrec #-}

instance Eq EnvChange where
  EnvChange
x == :: EnvChange -> EnvChange -> Bool
== EnvChange
y = case (EnvChange
x, EnvChange
y) of
    (ECDatabase Text
a Text
b, ECDatabase Text
a' Text
b') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
b Text
b'
    (ECLanguage Text
a Text
b, ECLanguage Text
a' Text
b') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
b Text
b'
    (ECCharacterSet Text
a Text
b, ECCharacterSet Text
a' Text
b') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
b Text
b'
    (ECPacketSize Word32
a Word32
b, ECPacketSize Word32
a' Word32
b') -> Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
a' Bool -> Bool -> Bool
&& Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
b'
    (ECUnicodeSortingLocale Text
a, ECUnicodeSortingLocale Text
a') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a'
    (ECUnicodeComparisonFlags Text
a, ECUnicodeComparisonFlags Text
a') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a'
    (ECSqlCollation ByteString
a ByteString
b, ECSqlCollation ByteString
a' ByteString
b') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a' Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
b ByteString
b'
    (ECBeginTransaction TransactionDescriptor
a, ECBeginTransaction TransactionDescriptor
a') -> TransactionDescriptor -> TransactionDescriptor -> Bool
forall a. Eq a => a -> a -> Bool
eq TransactionDescriptor
a TransactionDescriptor
a'
    (ECCommitTransaction TransactionDescriptor
a, ECCommitTransaction TransactionDescriptor
a') -> TransactionDescriptor -> TransactionDescriptor -> Bool
forall a. Eq a => a -> a -> Bool
eq TransactionDescriptor
a TransactionDescriptor
a'
    (ECRollbackTransaction TransactionDescriptor
a, ECRollbackTransaction TransactionDescriptor
a') -> TransactionDescriptor -> TransactionDescriptor -> Bool
forall a. Eq a => a -> a -> Bool
eq TransactionDescriptor
a TransactionDescriptor
a'
    (ECEnlistDtcTransaction TransactionDescriptor
a, ECEnlistDtcTransaction TransactionDescriptor
a') -> TransactionDescriptor -> TransactionDescriptor -> Bool
forall a. Eq a => a -> a -> Bool
eq TransactionDescriptor
a TransactionDescriptor
a'
    (ECDefectTransaction TransactionDescriptor
a, ECDefectTransaction TransactionDescriptor
a') -> TransactionDescriptor -> TransactionDescriptor -> Bool
forall a. Eq a => a -> a -> Bool
eq TransactionDescriptor
a TransactionDescriptor
a'
    (ECMirroringPartner Text
a, ECMirroringPartner Text
a') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a'
    (ECPromoteTransaction ByteString
a, ECPromoteTransaction ByteString
a') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a'
    (ECTransactionManagerAddress ByteString
a, ECTransactionManagerAddress ByteString
a') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a'
    (ECTransactionEnded TransactionDescriptor
a, ECTransactionEnded TransactionDescriptor
a') -> TransactionDescriptor -> TransactionDescriptor -> Bool
forall a. Eq a => a -> a -> Bool
eq TransactionDescriptor
a TransactionDescriptor
a'
    (EnvChange
ECResetConnectionAck, EnvChange
ECResetConnectionAck) -> Bool
True
    (ECUserInstance Text
a, ECUserInstance Text
a') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a'
    (ECRouting RoutingInfo
a, ECRouting RoutingInfo
a') -> RoutingInfo -> RoutingInfo -> Bool
forall a. Eq a => a -> a -> Bool
eq RoutingInfo
a RoutingInfo
a'
    (ECUnknown Word8
a ByteString
b, ECUnknown Word8
a' ByteString
b') -> Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
a' Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
b ByteString
b'
    (EnvChange, EnvChange)
_ -> Bool
False
  {-# OPAQUE (==) #-}

-- | A message from the server: an error ('Hmssql.Errors.SqlServerError')
-- or an informational message (@PRINT@ output, a low-severity message;
-- 'Hmssql.Connection.connectOnInfoMessage').
data ServerMessage = ServerMessage
  { ServerMessage -> Int32
msgNumber :: !Int32
    -- ^ The error number (@ERROR_NUMBER()@, @sys.messages@).
  , ServerMessage -> Word8
msgState :: !Word8
    -- ^ The state, which distinguishes the places one error is raised
    -- from.
  , ServerMessage -> Word8
msgClass :: !Word8
    -- ^ Severity. Values above 10 are errors; 20 and above close the
    -- connection.
  , ServerMessage -> Text
msgText :: !Text
  , ServerMessage -> Text
msgServer :: !Text
    -- ^ The server's name (@\@\@SERVERNAME@).
  , ServerMessage -> Text
msgProcedure :: !Text
    -- ^ The procedure the message was raised in, or empty.
  , ServerMessage -> Int32
msgLine :: !Int32
    -- ^ The line in the batch or procedure.
  }

instance Show ServerMessage where
  showsPrec :: Int -> ServerMessage -> ShowS
showsPrec Int
p (ServerMessage Int32
a Word8
b Word8
c Text
e Text
f Text
g Int32
h) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ServerMessage"#
    [ Addr#
"msgNumber"# Addr# -> Int32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Int32
a, Addr#
"msgState"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
b, Addr#
"msgClass"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
c, Addr#
"msgText"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
e, Addr#
"msgServer"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
f
    , Addr#
"msgProcedure"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
g, Addr#
"msgLine"# Addr# -> Int32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Int32
h
    ]
  {-# OPAQUE showsPrec #-}

instance Eq ServerMessage where
  ServerMessage Int32
a Word8
b Word8
c Text
e Text
f Text
g Int32
h == :: ServerMessage -> ServerMessage -> Bool
== ServerMessage Int32
a' Word8
b' Word8
c' Text
e' Text
f' Text
g' Int32
h' =
    Int32
a Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
a' Bool -> Bool -> Bool
&& Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
b' Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
e Text
e' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
f Text
f' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
g Text
g' Bool -> Bool -> Bool
&& Int32
h Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
h'
  {-# OPAQUE (==) #-}

-- | The LOGINACK token: the interface, the TDS version the server chose, and
-- the server's name and version.
data LoginAck = LoginAck
  { LoginAck -> Word8
laInterface :: !Word8
  , LoginAck -> Word32
laTdsVersion :: !Word32
  , LoginAck -> Text
laProgName :: !Text
  , LoginAck -> (Word8, Word8, Word8, Word8)
laProgVersion :: !(Word8, Word8, Word8, Word8)
  }

instance Show LoginAck where
  showsPrec :: Int -> LoginAck -> ShowS
showsPrec Int
p (LoginAck Word8
a Word32
b Text
c (Word8, Word8, Word8, Word8)
e) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"LoginAck"#
    [ Addr#
"laInterface"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
a, Addr#
"laTdsVersion"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
b, Addr#
"laProgName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
c, Addr#
"laProgVersion"# Addr# -> (Word8, Word8, Word8, Word8) -> Field
forall a. Show a => Addr# -> a -> Field
:= (Word8, Word8, Word8, Word8)
e ]
  {-# OPAQUE showsPrec #-}

instance Eq LoginAck where
  LoginAck Word8
a Word32
b Text
c (Word8, Word8, Word8, Word8)
e == :: LoginAck -> LoginAck -> Bool
== LoginAck Word8
a' Word32
b' Text
c' (Word8, Word8, Word8, Word8)
e' = Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
a' Bool -> Bool -> Bool
&& Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
b' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
c Text
c' Bool -> Bool -> Bool
&& (Word8, Word8, Word8, Word8)
-> (Word8, Word8, Word8, Word8) -> Bool
forall a. Eq a => a -> a -> Bool
eq (Word8, Word8, Word8, Word8)
e (Word8, Word8, Word8, Word8)
e'
  {-# OPAQUE (==) #-}

-- | A RETURNVALUE token: an output parameter's value, or a function's return
-- value, after a call.
data ReturnValue = ReturnValue
  { ReturnValue -> Word16
rvOrdinal :: !Word16
  , ReturnValue -> Text
rvName :: !Text
  , ReturnValue -> Word8
rvStatus :: !Word8
  , ReturnValue -> Word32
rvUserType :: !Word32
  , ReturnValue -> Word16
rvFlags :: !Word16
  , ReturnValue -> TypeInfo
rvType :: !TypeInfo
  , ReturnValue -> RawBytes
rvValue :: !RawBytes
  }

instance Show ReturnValue where
  showsPrec :: Int -> ReturnValue -> ShowS
showsPrec Int
p (ReturnValue Word16
a Text
b Word8
c Word32
e Word16
f TypeInfo
g RawBytes
h) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ReturnValue"#
    [ Addr#
"rvOrdinal"# Addr# -> Word16 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word16
a, Addr#
"rvName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
b, Addr#
"rvStatus"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
c, Addr#
"rvUserType"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
e, Addr#
"rvFlags"# Addr# -> Word16 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word16
f
    , Addr#
"rvType"# Addr# -> TypeInfo -> Field
forall a. Show a => Addr# -> a -> Field
:= TypeInfo
g, Addr#
"rvValue"# Addr# -> RawBytes -> Field
forall a. Show a => Addr# -> a -> Field
:= RawBytes
h
    ]
  {-# OPAQUE showsPrec #-}

instance Eq ReturnValue where
  ReturnValue Word16
a Text
b Word8
c Word32
e Word16
f TypeInfo
g RawBytes
h == :: ReturnValue -> ReturnValue -> Bool
== ReturnValue Word16
a' Text
b' Word8
c' Word32
e' Word16
f' TypeInfo
g' RawBytes
h' =
    Word16
a Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
a' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
b Text
b' Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c' Bool -> Bool -> Bool
&& Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
e' Bool -> Bool -> Bool
&& Word16
f Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
f' Bool -> Bool -> Bool
&& TypeInfo -> TypeInfo -> Bool
forall a. Eq a => a -> a -> Bool
eq TypeInfo
g TypeInfo
g' Bool -> Bool -> Bool
&& RawBytes -> RawBytes -> Bool
forall a. Eq a => a -> a -> Bool
eq RawBytes
h RawBytes
h'
  {-# OPAQUE (==) #-}

-- | One acknowledgment of a LOGIN7 feature extension, from a FEATUREEXTACK
-- token.
data FeatureAck = FeatureAck
  { FeatureAck -> Word8
featureId :: !Word8
  , FeatureAck -> ByteString
featureData :: !B.ByteString
  }

instance Show FeatureAck where
  showsPrec :: Int -> FeatureAck -> ShowS
showsPrec Int
p (FeatureAck Word8
a ByteString
b) =
    Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"FeatureAck"# [Addr#
"featureId"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
a, Addr#
"featureData"# Addr# -> ByteString -> Field
forall a. Show a => Addr# -> a -> Field
:= ByteString
b]
  {-# OPAQUE showsPrec #-}

instance Eq FeatureAck where
  FeatureAck Word8
a ByteString
b == :: FeatureAck -> FeatureAck -> Bool
== FeatureAck Word8
a' ByteString
b' = Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
a' Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
b ByteString
b'
  {-# OPAQUE (==) #-}

-- | A token of a response, as 'readToken' reads it.
data Token
  = TColMetaData ![ColumnInfo]        -- ^ 0x81; empty when the server reports no columns
  | TRow !V.Row                         -- ^ 0xD1 ROW or 0xD2 NBCROW; see "Hmssql.Tds.Value"
  | TDone !Done                       -- ^ 0xFD
  | TDoneProc !Done                   -- ^ 0xFE
  | TDoneInProc !Done                 -- ^ 0xFF
  | TEnvChange !EnvChange             -- ^ 0xE3
  | TError !ServerMessage             -- ^ 0xAA
  | TInfo !ServerMessage              -- ^ 0xAB
  | TLoginAck !LoginAck               -- ^ 0xAD
  | TReturnStatus !Int32              -- ^ 0x79
  | TReturnValue !ReturnValue         -- ^ 0xAC
  | TOrder ![Word16]                  -- ^ 0xA9
  | TColInfo !B.ByteString            -- ^ 0xA5, undecoded
  | TTabName !B.ByteString            -- ^ 0xA4, undecoded
  | TFeatureExtAck ![FeatureAck]      -- ^ 0xAE
  | TSessionState !B.ByteString       -- ^ 0xE4, undecoded
  | TFedAuthInfo !B.ByteString        -- ^ 0xEE, undecoded
  | TSspi !B.ByteString               -- ^ 0xED
  | TOffset !Word16 !Word16           -- ^ 0x78

instance Show Token where
  showsPrec :: Int -> Token -> ShowS
showsPrec Int
p = \case
    TColMetaData [ColumnInfo]
a -> Int -> Addr# -> [ColumnInfo] -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TColMetaData"# [ColumnInfo]
a
    TRow Row
a -> Int -> Addr# -> Row -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TRow"# Row
a
    TDone Done
a -> Int -> Addr# -> Done -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TDone"# Done
a
    TDoneProc Done
a -> Int -> Addr# -> Done -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TDoneProc"# Done
a
    TDoneInProc Done
a -> Int -> Addr# -> Done -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TDoneInProc"# Done
a
    TEnvChange EnvChange
a -> Int -> Addr# -> EnvChange -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TEnvChange"# EnvChange
a
    TError ServerMessage
a -> Int -> Addr# -> ServerMessage -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TError"# ServerMessage
a
    TInfo ServerMessage
a -> Int -> Addr# -> ServerMessage -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TInfo"# ServerMessage
a
    TLoginAck LoginAck
a -> Int -> Addr# -> LoginAck -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TLoginAck"# LoginAck
a
    TReturnStatus Int32
a -> Int -> Addr# -> Int32 -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TReturnStatus"# Int32
a
    TReturnValue ReturnValue
a -> Int -> Addr# -> ReturnValue -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TReturnValue"# ReturnValue
a
    TOrder [Word16]
a -> Int -> Addr# -> [Word16] -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TOrder"# [Word16]
a
    TColInfo ByteString
a -> Int -> Addr# -> ByteString -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TColInfo"# ByteString
a
    TTabName ByteString
a -> Int -> Addr# -> ByteString -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TTabName"# ByteString
a
    TFeatureExtAck [FeatureAck]
a -> Int -> Addr# -> [FeatureAck] -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TFeatureExtAck"# [FeatureAck]
a
    TSessionState ByteString
a -> Int -> Addr# -> ByteString -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TSessionState"# ByteString
a
    TFedAuthInfo ByteString
a -> Int -> Addr# -> ByteString -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TFedAuthInfo"# ByteString
a
    TSspi ByteString
a -> Int -> Addr# -> ByteString -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"TSspi"# ByteString
a
    TOffset Word16
a Word16
b -> Int -> Addr# -> [Arg] -> ShowS
showCon Int
p Addr#
"TOffset"# [Word16 -> Arg
forall a. Show a => a -> Arg
Arg Word16
a, Word16 -> Arg
forall a. Show a => a -> Arg
Arg Word16
b]
  {-# OPAQUE showsPrec #-}

instance Eq Token where
  Token
x == :: Token -> Token -> Bool
== Token
y = case (Token
x, Token
y) of
    (TColMetaData [ColumnInfo]
a, TColMetaData [ColumnInfo]
a') -> [ColumnInfo] -> [ColumnInfo] -> Bool
forall a. Eq a => a -> a -> Bool
eq [ColumnInfo]
a [ColumnInfo]
a'
    (TRow Row
a, TRow Row
a') -> Row -> Row -> Bool
forall a. Eq a => a -> a -> Bool
eq Row
a Row
a'
    (TDone Done
a, TDone Done
a') -> Done -> Done -> Bool
forall a. Eq a => a -> a -> Bool
eq Done
a Done
a'
    (TDoneProc Done
a, TDoneProc Done
a') -> Done -> Done -> Bool
forall a. Eq a => a -> a -> Bool
eq Done
a Done
a'
    (TDoneInProc Done
a, TDoneInProc Done
a') -> Done -> Done -> Bool
forall a. Eq a => a -> a -> Bool
eq Done
a Done
a'
    (TEnvChange EnvChange
a, TEnvChange EnvChange
a') -> EnvChange -> EnvChange -> Bool
forall a. Eq a => a -> a -> Bool
eq EnvChange
a EnvChange
a'
    (TError ServerMessage
a, TError ServerMessage
a') -> ServerMessage -> ServerMessage -> Bool
forall a. Eq a => a -> a -> Bool
eq ServerMessage
a ServerMessage
a'
    (TInfo ServerMessage
a, TInfo ServerMessage
a') -> ServerMessage -> ServerMessage -> Bool
forall a. Eq a => a -> a -> Bool
eq ServerMessage
a ServerMessage
a'
    (TLoginAck LoginAck
a, TLoginAck LoginAck
a') -> LoginAck -> LoginAck -> Bool
forall a. Eq a => a -> a -> Bool
eq LoginAck
a LoginAck
a'
    (TReturnStatus Int32
a, TReturnStatus Int32
a') -> Int32
a Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
a'
    (TReturnValue ReturnValue
a, TReturnValue ReturnValue
a') -> ReturnValue -> ReturnValue -> Bool
forall a. Eq a => a -> a -> Bool
eq ReturnValue
a ReturnValue
a'
    (TOrder [Word16]
a, TOrder [Word16]
a') -> [Word16] -> [Word16] -> Bool
forall a. Eq a => a -> a -> Bool
eq [Word16]
a [Word16]
a'
    (TColInfo ByteString
a, TColInfo ByteString
a') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a'
    (TTabName ByteString
a, TTabName ByteString
a') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a'
    (TFeatureExtAck [FeatureAck]
a, TFeatureExtAck [FeatureAck]
a') -> [FeatureAck] -> [FeatureAck] -> Bool
forall a. Eq a => a -> a -> Bool
eq [FeatureAck]
a [FeatureAck]
a'
    (TSessionState ByteString
a, TSessionState ByteString
a') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a'
    (TFedAuthInfo ByteString
a, TFedAuthInfo ByteString
a') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a'
    (TSspi ByteString
a, TSspi ByteString
a') -> ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
eq ByteString
a ByteString
a'
    (TOffset Word16
a Word16
b, TOffset Word16
a' Word16
b') -> Word16
a Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
a' Bool -> Bool -> Bool
&& Word16
b Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
b'
    (Token, Token)
_ -> Bool
False
  {-# OPAQUE (==) #-}

-- | The DONE, DONEPROC or DONEINPROC a token is, if it is flagged as
-- failed (DONE_ERROR or DONE_SRVERROR).  In a response with no ERROR token
-- that is all the server says of a failed request
-- ('Hmssql.Errors.SevereError').
doneOf :: Token -> Maybe Done
doneOf :: Token -> Maybe Done
doneOf (TDone Done
d) = Done -> Maybe Done
forall a. a -> Maybe a
Just Done
d
doneOf (TDoneProc Done
d) = Done -> Maybe Done
forall a. a -> Maybe a
Just Done
d
doneOf (TDoneInProc Done
d) = Done -> Maybe Done
forall a. a -> Maybe a
Just Done
d
doneOf Token
_ = Maybe Done
forall a. Maybe a
Nothing

failedDoneOf :: Token -> Maybe Done
failedDoneOf :: Token -> Maybe Done
failedDoneOf Token
token = case Token -> Maybe Done
doneOf Token
token of
  Just Done
d | Done -> Bool
doneError Done
d Bool -> Bool -> Bool
|| Done -> Bool
doneServerError Done
d -> Done -> Maybe Done
forall a. a -> Maybe a
Just Done
d
  Maybe Done
_ -> Maybe Done
forall a. Maybe a
Nothing

-- | A DONE-family token without MORE ends the response.
isFinalDone :: Token -> Bool
isFinalDone :: Token -> Bool
isFinalDone = Bool -> (Done -> Bool) -> Maybe Done -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> (Done -> Bool) -> Done -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Done -> Bool
doneMore) (Maybe Done -> Bool) -> (Token -> Maybe Done) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Maybe Done
doneOf

-- | One token as a recipe, given the current result set's columns.  It reads
-- from the parser's input and suspends when that runs out, so nothing here knows
-- about packets, sessions or the end of a message.
readToken :: Maybe ResultSetInfo -> P.Parser Token
readToken :: Maybe ResultSetInfo -> Parser Token
readToken = Int -> Maybe ResultSetInfo -> Parser Token
readTokenWith Int
lobAllocAhead

-- | 'readToken' with the bound on allocating ahead of a value's bytes.
readTokenWith :: Int -> Maybe ResultSetInfo -> P.Parser Token
readTokenWith :: Int -> Maybe ResultSetInfo -> Parser Token
readTokenWith Int
ahead = ValueMode -> Maybe ResultSetInfo -> Parser Token
tokenWith (Int -> ValueMode
AssembleValues Int
ahead)

-- | 'readToken' for a drain, which skips values rather than assembling them.
readTokenSkipping :: Maybe ResultSetInfo -> P.Parser Token
readTokenSkipping :: Maybe ResultSetInfo -> Parser Token
readTokenSkipping = ValueMode -> Maybe ResultSetInfo -> Parser Token
tokenWith ValueMode
SkipValues

-- Whether values become bytes or are read past.  One definition of each wire form
-- serves ordinary reads and drains; a drain just asks for less.
data ValueMode = AssembleValues !Int | SkipValues

-- The rows are the tokens that come by the thousand, so 'tokenWith' reads the token
-- byte and the ROW and NBCROW bodies with the inlined binds, and everything else is
-- 'otherToken', a call.  With every token in the one case, each token, a row
-- included, allocated the closures of the other tokens' alternatives (the value
-- continuation of RETURNVALUE among them), because they were let-bound around the
-- continuation of the token byte; and RETURNVALUE's value read, a whole 'V.cellHead',
-- was inlined into that continuation.  Split, a row token allocates 96 bytes less
-- (Decode's token benchmarks, 2026-11-04).  Putting the case on the columns before
-- the bind, with NBCROW's body out of line, allocated 16 bytes more per ROW and 56
-- more per NBCROW, because the NBCROW recipe was then a thunk per token.
tokenWith :: ValueMode -> Maybe ResultSetInfo -> P.Parser Token
tokenWith :: ValueMode -> Maybe ResultSetInfo -> Parser Token
tokenWith ValueMode
mode Maybe ResultSetInfo
currentColumns = Parser Word8
P.word8 Parser Word8 -> (Word8 -> Parser Token) -> Parser Token
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Word8
0xD1 -> (ResultSetInfo -> Parser Token) -> Parser Token
forall {m :: * -> *} {a}.
MonadFail m =>
(ResultSetInfo -> m a) -> m a
withColumns (ValueMode -> ByteString -> ResultSetInfo -> Parser Token
readRowBody ValueMode
mode ByteString
B.empty)
  Word8
0xD2 -> (ResultSetInfo -> Parser Token) -> Parser Token
forall {m :: * -> *} {a}.
MonadFail m =>
(ResultSetInfo -> m a) -> m a
withColumns (ValueMode -> ResultSetInfo -> Parser Token
readNbcRow ValueMode
mode)
  Word8
code -> ValueMode -> Word8 -> Parser Token
otherToken ValueMode
mode Word8
code
  where
    withColumns :: (ResultSetInfo -> m a) -> m a
withColumns ResultSetInfo -> m a
k = case Maybe ResultSetInfo
currentColumns of
      Maybe ResultSetInfo
Nothing -> [Char] -> m a
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"readToken: ROW token received before COLMETADATA"
      Just ResultSetInfo
cols -> ResultSetInfo -> m a
k ResultSetInfo
cols

readNbcRow :: ValueMode -> ResultSetInfo -> P.Parser Token
readNbcRow :: ValueMode -> ResultSetInfo -> Parser Token
readNbcRow ValueMode
mode ResultSetInfo
info = do
  bitmap <- Int -> Parser ByteString
P.boundedBytes ((ResultSetInfo -> Int
rsColumnCount ResultSetInfo
info Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
  readRowBody mode bitmap info

-- Only 'TRow' readers come here, not typed rows.  A value can turn out
-- discarded when a drain takes over a row already being read, and the later
-- cells are then skipped; the drain doesn't look at the short row it gets.
--
-- 'go' builds the rest of the row's recipe as it reads, and each step runs once, so
-- it is a 'P.oneShotRecipe'.  Without it, GHC gave 'go' arity 2: each cell built a
-- thunk of its delimiter's recipe, two thunks of the rest of the row, and the bind's
-- continuations, and then ran them.  Measured on 2026-11-04 with GHC 9.12.4: about
-- 390 bytes less per row of two columns (Decode int bigint x10000.tokens 13,795,596
-- bytes to 9,881,849, nullable no NULL ROW of five 28,927,504 to 21,255,502), and the
-- Decode token benchmarks of 10,000 rows 0.64 to 0.73 in time against 997107d.
readRowBody :: ValueMode -> B.ByteString -> ResultSetInfo -> P.Parser Token
readRowBody :: ValueMode -> ByteString -> ResultSetInfo -> Parser Token
readRowBody ValueMode
mode ByteString
bitmap ResultSetInfo
info = Row -> Token
TRow (Row -> Token) -> ([RawBytes] -> Row) -> [RawBytes] -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RawBytes] -> Row
V.rowFromValues ([RawBytes] -> Token) -> Recipe () [RawBytes] -> Parser Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [(Int, ColumnShape)] -> Recipe () [RawBytes]
go (case ValueMode
mode of ValueMode
SkipValues -> Bool
True; ValueMode
_ -> Bool
False) (ResultSetInfo -> [(Int, ColumnShape)]
rsCells ResultSetInfo
info)
  where
    go :: Bool -> [(Int, ColumnShape)] -> Recipe () [RawBytes]
go Bool
_ [] = [RawBytes] -> Recipe () [RawBytes]
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go Bool
discarding ((Int
i, ColumnShape
shape) : [(Int, ColumnShape)]
later) = Recipe () [RawBytes] -> Recipe () [RawBytes]
forall env a. Recipe env a -> Recipe env a
P.oneShotRecipe (Recipe () [RawBytes] -> Recipe () [RawBytes])
-> Recipe () [RawBytes] -> Recipe () [RawBytes]
forall a b. (a -> b) -> a -> b
$ do
      cell <- ByteString -> Int -> ColumnShape -> Parser Cell
V.cellAt ByteString
bitmap Int
i ColumnShape
shape
      if discarding then V.skipValue cell >> go True later else do
        value <- V.wholeValueBytes (case mode of AssembleValues Int
ahead -> Int
ahead; ValueMode
SkipValues -> Int
0) cell
        case value of
          WholeValue
V.DiscardedValue -> Bool -> [(Int, ColumnShape)] -> Recipe () [RawBytes]
go Bool
True [(Int, ColumnShape)]
later
          WholeValue
V.NullValue -> (RawBytes
forall a. Maybe a
Nothing RawBytes -> [RawBytes] -> [RawBytes]
forall a. a -> [a] -> [a]
:) ([RawBytes] -> [RawBytes])
-> Recipe () [RawBytes] -> Recipe () [RawBytes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [(Int, ColumnShape)] -> Recipe () [RawBytes]
go Bool
False [(Int, ColumnShape)]
later
          V.PresentValue ValueBytes
bytes -> (ByteString -> RawBytes
forall a. a -> Maybe a
Just (ValueBytes -> ByteString
P.keepBytes ValueBytes
bytes) RawBytes -> [RawBytes] -> [RawBytes]
forall a. a -> [a] -> [a]
:) ([RawBytes] -> [RawBytes])
-> Recipe () [RawBytes] -> Recipe () [RawBytes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [(Int, ColumnShape)] -> Recipe () [RawBytes]
go Bool
False [(Int, ColumnShape)]
later

-- | Every token but the rows, after its token byte.
otherToken :: ValueMode -> Word8 -> P.Parser Token
otherToken :: ValueMode -> Word8 -> Parser Token
otherToken ValueMode
mode = \case
  Word8
0x81 -> [ColumnInfo] -> Token
TColMetaData ([ColumnInfo] -> Token) -> Recipe () [ColumnInfo] -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () [ColumnInfo]
readColMetaData
  Word8
0xFD -> Done -> Token
TDone (Done -> Token) -> Recipe () Done -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () Done
readDone
  Word8
0xFE -> Done -> Token
TDoneProc (Done -> Token) -> Recipe () Done -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () Done
readDone
  Word8
0xFF -> Done -> Token
TDoneInProc (Done -> Token) -> Recipe () Done -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () Done
readDone
  Word8
0xE3 -> EnvChange -> Token
TEnvChange (EnvChange -> Token) -> Recipe () EnvChange -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () EnvChange
readEnvChange
  Word8
0xAA -> ServerMessage -> Token
TError (ServerMessage -> Token) -> Recipe () ServerMessage -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () ServerMessage
readServerMessage
  Word8
0xAB -> ServerMessage -> Token
TInfo (ServerMessage -> Token) -> Recipe () ServerMessage -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () ServerMessage
readServerMessage
  Word8
0xAD -> LoginAck -> Token
TLoginAck (LoginAck -> Token) -> Recipe () LoginAck -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () LoginAck
readLoginAck
  Word8
0x79 -> Int32 -> Token
TReturnStatus (Int32 -> Token) -> Recipe () Int32 -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Recipe () Word32 -> Recipe () Int32
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () Word32
O.word32le)
  Word8
0xAC -> ReturnValue -> Token
TReturnValue (ReturnValue -> Token) -> Recipe () ReturnValue -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> ValueMode -> Recipe () ReturnValue
readReturnValue ValueMode
mode
  Word8
0xA9 -> O.do
    -- A USHORT column number per ORDER BY column.
    len <- Parser Word16
O.word16le
    when (odd len) $ fail $ "readToken: ORDER token of odd length " ++ show len
    TOrder O.<$> P.count (fromIntegral len `div` 2) O.word16le
  Word8
0xA5 -> ByteString -> Token
TColInfo (ByteString -> Token) -> Parser ByteString -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Parser ByteString
lengthPrefixed16
  Word8
0xA4 -> ByteString -> Token
TTabName (ByteString -> Token) -> Parser ByteString -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Parser ByteString
lengthPrefixed16
  Word8
0xAE -> [FeatureAck] -> Token
TFeatureExtAck ([FeatureAck] -> Token) -> Recipe () [FeatureAck] -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () [FeatureAck]
readFeatureExtAck
  Word8
0xE4 -> ByteString -> Token
TSessionState (ByteString -> Token) -> Parser ByteString -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Parser ByteString
lengthPrefixed32
  Word8
0xEE -> ByteString -> Token
TFedAuthInfo (ByteString -> Token) -> Parser ByteString -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Parser ByteString
lengthPrefixed32
  Word8
0xED -> ByteString -> Token
TSspi (ByteString -> Token) -> Parser ByteString -> Parser Token
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Parser ByteString
lengthPrefixed16
  Word8
0x78 -> Word16 -> Word16 -> Token
TOffset (Word16 -> Word16 -> Token)
-> Parser Word16 -> Recipe () (Word16 -> Token)
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Parser Word16
O.word16le Recipe () (Word16 -> Token) -> Parser Word16 -> Parser Token
forall env a b. Recipe env (a -> b) -> Recipe env a -> Recipe env b
O.<*> Parser Word16
O.word16le
  Word8
0x88 -> [Char] -> Parser Token
forall a. [Char] -> Recipe () a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"readToken: ALTMETADATA (COMPUTE BY) is not supported"
  Word8
0xD3 -> [Char] -> Parser Token
forall a. [Char] -> Recipe () a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"readToken: ALTROW (COMPUTE BY) is not supported"
  Word8
code -> [Char] -> Parser Token
forall a. [Char] -> Recipe () a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Token) -> [Char] -> Parser Token
forall a b. (a -> b) -> a -> b
$ [Char]
"readToken: unknown token 0x" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> Word8 -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%02x" Word8
code
  where
    lengthPrefixed16 :: Parser ByteString
lengthPrefixed16 = Parser Word16
O.word16le Parser Word16 -> (Word16 -> Parser ByteString) -> Parser ByteString
forall env a b. Recipe env a -> (a -> Recipe env b) -> Recipe env b
O.>>= (Int -> Int -> Parser ByteString
P.ownedBytes Int
lobAllocAhead) (Int -> Parser ByteString)
-> (Word16 -> Int) -> Word16 -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    lengthPrefixed32 :: Parser ByteString
lengthPrefixed32 = Recipe () Word32
O.word32le Recipe () Word32
-> (Word32 -> Parser ByteString) -> Parser ByteString
forall env a b. Recipe env a -> (a -> Recipe env b) -> Recipe env b
O.>>= (Int -> Int -> Parser ByteString
P.ownedBytes Int
lobAllocAhead) (Int -> Parser ByteString)
-> (Word32 -> Int) -> Word32 -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# NOINLINE otherToken #-}

readColMetaData :: P.Parser [ColumnInfo]
readColMetaData :: Recipe () [ColumnInfo]
readColMetaData = O.do
  count <- Parser Word16
O.word16le
  if count == 0xFFFF
    then pure []
    else P.count (fromIntegral count) $ O.do
      columnUserType <- O.word32le
      columnFlags <- O.word16le
      columnType <- readTypeInfo
      columnTableName <- case columnType of
        TIText{} -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> Recipe () [Text] -> Recipe () (Maybe [Text])
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () [Text]
getMultiPartName
        TINText{} -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> Recipe () [Text] -> Recipe () (Maybe [Text])
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () [Text]
getMultiPartName
        TIImage{} -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> Recipe () [Text] -> Recipe () (Maybe [Text])
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () [Text]
getMultiPartName
        TypeInfo
_ -> Maybe [Text] -> Recipe () (Maybe [Text])
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Text]
forall a. Maybe a
Nothing
      columnName <- P.bVarChar
      pure ColumnInfo{..}
  where
    getMultiPartName :: Recipe () [Text]
getMultiPartName = O.do
      parts <- Parser Word8
O.word8
      P.count (fromIntegral parts) P.usVarChar

readDone :: P.Parser Done
readDone :: Recipe () Done
readDone = Word16 -> Word16 -> Word64 -> Done
Done (Word16 -> Word16 -> Word64 -> Done)
-> Parser Word16 -> Recipe () (Word16 -> Word64 -> Done)
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Parser Word16
O.word16le Recipe () (Word16 -> Word64 -> Done)
-> Parser Word16 -> Recipe () (Word64 -> Done)
forall env a b. Recipe env (a -> b) -> Recipe env a -> Recipe env b
O.<*> Parser Word16
O.word16le Recipe () (Word64 -> Done) -> Recipe () Word64 -> Recipe () Done
forall env a b. Recipe env (a -> b) -> Recipe env a -> Recipe env b
O.<*> Recipe () Word64
O.word64le

-- 'P.isolate' takes the token's declared length as a sub-envelope, so its fields
-- can't read past it and leftover bytes are an error.  'P.limited' (which the
-- driver puts around metadata tokens) is different: it bounds what is received,
-- for tokens with no length of their own such as COLMETADATA.
readServerMessage :: P.Parser ServerMessage
readServerMessage :: Recipe () ServerMessage
readServerMessage = O.do
  len <- Parser Word16
O.word16le
  P.isolate (fromIntegral len) $
    ServerMessage
      O.<$> (fromIntegral O.<$> O.word32le)
      O.<*> O.word8
      O.<*> O.word8
      O.<*> P.usVarChar
      O.<*> P.bVarChar
      O.<*> P.bVarChar
      O.<*> (fromIntegral O.<$> O.word32le)

readLoginAck :: P.Parser LoginAck
readLoginAck :: Recipe () LoginAck
readLoginAck = O.do
  len <- Parser Word16
O.word16le
  P.isolate (fromIntegral len) $ O.do
    laInterface <- O.word8
    laTdsVersion <- O.word32be
    -- SQL Server pads the name with NULs ("Microsoft SQL Server\0\0\0\0").
    laProgName <- T.dropWhileEnd (== '\0') O.<$> P.bVarChar
    laProgVersion <- (,,,) O.<$> O.word8 O.<*> O.word8 O.<*> O.word8 O.<*> O.word8
    pure LoginAck{..}

-- The value of an output parameter is read by the same value recipes as a column,
-- in the RETURNVALUE form, which has no text pointer ('V.valueShape').
readReturnValue :: ValueMode -> P.Parser ReturnValue
readReturnValue :: ValueMode -> Recipe () ReturnValue
readReturnValue ValueMode
mode = O.do
  rv <- Recipe () ReturnValue
readReturnValueHead
  v <- readValue mode (rvType rv)
  pure rv { rvValue = v }

-- | A RETURNVALUE token after its token byte, up to its value ('rvValue'
-- is left 'Nothing').
readReturnValueHead :: P.Parser ReturnValue
readReturnValueHead :: Recipe () ReturnValue
readReturnValueHead = O.do
  rvOrdinal <- Parser Word16
O.word16le
  rvName <- P.bVarChar
  rvStatus <- O.word8
  rvUserType <- O.word32le
  rvFlags <- O.word16le
  rvType <- readTypeInfo
  pure ReturnValue{rvValue = Nothing, ..}

readFeatureExtAck :: P.Parser [FeatureAck]
readFeatureExtAck :: Recipe () [FeatureAck]
readFeatureExtAck = [FeatureAck] -> Recipe () [FeatureAck]
go []
  where
    go :: [FeatureAck] -> Recipe () [FeatureAck]
go [FeatureAck]
features = O.do
      fid <- Parser Word8
O.word8
      if fid == 0xFF then pure (reverse features) else O.do
        len <- O.word32le
        dat <- P.ownedBytes lobAllocAhead (fromIntegral len)
        go (FeatureAck fid dat : features)

-- | [MS-TDS 2.2.7.9 ENVCHANGE](https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/2b3eb7e5-d43d-4d1b-bf4d-76b9e3afc791).
-- The wire order is type, new value, old value.
readEnvChange :: P.Parser EnvChange
readEnvChange :: Recipe () EnvChange
readEnvChange = O.do
  len <- Parser Word16
O.word16le
  when (len == 0) $ fail "readEnvChange: empty ENVCHANGE"
  ty <- P.peekWord8
  if ty == 15 && len == 1
    -- The server reports the length of Promote Transaction as 1 (just the
    -- type byte); the client has to read the rest itself.
    then P.skip 1 O.>> readEnvValue ty (fromIntegral len)
    else P.isolate (fromIntegral len) (P.skip 1 O.>> readEnvValue ty (fromIntegral len))

readEnvValue :: Word8 -> Int -> P.Parser EnvChange
readEnvValue :: Word8 -> Int -> Recipe () EnvChange
readEnvValue Word8
ty Int
len = case Word8
ty of
  Word8
1 -> (Text -> Text -> EnvChange) -> Parser Text -> Recipe () EnvChange
forall {t} {b} {env}. (t -> t -> b) -> Recipe env t -> Recipe env b
newThenOld Text -> Text -> EnvChange
ECDatabase Parser Text
P.bVarChar
  Word8
2 -> (Text -> Text -> EnvChange) -> Parser Text -> Recipe () EnvChange
forall {t} {b} {env}. (t -> t -> b) -> Recipe env t -> Recipe env b
newThenOld Text -> Text -> EnvChange
ECLanguage Parser Text
P.bVarChar
  Word8
3 -> (Text -> Text -> EnvChange) -> Parser Text -> Recipe () EnvChange
forall {t} {b} {env}. (t -> t -> b) -> Recipe env t -> Recipe env b
newThenOld Text -> Text -> EnvChange
ECCharacterSet Parser Text
P.bVarChar
  Word8
4 -> O.do
    new <- Parser Text
P.bVarChar Parser Text -> (Text -> Recipe () Integer) -> Recipe () Integer
forall env a b. Recipe env a -> (a -> Recipe env b) -> Recipe env b
O.>>= Text -> Recipe () Integer
readNumber
    old <- P.bVarChar O.>>= readNumber
    -- Framing requests with a size outside this range would loop (below
    -- the header size) or truncate the 16-bit packet length (above 64 KiB).
    unless (new >= toInteger minPacketSize && new <= toInteger maxPacketSize) $
      fail $ "readEnvChange: packet size " ++ show new ++ " is outside the range "
        ++ show minPacketSize ++ ".." ++ show maxPacketSize
    -- The old value is whatever LOGIN7 asked for, which is any DWORD.
    unless (old <= toInteger (maxBound :: Word32)) $
      fail $ "readEnvChange: old packet size " ++ show old ++ " is out of range"
    pure $ ECPacketSize (fromInteger old) (fromInteger new)
  Word8
5 -> (Text -> EnvChange) -> Parser Text -> Recipe () EnvChange
forall {t} {b}. (t -> b) -> Recipe () t -> Recipe () b
newOnly Text -> EnvChange
ECUnicodeSortingLocale Parser Text
P.bVarChar
  Word8
6 -> (Text -> EnvChange) -> Parser Text -> Recipe () EnvChange
forall {t} {b}. (t -> b) -> Recipe () t -> Recipe () b
newOnly Text -> EnvChange
ECUnicodeComparisonFlags Parser Text
P.bVarChar
  Word8
7 -> (ByteString -> ByteString -> EnvChange)
-> Parser ByteString -> Recipe () EnvChange
forall {t} {b} {env}. (t -> t -> b) -> Recipe env t -> Recipe env b
newThenOld ByteString -> ByteString -> EnvChange
ECSqlCollation Parser ByteString
readBVarByte
  Word8
8 -> (TransactionDescriptor -> EnvChange) -> Recipe () EnvChange
forall {b}. (TransactionDescriptor -> b) -> Recipe () b
txn TransactionDescriptor -> EnvChange
ECBeginTransaction
  Word8
9 -> (TransactionDescriptor -> EnvChange) -> Recipe () EnvChange
forall {b}. (TransactionDescriptor -> b) -> Recipe () b
txn TransactionDescriptor -> EnvChange
ECCommitTransaction
  Word8
10 -> (TransactionDescriptor -> EnvChange) -> Recipe () EnvChange
forall {b}. (TransactionDescriptor -> b) -> Recipe () b
txn TransactionDescriptor -> EnvChange
ECRollbackTransaction
  Word8
11 -> (TransactionDescriptor -> EnvChange) -> Recipe () EnvChange
forall {b}. (TransactionDescriptor -> b) -> Recipe () b
txn TransactionDescriptor -> EnvChange
ECEnlistDtcTransaction
  Word8
12 -> (TransactionDescriptor -> EnvChange) -> Recipe () EnvChange
forall {b}. (TransactionDescriptor -> b) -> Recipe () b
txn TransactionDescriptor -> EnvChange
ECDefectTransaction
  Word8
13 -> (Text -> EnvChange) -> Parser Text -> Recipe () EnvChange
forall {t} {b}. (t -> b) -> Recipe () t -> Recipe () b
newOnly Text -> EnvChange
ECMirroringPartner Parser Text
P.bVarChar
  Word8
15 -> (ByteString -> EnvChange)
-> Parser ByteString -> Recipe () EnvChange
forall {t} {b}. (t -> b) -> Recipe () t -> Recipe () b
newOnly ByteString -> EnvChange
ECPromoteTransaction (Recipe () Word32
O.word32le Recipe () Word32
-> (Word32 -> Parser ByteString) -> Parser ByteString
forall env a b. Recipe env a -> (a -> Recipe env b) -> Recipe env b
O.>>= (Int -> Int -> Parser ByteString
P.ownedBytes Int
lobAllocAhead) (Int -> Parser ByteString)
-> (Word32 -> Int) -> Word32 -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  Word8
16 -> (ByteString -> EnvChange)
-> Parser ByteString -> Recipe () EnvChange
forall {t} {b}. (t -> b) -> Recipe () t -> Recipe () b
newOnly ByteString -> EnvChange
ECTransactionManagerAddress Parser ByteString
readBVarByte
  Word8
17 -> (TransactionDescriptor -> EnvChange) -> Recipe () EnvChange
forall {b}. (TransactionDescriptor -> b) -> Recipe () b
txn TransactionDescriptor -> EnvChange
ECTransactionEnded
  Word8
18 -> EnvChange
ECResetConnectionAck EnvChange -> Parser () -> Recipe () EnvChange
forall a env b. a -> Recipe env b -> Recipe env a
O.<$ (Parser ()
expectEmpty Parser () -> Parser () -> Parser ()
forall env a b. Recipe env a -> Recipe env b -> Recipe env b
O.>> Parser ()
expectEmpty)
  Word8
19 -> (Text -> EnvChange) -> Parser Text -> Recipe () EnvChange
forall {t} {b}. (t -> b) -> Recipe () t -> Recipe () b
newOnly Text -> EnvChange
ECUserInstance Parser Text
P.bVarChar
  Word8
20 -> O.do
    -- NEWVALUE is RoutingData (a USHORT length, then protocol, port and
    -- server name); OLDVALUE is two zero bytes.
    n <- Parser Word16
O.word16le
    when (n == 0) $ fail "readEnvChange: routing ENVCHANGE without routing data"
    info <- P.isolate (fromIntegral n) $
      RoutingInfo O.<$> O.word8 O.<*> O.word16le O.<*> P.usVarChar
    old <- O.word16le
    unless (old == 0) $ fail "readEnvChange: expected empty old value in routing ENVCHANGE"
    pure $ ECRouting info
  Word8
_ -> Word8 -> ByteString -> EnvChange
ECUnknown Word8
ty (ByteString -> EnvChange)
-> Parser ByteString -> Recipe () EnvChange
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> (Int -> Int -> Parser ByteString
P.ownedBytes Int
lobAllocAhead) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    newThenOld :: (t -> t -> b) -> Recipe env t -> Recipe env b
newThenOld t -> t -> b
f Recipe env t
g = O.do { new <- Recipe env t
g; old <- g; pure (f old new) }
    newOnly :: (t -> b) -> Recipe () t -> Recipe () b
newOnly t -> b
f Recipe () t
g = O.do { v <- Recipe () t
g; expectEmpty; pure (f v) }
    expectEmpty :: Parser ()
expectEmpty = O.do
      n <- Parser Word8
O.word8
      unless (n == 0) $ fail $ "readEnvChange: expected empty value in type " ++ show ty
    -- The spec's table and its notes disagree about which side carries the
    -- descriptor for types 11, 12 and 17, so (like Microsoft's drivers)
    -- accept it on either side.
    txn :: (TransactionDescriptor -> b) -> Recipe () b
txn TransactionDescriptor -> b
f = O.do
      new <- Recipe () (Maybe TransactionDescriptor)
txnValue
      old <- txnValue
      case (new, old) of
        (Just TransactionDescriptor
d, Maybe TransactionDescriptor
_) -> b -> Recipe () b
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransactionDescriptor -> b
f TransactionDescriptor
d)
        (Maybe TransactionDescriptor
Nothing, Just TransactionDescriptor
d) -> b -> Recipe () b
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransactionDescriptor -> b
f TransactionDescriptor
d)
        (Maybe TransactionDescriptor
Nothing, Maybe TransactionDescriptor
Nothing) -> [Char] -> Recipe () b
forall a. [Char] -> Recipe () a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Recipe () b) -> [Char] -> Recipe () b
forall a b. (a -> b) -> a -> b
$ [Char]
"readEnvChange: no transaction descriptor in type " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
ty
    txnValue :: Recipe () (Maybe TransactionDescriptor)
txnValue = Parser Word8
O.word8 Parser Word8
-> (Word8 -> Recipe () (Maybe TransactionDescriptor))
-> Recipe () (Maybe TransactionDescriptor)
forall env a b. Recipe env a -> (a -> Recipe env b) -> Recipe env b
O.>>= \case
      Word8
0 -> Maybe TransactionDescriptor
-> Recipe () (Maybe TransactionDescriptor)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TransactionDescriptor
forall a. Maybe a
Nothing
      Word8
8 -> TransactionDescriptor -> Maybe TransactionDescriptor
forall a. a -> Maybe a
Just (TransactionDescriptor -> Maybe TransactionDescriptor)
-> (Word64 -> TransactionDescriptor)
-> Word64
-> Maybe TransactionDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> TransactionDescriptor
TransactionDescriptor (Word64 -> Maybe TransactionDescriptor)
-> Recipe () Word64 -> Recipe () (Maybe TransactionDescriptor)
forall a b env. (a -> b) -> Recipe env a -> Recipe env b
O.<$> Recipe () Word64
O.word64le
      Word8
_ -> [Char] -> Recipe () (Maybe TransactionDescriptor)
forall a. [Char] -> Recipe () a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"readEnvChange: transaction descriptor must be 8 bytes"
    readNumber :: Text -> P.Parser Integer
    readNumber :: Text -> Recipe () Integer
readNumber Text
t = case Reader Integer
forall a. Integral a => Reader a
TR.decimal Text
t of
      Right (Integer
n, Text
rest) | Text -> Bool
T.null Text
rest -> Integer -> Recipe () Integer
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
n
      Either [Char] (Integer, Text)
_ -> [Char] -> Recipe () Integer
forall a. [Char] -> Recipe () a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Recipe () Integer) -> [Char] -> Recipe () Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"readEnvChange: packet size is not a number: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t

readBVarByte :: P.Parser B.ByteString
readBVarByte :: Parser ByteString
readBVarByte = Parser Word8
O.word8 Parser Word8 -> (Word8 -> Parser ByteString) -> Parser ByteString
forall env a b. Recipe env a -> (a -> Recipe env b) -> Recipe env b
O.>>= Int -> Parser ByteString
P.ownedBoundedBytes (Int -> Parser ByteString)
-> (Word8 -> Int) -> Word8 -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

readValue :: ValueMode -> TypeInfo -> P.Parser RawBytes
readValue :: ValueMode -> TypeInfo -> Parser RawBytes
readValue ValueMode
mode = ValueMode -> ColumnShape -> Parser RawBytes
readCellValue ValueMode
mode (ColumnShape -> Parser RawBytes)
-> (TypeInfo -> ColumnShape) -> TypeInfo -> Parser RawBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> ColumnShape
V.valueShape

-- An output parameter's value comes once per parameter, so its delimiter is read by
-- 'V.cellHead''s compiled copy and the binds are calls.  Inlined, this was a copy of
-- every delimiter form inside the token reader.
readCellValue :: ValueMode -> V.ColumnShape -> P.Parser RawBytes
readCellValue :: ValueMode -> ColumnShape -> Parser RawBytes
readCellValue ValueMode
mode ColumnShape
shape = (ColumnShape -> Parser Cell) -> ColumnShape -> Parser Cell
forall a. a -> a
noinline ColumnShape -> Parser Cell
V.cellHead ColumnShape
shape Parser Cell -> (Cell -> Parser RawBytes) -> Parser RawBytes
forall env a b. Recipe env a -> (a -> Recipe env b) -> Recipe env b
O.>>= \case
  Cell
V.NullCell -> RawBytes -> Parser RawBytes
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RawBytes
forall a. Maybe a
Nothing
  Cell
cell -> case ValueMode
mode of
    AssembleValues Int
ahead -> Int -> Cell -> Parser RawBytes
V.ownedValue Int
ahead Cell
cell
    ValueMode
SkipValues -> ByteString -> RawBytes
forall a. a -> Maybe a
Just ByteString
B.empty RawBytes -> Parser () -> Parser RawBytes
forall a env b. a -> Recipe env b -> Recipe env a
O.<$ (Cell -> Parser ()) -> Cell -> Parser ()
forall a. a -> a
noinline Cell -> Parser ()
V.skipValue Cell
cell