{-# LANGUAGE CPP #-}
-- | Bounds-checked little-endian (and two big-endian) reads from a
-- 'B.ByteString' at an offset: what the value decoders use once a value's
-- length has been checked against its type.
--
-- No 'Data.Binary.Get', no intermediate 'B.ByteString', and no pointers here:
-- each reader checks that the @n@ bytes at @off@ lie within the buffer (calling
-- 'error' if they don't, as 'B.index' does: a read can never touch memory
-- outside the buffer, whatever the caller got wrong), then assembles the value
-- from its bytes.  Raw pointer operations, for the character codecs, are in
-- "Hmssql.Tds.Bytes.Unsafe".
--
-- The parser and the scalar codecs read with these.  A field conversion
-- receives a whole value, so it never needs an offset into a packet.
module Hmssql.Tds.Bytes
  ( -- * Checked reads from a buffer
    word8At
  , word16LeAt
  , word32LeAt
  , word64LeAt
  , word16BeAt
  , word64BeAt
  , wordLeAt
  , int8At
  , int16LeAt
  , int32LeAt
  , int64LeAt
    -- * Spans
  , spanWithin
  , checkSpan
  ) where

#include "MachDeps.h"

#if WORD_SIZE_IN_BITS < 64
#error "hmssql needs a 64-bit Int: its wire lengths (up to 2^32 - 1, and PLP totals up to 2^64 - 2) are converted to Int"
#endif

import Data.Bits (Bits, shiftL, unsafeShiftL, (.|.))
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Word (Word16, Word32, Word64, Word8, byteSwap16, byteSwap64)

-- | Whether @len@ bytes at @off@ lie within a buffer of @size@ bytes:
-- @0 <= off@, @0 <= len@ and @off + len <= size@, checked without
-- overflowing.
spanWithin :: Int -> Int -> Int -> Bool
spanWithin :: Int -> Int -> Int -> Bool
spanWithin Int
size Int
off Int
len = Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off
{-# INLINE spanWithin #-}

-- | 'error' unless the span lies within the buffer ('spanWithin').
checkSpan :: String -> B.ByteString -> Int -> Int -> ()
checkSpan :: String -> ByteString -> Int -> Int -> ()
checkSpan String
who ByteString
bs Int
off Int
len
  | Int -> Int -> Int -> Bool
spanWithin (ByteString -> Int
B.length ByteString
bs) Int
off Int
len = ()
  | Bool
otherwise = String -> Int -> Int -> Int -> ()
forall a. String -> Int -> Int -> Int -> a
outOfBounds String
who Int
len Int
off (ByteString -> Int
B.length ByteString
bs)
{-# INLINE checkSpan #-}

outOfBounds :: String -> Int -> Int -> Int -> a
outOfBounds :: forall a. String -> Int -> Int -> Int -> a
outOfBounds String
who Int
n Int
off Int
size = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
  String
who String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes at offset " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
off String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-byte buffer"
{-# NOINLINE outOfBounds #-}

-- | A read of @n@ bytes at the offset, checked against the buffer.
checked :: Int -> B.ByteString -> Int -> a -> a
checked :: forall a. Int -> ByteString -> Int -> a -> a
checked Int
n ByteString
bs Int
off a
read
  | Int -> Int -> Int -> Bool
spanWithin (ByteString -> Int
B.length ByteString
bs) Int
off Int
n = a
read
  | Bool
otherwise = String -> Int -> Int -> Int -> a
forall a. String -> Int -> Int -> Int -> a
outOfBounds String
"Hmssql.Tds.Bytes" Int
n Int
off (ByteString -> Int
B.length ByteString
bs)
{-# INLINE checked #-}

-- GHC doesn't merge these into one load, so a word is several. Measured against
-- a single load through runRW#, which had to sidestep unsafeDupablePerformIO's lazy
-- to stay unboxed: Decode 1.03 in time and 1.00 in allocation, Mock.query typed 1.04.
-- That was accepted to keep this code free of pointers and of that trick.

-- | The byte at a position already checked, widened and shifted into place.
byteAt :: (Bits w, Num w) => B.ByteString -> Int -> Int -> w
byteAt :: forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
i = Word8 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)) w -> Int -> w
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
{-# INLINE byteAt #-}

word8At :: B.ByteString -> Int -> Word8
word8At :: ByteString -> Int -> Word8
word8At ByteString
bs Int
off = Int -> ByteString -> Int -> Word8 -> Word8
forall a. Int -> ByteString -> Int -> a -> a
checked Int
1 ByteString
bs Int
off (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
off)
{-# INLINE word8At #-}

word16LeAt :: B.ByteString -> Int -> Word16
word16LeAt :: ByteString -> Int -> Word16
word16LeAt ByteString
bs Int
off = Int -> ByteString -> Int -> Word16 -> Word16
forall a. Int -> ByteString -> Int -> a -> a
checked Int
2 ByteString
bs Int
off (ByteString -> Int -> Int -> Word16
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word16
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
1)
{-# INLINE word16LeAt #-}

word32LeAt :: B.ByteString -> Int -> Word32
word32LeAt :: ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
off = Int -> ByteString -> Int -> Word32 -> Word32
forall a. Int -> ByteString -> Int -> a -> a
checked Int
4 ByteString
bs Int
off
  (ByteString -> Int -> Int -> Word32
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word32
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word32
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word32
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
3)
{-# INLINE word32LeAt #-}

word64LeAt :: B.ByteString -> Int -> Word64
word64LeAt :: ByteString -> Int -> Word64
word64LeAt ByteString
bs Int
off = Int -> ByteString -> Int -> Word64 -> Word64
forall a. Int -> ByteString -> Int -> a -> a
checked Int
8 ByteString
bs Int
off
  ( ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
3
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
5 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ByteString -> Int -> Int -> Word64
forall w. (Bits w, Num w) => ByteString -> Int -> Int -> w
byteAt ByteString
bs Int
off Int
7 )
{-# INLINE word64LeAt #-}

-- | Big-endian: a packet header's fields, and a GUID's last eight bytes.
word16BeAt :: B.ByteString -> Int -> Word16
word16BeAt :: ByteString -> Int -> Word16
word16BeAt ByteString
bs Int
off = Word16 -> Word16
byteSwap16 (ByteString -> Int -> Word16
word16LeAt ByteString
bs Int
off)
{-# INLINE word16BeAt #-}

word64BeAt :: B.ByteString -> Int -> Word64
word64BeAt :: ByteString -> Int -> Word64
word64BeAt ByteString
bs Int
off = Word64 -> Word64
byteSwap64 (ByteString -> Int -> Word64
word64LeAt ByteString
bs Int
off)
{-# INLINE word64BeAt #-}

-- | An unsigned little-endian integer of @n@ bytes (0 through 8).
wordLeAt :: Int -> B.ByteString -> Int -> Word64
wordLeAt :: Int -> ByteString -> Int -> Word64
wordLeAt Int
n ByteString
bs Int
off = case Int
n of
  Int
3 -> Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word16
word16LeAt ByteString
bs Int
off) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
word8At ByteString
bs (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
  Int
4 -> Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
off)
  Int
5 -> Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
off) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
word8At ByteString
bs (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
  Int
_ -> Int -> Word64 -> Word64
forall {t}. (Bits t, Num t) => Int -> t -> t
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word64
0
  where
    go :: Int -> t -> t
go Int
i !t
acc
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = t
acc
      | Bool
otherwise = Int -> t -> t
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ((t
acc t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) t -> t -> t
forall a. Bits a => a -> a -> a
.|. Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
word8At ByteString
bs (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)))
{-# INLINE wordLeAt #-}

int8At :: B.ByteString -> Int -> Int8
int8At :: ByteString -> Int -> Int8
int8At ByteString
bs Int
off = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
word8At ByteString
bs Int
off)
{-# INLINE int8At #-}

int16LeAt :: B.ByteString -> Int -> Int16
int16LeAt :: ByteString -> Int -> Int16
int16LeAt ByteString
bs Int
off = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word16
word16LeAt ByteString
bs Int
off)
{-# INLINE int16LeAt #-}

int32LeAt :: B.ByteString -> Int -> Int32
int32LeAt :: ByteString -> Int -> Int32
int32LeAt ByteString
bs Int
off = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
off)
{-# INLINE int32LeAt #-}

int64LeAt :: B.ByteString -> Int -> Int64
int64LeAt :: ByteString -> Int -> Int64
int64LeAt ByteString
bs Int
off = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word64
word64LeAt ByteString
bs Int
off)
{-# INLINE int64LeAt #-}