{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}

module FoundationDB.Layer.Tuple.Internal where

import Control.Applicative
import Control.DeepSeq (NFData)
import Control.Exception (throw)
import Control.Monad
import Control.Monad.State.Strict
import Data.Array.Unboxed (Array)
import qualified Data.Array.Unboxed as A
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Serialize.Get
  ( Get,
    getByteString,
    getBytes,
    getWord16be,
    getWord32be,
    getWord64be,
    getWord8,
    lookAhead,
    remaining,
    runGet,
    runGetState,
  )
import Data.Serialize.IEEE754 (getFloat32be, getFloat64be)
import qualified Data.Serialize.IEEE754 as Put
import qualified Data.Serialize.Put as Put
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Tuple (swap)
import Data.Word (Word16, Word32, Word64, Word8)
import FoundationDB.Error.Internal (Error (Error), FDBHsError (TupleIntTooLarge))
import FoundationDB.Versionstamp hiding (decodeVersionstamp)
import GHC.Exts (Int (I#))
import GHC.Generics (Generic)
import GHC.Integer.Logarithms (integerLog2#)

-- | Elements of tuples. A tuple is represented as a list of these. Note that
-- a tuple may contain at most one incomplete version stamp. Future versions of
-- this library may introduce a more strongly typed tuple representation that
-- enforces this restriction.
data Elem
  = -- | Corresponds to null or nil types in other language bindings.
    None
  | -- | Nested tuples.
    Tuple [Elem]
  | Bytes ByteString
  | Text T.Text
  | -- | Variable-length integer encodings. For values that fit within a 64-bit
    -- signed integer, the <https://github.com/apple/foundationdb/blob/master/design/tuple.md#integer standard integer>
    -- encoding is used. For larger values, the <https://github.com/apple/foundationdb/blob/master/design/tuple.md#positive-arbitrary-precision-integer provisional spec>
    -- for Java and Python values is used.
    Int Integer
  | Float Float
  | Double Double
  | Bool Bool
  | -- | Crude UUID to avoid dependency on UUID library. Interconvertible with
    -- @toWords@ and @fromWords@ in 'Data.UUID'.
    UUID Word32 Word32 Word32 Word32
  | CompleteVS (Versionstamp 'Complete)
  | -- | This constructor is to be used in conjunction with 'encodeTupleElems' and
    -- the 'setVersionstampedKey' atomic operation. See 'encodeTupleElems' for
    -- more information.
    IncompleteVS (Versionstamp 'Incomplete)
  deriving (Int -> Elem -> ShowS
[Elem] -> ShowS
Elem -> String
(Int -> Elem -> ShowS)
-> (Elem -> String) -> ([Elem] -> ShowS) -> Show Elem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elem] -> ShowS
$cshowList :: [Elem] -> ShowS
show :: Elem -> String
$cshow :: Elem -> String
showsPrec :: Int -> Elem -> ShowS
$cshowsPrec :: Int -> Elem -> ShowS
Show, Elem -> Elem -> Bool
(Elem -> Elem -> Bool) -> (Elem -> Elem -> Bool) -> Eq Elem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elem -> Elem -> Bool
$c/= :: Elem -> Elem -> Bool
== :: Elem -> Elem -> Bool
$c== :: Elem -> Elem -> Bool
Eq, Eq Elem
Eq Elem
-> (Elem -> Elem -> Ordering)
-> (Elem -> Elem -> Bool)
-> (Elem -> Elem -> Bool)
-> (Elem -> Elem -> Bool)
-> (Elem -> Elem -> Bool)
-> (Elem -> Elem -> Elem)
-> (Elem -> Elem -> Elem)
-> Ord Elem
Elem -> Elem -> Bool
Elem -> Elem -> Ordering
Elem -> Elem -> Elem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Elem -> Elem -> Elem
$cmin :: Elem -> Elem -> Elem
max :: Elem -> Elem -> Elem
$cmax :: Elem -> Elem -> Elem
>= :: Elem -> Elem -> Bool
$c>= :: Elem -> Elem -> Bool
> :: Elem -> Elem -> Bool
$c> :: Elem -> Elem -> Bool
<= :: Elem -> Elem -> Bool
$c<= :: Elem -> Elem -> Bool
< :: Elem -> Elem -> Bool
$c< :: Elem -> Elem -> Bool
compare :: Elem -> Elem -> Ordering
$ccompare :: Elem -> Elem -> Ordering
$cp1Ord :: Eq Elem
Ord, (forall x. Elem -> Rep Elem x)
-> (forall x. Rep Elem x -> Elem) -> Generic Elem
forall x. Rep Elem x -> Elem
forall x. Elem -> Rep Elem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Elem x -> Elem
$cfrom :: forall x. Elem -> Rep Elem x
Generic)

instance NFData Elem

sizeLimits :: Array Int Integer
sizeLimits :: Array Int Integer
sizeLimits = (Int, Int) -> [Integer] -> Array Int Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (Int
0, Int
8) [Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL Integer
1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 | Int
i <- [Int
0 .. Int
8]]

-- | Returns smallest size limit greater than input.
bisectSize :: Integer -> Int
bisectSize :: Integer -> Int
bisectSize Integer
n = Int -> Int
go Int
0
  where
    go :: Int -> Int
go Int
8 = Int
8
    go !Int
i = if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (Array Int Integer
sizeLimits Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Int
i) then Int
i else Int -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Returns the minimum number of bits needed to encode the given int.
bitLen :: Integer -> Int
bitLen :: Integer -> Int
bitLen Integer
x = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Integer -> Int#
integerLog2# (Integer -> Integer
forall a. Num a => a -> a
abs Integer
x))

-- | Returns the minimum number of bytes needed to encode the given int.
byteLen :: Integer -> Int
byteLen :: Integer -> Int
byteLen Integer
x = (Integer -> Int
bitLen Integer
x 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

nullCode, bytesCode, stringCode, nestedCode :: Word8
zeroCode, posEndCode, negStartCode, floatCode :: Word8
doubleCode, falseCode, trueCode, uuidCode, versionstampCode :: Word8
nullCode :: Word8
nullCode = Word8
0x00
bytesCode :: Word8
bytesCode = Word8
0x01
stringCode :: Word8
stringCode = Word8
0x02
nestedCode :: Word8
nestedCode = Word8
0x05

negStartCode :: Word8
negStartCode = Word8
0x0b

zeroCode :: Word8
zeroCode = Word8
0x14

posEndCode :: Word8
posEndCode = Word8
0x1d

floatCode :: Word8
floatCode = Word8
0x20

doubleCode :: Word8
doubleCode = Word8
0x21

falseCode :: Word8
falseCode = Word8
0x26

trueCode :: Word8
trueCode = Word8
0x27

uuidCode :: Word8
uuidCode = Word8
0x30

versionstampCode :: Word8
versionstampCode = Word8
0x33

data SerializationState = SerializationState
  { SerializationState -> Int
currLength :: Int,
    SerializationState -> Maybe Int
incompleteVersionstampPos :: Maybe Int
  }
  deriving (Int -> SerializationState -> ShowS
[SerializationState] -> ShowS
SerializationState -> String
(Int -> SerializationState -> ShowS)
-> (SerializationState -> String)
-> ([SerializationState] -> ShowS)
-> Show SerializationState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerializationState] -> ShowS
$cshowList :: [SerializationState] -> ShowS
show :: SerializationState -> String
$cshow :: SerializationState -> String
showsPrec :: Int -> SerializationState -> ShowS
$cshowsPrec :: Int -> SerializationState -> ShowS
Show, SerializationState -> SerializationState -> Bool
(SerializationState -> SerializationState -> Bool)
-> (SerializationState -> SerializationState -> Bool)
-> Eq SerializationState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerializationState -> SerializationState -> Bool
$c/= :: SerializationState -> SerializationState -> Bool
== :: SerializationState -> SerializationState -> Bool
$c== :: SerializationState -> SerializationState -> Bool
Eq, Eq SerializationState
Eq SerializationState
-> (SerializationState -> SerializationState -> Ordering)
-> (SerializationState -> SerializationState -> Bool)
-> (SerializationState -> SerializationState -> Bool)
-> (SerializationState -> SerializationState -> Bool)
-> (SerializationState -> SerializationState -> Bool)
-> (SerializationState -> SerializationState -> SerializationState)
-> (SerializationState -> SerializationState -> SerializationState)
-> Ord SerializationState
SerializationState -> SerializationState -> Bool
SerializationState -> SerializationState -> Ordering
SerializationState -> SerializationState -> SerializationState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SerializationState -> SerializationState -> SerializationState
$cmin :: SerializationState -> SerializationState -> SerializationState
max :: SerializationState -> SerializationState -> SerializationState
$cmax :: SerializationState -> SerializationState -> SerializationState
>= :: SerializationState -> SerializationState -> Bool
$c>= :: SerializationState -> SerializationState -> Bool
> :: SerializationState -> SerializationState -> Bool
$c> :: SerializationState -> SerializationState -> Bool
<= :: SerializationState -> SerializationState -> Bool
$c<= :: SerializationState -> SerializationState -> Bool
< :: SerializationState -> SerializationState -> Bool
$c< :: SerializationState -> SerializationState -> Bool
compare :: SerializationState -> SerializationState -> Ordering
$ccompare :: SerializationState -> SerializationState -> Ordering
$cp1Ord :: Eq SerializationState
Ord)

newtype PutTuple a = PutTuple {PutTuple a -> StateT SerializationState PutM a
unPutTuple :: StateT SerializationState Put.PutM a}
  deriving (a -> PutTuple b -> PutTuple a
(a -> b) -> PutTuple a -> PutTuple b
(forall a b. (a -> b) -> PutTuple a -> PutTuple b)
-> (forall a b. a -> PutTuple b -> PutTuple a) -> Functor PutTuple
forall a b. a -> PutTuple b -> PutTuple a
forall a b. (a -> b) -> PutTuple a -> PutTuple b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PutTuple b -> PutTuple a
$c<$ :: forall a b. a -> PutTuple b -> PutTuple a
fmap :: (a -> b) -> PutTuple a -> PutTuple b
$cfmap :: forall a b. (a -> b) -> PutTuple a -> PutTuple b
Functor, Functor PutTuple
a -> PutTuple a
Functor PutTuple
-> (forall a. a -> PutTuple a)
-> (forall a b. PutTuple (a -> b) -> PutTuple a -> PutTuple b)
-> (forall a b c.
    (a -> b -> c) -> PutTuple a -> PutTuple b -> PutTuple c)
-> (forall a b. PutTuple a -> PutTuple b -> PutTuple b)
-> (forall a b. PutTuple a -> PutTuple b -> PutTuple a)
-> Applicative PutTuple
PutTuple a -> PutTuple b -> PutTuple b
PutTuple a -> PutTuple b -> PutTuple a
PutTuple (a -> b) -> PutTuple a -> PutTuple b
(a -> b -> c) -> PutTuple a -> PutTuple b -> PutTuple c
forall a. a -> PutTuple a
forall a b. PutTuple a -> PutTuple b -> PutTuple a
forall a b. PutTuple a -> PutTuple b -> PutTuple b
forall a b. PutTuple (a -> b) -> PutTuple a -> PutTuple b
forall a b c.
(a -> b -> c) -> PutTuple a -> PutTuple b -> PutTuple c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PutTuple a -> PutTuple b -> PutTuple a
$c<* :: forall a b. PutTuple a -> PutTuple b -> PutTuple a
*> :: PutTuple a -> PutTuple b -> PutTuple b
$c*> :: forall a b. PutTuple a -> PutTuple b -> PutTuple b
liftA2 :: (a -> b -> c) -> PutTuple a -> PutTuple b -> PutTuple c
$cliftA2 :: forall a b c.
(a -> b -> c) -> PutTuple a -> PutTuple b -> PutTuple c
<*> :: PutTuple (a -> b) -> PutTuple a -> PutTuple b
$c<*> :: forall a b. PutTuple (a -> b) -> PutTuple a -> PutTuple b
pure :: a -> PutTuple a
$cpure :: forall a. a -> PutTuple a
$cp1Applicative :: Functor PutTuple
Applicative, Applicative PutTuple
a -> PutTuple a
Applicative PutTuple
-> (forall a b. PutTuple a -> (a -> PutTuple b) -> PutTuple b)
-> (forall a b. PutTuple a -> PutTuple b -> PutTuple b)
-> (forall a. a -> PutTuple a)
-> Monad PutTuple
PutTuple a -> (a -> PutTuple b) -> PutTuple b
PutTuple a -> PutTuple b -> PutTuple b
forall a. a -> PutTuple a
forall a b. PutTuple a -> PutTuple b -> PutTuple b
forall a b. PutTuple a -> (a -> PutTuple b) -> PutTuple b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PutTuple a
$creturn :: forall a. a -> PutTuple a
>> :: PutTuple a -> PutTuple b -> PutTuple b
$c>> :: forall a b. PutTuple a -> PutTuple b -> PutTuple b
>>= :: PutTuple a -> (a -> PutTuple b) -> PutTuple b
$c>>= :: forall a b. PutTuple a -> (a -> PutTuple b) -> PutTuple b
$cp1Monad :: Applicative PutTuple
Monad)

deriving instance MonadState SerializationState PutTuple

-- | returns the serialized tuple and the position of the incomplete version
-- stamp, if any.
runPutTuple :: PutTuple () -> (ByteString, Maybe Int)
runPutTuple :: PutTuple () -> (ByteString, Maybe Int)
runPutTuple PutTuple ()
x = (Maybe Int, ByteString) -> (ByteString, Maybe Int)
forall a b. (a, b) -> (b, a)
swap ((Maybe Int, ByteString) -> (ByteString, Maybe Int))
-> (Maybe Int, ByteString) -> (ByteString, Maybe Int)
forall a b. (a -> b) -> a -> b
$
  PutM (Maybe Int) -> (Maybe Int, ByteString)
forall a. PutM a -> (a, ByteString)
Put.runPutM (PutM (Maybe Int) -> (Maybe Int, ByteString))
-> PutM (Maybe Int) -> (Maybe Int, ByteString)
forall a b. (a -> b) -> a -> b
$ do
    ((), SerializationState
s) <- StateT SerializationState PutM ()
-> SerializationState -> PutM ((), SerializationState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (PutTuple () -> StateT SerializationState PutM ()
forall a. PutTuple a -> StateT SerializationState PutM a
unPutTuple PutTuple ()
x) (Int -> Maybe Int -> SerializationState
SerializationState Int
0 Maybe Int
forall a. Maybe a
Nothing)
    Maybe Int -> (Int -> PutM ()) -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (SerializationState -> Maybe Int
incompleteVersionstampPos SerializationState
s) ((Int -> PutM ()) -> PutM ()) -> (Int -> PutM ()) -> PutM ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> Putter Word32
Put.putWord32le (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    Maybe Int -> PutM (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (SerializationState -> Maybe Int
incompleteVersionstampPos SerializationState
s)

incrLength :: Int -> PutTuple ()
incrLength :: Int -> PutTuple ()
incrLength !Int
i = do
  SerializationState
s <- PutTuple SerializationState
forall s (m :: * -> *). MonadState s m => m s
get
  SerializationState -> PutTuple ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put SerializationState
s {currLength :: Int
currLength = SerializationState -> Int
currLength SerializationState
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i}

liftPutM :: Put.PutM a -> PutTuple a
liftPutM :: PutM a -> PutTuple a
liftPutM PutM a
x = StateT SerializationState PutM a -> PutTuple a
forall a. StateT SerializationState PutM a -> PutTuple a
PutTuple (StateT SerializationState PutM a -> PutTuple a)
-> StateT SerializationState PutM a -> PutTuple a
forall a b. (a -> b) -> a -> b
$ PutM a -> StateT SerializationState PutM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift PutM a
x

putWord8 :: Word8 -> PutTuple ()
putWord8 :: Word8 -> PutTuple ()
putWord8 Word8
x = do
  PutM () -> PutTuple ()
forall a. PutM a -> PutTuple a
liftPutM (Putter Word8
Put.putWord8 Word8
x)
  Int -> PutTuple ()
incrLength Int
1

putWord16be :: Word16 -> PutTuple ()
putWord16be :: Word16 -> PutTuple ()
putWord16be Word16
x = do
  PutM () -> PutTuple ()
forall a. PutM a -> PutTuple a
liftPutM (Putter Word16
Put.putWord16be Word16
x)
  Int -> PutTuple ()
incrLength Int
2

putWord32be :: Word32 -> PutTuple ()
putWord32be :: Word32 -> PutTuple ()
putWord32be Word32
x = do
  PutM () -> PutTuple ()
forall a. PutM a -> PutTuple a
liftPutM (Putter Word32
Put.putWord32be Word32
x)
  Int -> PutTuple ()
incrLength Int
4

putWord64be :: Word64 -> PutTuple ()
putWord64be :: Word64 -> PutTuple ()
putWord64be Word64
x = do
  PutM () -> PutTuple ()
forall a. PutM a -> PutTuple a
liftPutM (Putter Word64
Put.putWord64be Word64
x)
  Int -> PutTuple ()
incrLength Int
8

putByteString :: ByteString -> PutTuple ()
putByteString :: ByteString -> PutTuple ()
putByteString ByteString
bs = do
  PutM () -> PutTuple ()
forall a. PutM a -> PutTuple a
liftPutM (Putter ByteString
Put.putByteString ByteString
bs)
  Int -> PutTuple ()
incrLength (ByteString -> Int
BS.length ByteString
bs)

encodeBytes :: ByteString -> PutTuple ()
encodeBytes :: ByteString -> PutTuple ()
encodeBytes ByteString
bs = (Word8 -> PutTuple ()) -> [Word8] -> PutTuple ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> PutTuple ()
f (ByteString -> [Word8]
BS.unpack ByteString
bs) PutTuple () -> PutTuple () -> PutTuple ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> PutTuple ()
putWord8 Word8
0x00
  where
    f :: Word8 -> PutTuple ()
f Word8
0x00 = Word8 -> PutTuple ()
putWord8 Word8
0x00 PutTuple () -> PutTuple () -> PutTuple ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> PutTuple ()
putWord8 Word8
0xff
    f Word8
x = Word8 -> PutTuple ()
putWord8 Word8
x

-- @truncatedInt n v@ returns the last n bytes of v, encoded big endian.
truncatedInt :: Int -> Integer -> ByteString
truncatedInt :: Int -> Integer -> ByteString
truncatedInt Int
n Integer
v = Int -> ByteString -> ByteString
BS.drop (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (PutM () -> ByteString
Put.runPut (Putter Word64
Put.putWord64be Putter Word64 -> Putter Word64
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v))

encodeLargePosInt :: Integer -> PutTuple ()
encodeLargePosInt :: Integer -> PutTuple ()
encodeLargePosInt Integer
v = do
  let l :: Int
l = Integer -> Int
byteLen Integer
v
  Bool -> PutTuple () -> PutTuple ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
255) (Error -> PutTuple ()
forall a e. Exception e => e -> a
throw (FDBHsError -> Error
Error FDBHsError
TupleIntTooLarge))
  Word8 -> PutTuple ()
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
  [Int] -> (Int -> PutTuple ()) -> PutTuple ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2 .. Int
0] ((Int -> PutTuple ()) -> PutTuple ())
-> (Int -> PutTuple ()) -> PutTuple ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Word8 -> PutTuple ()
putWord8 (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
v Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)))

encodeLargeNegInt :: Integer -> PutTuple ()
encodeLargeNegInt :: Integer -> PutTuple ()
encodeLargeNegInt Integer
v = do
  let l :: Int
l = Integer -> Int
byteLen Integer
v
  Bool -> PutTuple () -> PutTuple ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
255) (Error -> PutTuple ()
forall a e. Exception e => e -> a
throw (FDBHsError -> Error
Error FDBHsError
TupleIntTooLarge))
  let v' :: Integer
v' = Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 :: Integer
  Word8 -> PutTuple ()
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
0xff)
  [Int] -> (Int -> PutTuple ()) -> PutTuple ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2 .. Int
0] ((Int -> PutTuple ()) -> PutTuple ())
-> (Int -> PutTuple ()) -> PutTuple ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Word8 -> PutTuple ()
putWord8 (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
v' Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)))

encodePosInt :: Integer -> PutTuple ()
encodePosInt :: Integer -> PutTuple ()
encodePosInt Integer
v =
  if Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Array Int Integer
sizeLimits Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Array Int Integer -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array Int Integer
sizeLimits)
    then Word8 -> PutTuple ()
putWord8 Word8
posEndCode PutTuple () -> PutTuple () -> PutTuple ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> PutTuple ()
encodeLargePosInt Integer
v
    else do
      let n :: Int
n = Integer -> Int
bisectSize Integer
v
      Word8 -> PutTuple ()
putWord8 (Word8
zeroCode Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      ByteString -> PutTuple ()
putByteString (ByteString -> PutTuple ()) -> ByteString -> PutTuple ()
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ByteString
truncatedInt Int
n Integer
v

encodeNegInt :: Integer -> PutTuple ()
encodeNegInt :: Integer -> PutTuple ()
encodeNegInt Integer
v =
  if (Integer -> Integer
forall a. Num a => a -> a
negate Integer
v) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Array Int Integer
sizeLimits Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Array Int Integer -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array Int Integer
sizeLimits)
    then Word8 -> PutTuple ()
putWord8 Word8
negStartCode PutTuple () -> PutTuple () -> PutTuple ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> PutTuple ()
encodeLargeNegInt Integer
v
    else do
      let n :: Int
n = Integer -> Int
bisectSize (Integer -> Integer
forall a. Num a => a -> a
negate Integer
v)
      let maxv :: Integer
maxv = Array Int Integer
sizeLimits Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Int
n
      Word8 -> PutTuple ()
putWord8 (Word8
zeroCode Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      ByteString -> PutTuple ()
putByteString (ByteString -> PutTuple ()) -> ByteString -> PutTuple ()
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ByteString
truncatedInt Int
n (Integer
maxv Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
v)

-- | given an IEEE 754 float/double, adjust it for encoding.
floatAdjust :: Bool -> ByteString -> ByteString
floatAdjust :: Bool -> ByteString -> ByteString
floatAdjust Bool
isEncode ByteString
bs
  | Bool
isEncode Bool -> Bool -> Bool
&& (ByteString -> Word8
BS.head ByteString
bs Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0xff) ByteString
bs
  | Bool -> Bool
not Bool
isEncode Bool -> Bool -> Bool
&& (ByteString -> Word8
BS.head ByteString
bs Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x80 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0xff) ByteString
bs
  | Bool
otherwise = Word8 -> ByteString -> ByteString
BS.cons (ByteString -> Word8
BS.head ByteString
bs Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
0x80) (ByteString -> ByteString
BS.tail ByteString
bs)

encodeElem ::
  -- | Whether we are inside a nested tuple
  Bool ->
  -- | elem to encode
  Elem ->
  PutTuple ()
encodeElem :: Bool -> Elem -> PutTuple ()
encodeElem Bool
True Elem
None =
  Word8 -> PutTuple ()
putWord8 Word8
nullCode PutTuple () -> PutTuple () -> PutTuple ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> PutTuple ()
putWord8 Word8
0xff
encodeElem Bool
False Elem
None =
  Word8 -> PutTuple ()
putWord8 Word8
nullCode
encodeElem Bool
_ (Bytes ByteString
bs) =
  Word8 -> PutTuple ()
putWord8 Word8
bytesCode PutTuple () -> PutTuple () -> PutTuple ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> PutTuple ()
encodeBytes ByteString
bs
encodeElem Bool
_ (Text Text
t) =
  Word8 -> PutTuple ()
putWord8 Word8
stringCode PutTuple () -> PutTuple () -> PutTuple ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> PutTuple ()
encodeBytes (Text -> ByteString
encodeUtf8 Text
t)
encodeElem Bool
_ (Int Integer
0) = Word8 -> PutTuple ()
putWord8 Word8
zeroCode
encodeElem Bool
_ (Int Integer
n) = if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer -> PutTuple ()
encodePosInt Integer
n else Integer -> PutTuple ()
encodeNegInt Integer
n
encodeElem Bool
_ (Float Float
x) = do
  Word8 -> PutTuple ()
putWord8 Word8
floatCode
  ByteString -> PutTuple ()
putByteString (ByteString -> PutTuple ()) -> ByteString -> PutTuple ()
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
floatAdjust Bool
True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PutM () -> ByteString
Put.runPut (PutM () -> ByteString) -> PutM () -> ByteString
forall a b. (a -> b) -> a -> b
$ Float -> PutM ()
Put.putFloat32be Float
x
encodeElem Bool
_ (Double Double
x) = do
  Word8 -> PutTuple ()
putWord8 Word8
doubleCode
  ByteString -> PutTuple ()
putByteString (ByteString -> PutTuple ()) -> ByteString -> PutTuple ()
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
floatAdjust Bool
True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PutM () -> ByteString
Put.runPut (PutM () -> ByteString) -> PutM () -> ByteString
forall a b. (a -> b) -> a -> b
$ Double -> PutM ()
Put.putFloat64be Double
x
encodeElem Bool
_ (Bool Bool
True) = Word8 -> PutTuple ()
putWord8 Word8
trueCode
encodeElem Bool
_ (Bool Bool
False) = Word8 -> PutTuple ()
putWord8 Word8
falseCode
encodeElem Bool
_ (UUID Word32
w Word32
x Word32
y Word32
z) = do
  Word8 -> PutTuple ()
putWord8 Word8
uuidCode
  Word32 -> PutTuple ()
putWord32be Word32
w
  Word32 -> PutTuple ()
putWord32be Word32
x
  Word32 -> PutTuple ()
putWord32be Word32
y
  Word32 -> PutTuple ()
putWord32be Word32
z
encodeElem Bool
_ (Tuple [Elem]
xs) = do
  Word8 -> PutTuple ()
putWord8 Word8
nestedCode
  (Elem -> PutTuple ()) -> [Elem] -> PutTuple ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Elem -> PutTuple ()
encodeElem Bool
True) [Elem]
xs
  Word8 -> PutTuple ()
putWord8 Word8
0x00
encodeElem Bool
_ (CompleteVS (CompleteVersionstamp TransactionVersionstamp
tvs Word16
uv)) = do
  let (TransactionVersionstamp Word64
tv Word16
tb) = TransactionVersionstamp
tvs
  Word8 -> PutTuple ()
putWord8 Word8
versionstampCode
  Word64 -> PutTuple ()
putWord64be Word64
tv
  Word16 -> PutTuple ()
putWord16be Word16
tb
  Word16 -> PutTuple ()
putWord16be Word16
uv
encodeElem Bool
_ (IncompleteVS (IncompleteVersionstamp Word16
uv)) = do
  Word8 -> PutTuple ()
putWord8 Word8
versionstampCode
  SerializationState
s <- PutTuple SerializationState
forall s (m :: * -> *). MonadState s m => m s
get
  SerializationState -> PutTuple ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put SerializationState
s {incompleteVersionstampPos :: Maybe Int
incompleteVersionstampPos = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SerializationState -> Int
currLength SerializationState
s}
  Word64 -> PutTuple ()
putWord64be Word64
forall a. Bounded a => a
maxBound
  Word16 -> PutTuple ()
putWord16be Word16
forall a. Bounded a => a
maxBound
  Word16 -> PutTuple ()
putWord16be Word16
uv

-- | Encodes a tuple from a list of tuple elements. Returns the encoded
-- tuple.
--
-- Warning: this function can throw an 'Error' with 'TupleIntTooLarge' if you
-- pass an Int element that requires more than 255 bytes to serialize. Since
-- the smallest such number is 614 decimal digits long, we deemed this situation
-- unlikely enough that it wasn't worth returning a sum type from this function.
--
-- Note: this encodes to the format expected by FoundationDB as input, which
-- is slightly different from the format returned by FoundationDB as output. The
-- difference is that if the encoded bytes include an incomplete version stamp,
-- four bytes are appended to the end to indicate the index of the incomplete
-- version stamp so that FoundationDB can fill in the transaction version and
-- batch order when this function is used in conjunction with
-- 'setVersionstampedKey' and 'setVersionstampedValue':
--
-- @
-- do let k = pack mySubspace [IncompleteVS (IncompleteVersionstamp 123)]
--    atomicOp k (setVersionstampedKey "my_value")
-- @
--
-- Because FoundationDB uses two bytes at the end of the key for this, only
-- one 'IncompleteVS' can be used per key.
--
-- This also means that @(decodeTupleElems . encodeTupleElems)@ gives
-- strange results when an 'IncompleteVS' is present in the input, because the
-- two extra bytes are interpreted as being part of the tuple.
--
-- >>> decodeTupleElems $ encodeTupleElems [IncompleteVS (IncompleteVersionstamp 1)]
-- Right [IncompleteVS (IncompleteVersionstamp 1),Bytes "",None,None]
--
-- For this reason, 'decodeTupleElems' should only be called on keys that have
-- been returned from the database, because 'setVersionstampedKey' drops
-- the last two bytes when it writes the key to the database.
encodeTupleElems :: Traversable t => t Elem -> ByteString
encodeTupleElems :: t Elem -> ByteString
encodeTupleElems = (ByteString, Maybe Int) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Int) -> ByteString)
-> (t Elem -> (ByteString, Maybe Int)) -> t Elem -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutTuple () -> (ByteString, Maybe Int)
runPutTuple (PutTuple () -> (ByteString, Maybe Int))
-> (t Elem -> PutTuple ()) -> t Elem -> (ByteString, Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem -> PutTuple ()) -> t Elem -> PutTuple ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Elem -> PutTuple ()
encodeElem Bool
False)

-- | Like 'encodeTupleElems', but prepends a raw bytestring prefix to the
-- tuple. This is used by the subspace and directory layers.
encodeTupleElemsWPrefix :: Traversable t => ByteString -> t Elem -> ByteString
encodeTupleElemsWPrefix :: ByteString -> t Elem -> ByteString
encodeTupleElemsWPrefix ByteString
prefix t Elem
es =
  (ByteString, Maybe Int) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Int) -> ByteString)
-> (ByteString, Maybe Int) -> ByteString
forall a b. (a -> b) -> a -> b
$
    PutTuple () -> (ByteString, Maybe Int)
runPutTuple (PutTuple () -> (ByteString, Maybe Int))
-> PutTuple () -> (ByteString, Maybe Int)
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> PutTuple ()
putByteString ByteString
prefix
      (Elem -> PutTuple ()) -> t Elem -> PutTuple ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Elem -> PutTuple ()
encodeElem Bool
False) t Elem
es

-- | Decodes a tuple, or returns a parse error. This function will never return
-- 'IncompleteVS' tuple elements. See the note on 'encodeTupleElems' for more
-- information.
decodeTupleElems :: ByteString -> Either String [Elem]
decodeTupleElems :: ByteString -> Either String [Elem]
decodeTupleElems ByteString
bs = ByteString -> Get [Elem] -> Either String [Elem]
forall a. ByteString -> Get a -> Either String a
runGetComplete ByteString
bs (Get [Elem] -> Either String [Elem])
-> Get [Elem] -> Either String [Elem]
forall a b. (a -> b) -> a -> b
$ Get Elem -> Get [Elem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Bool -> Get Elem
decodeElem Bool
False)

-- | Decodes a tuple that was encoded with a given prefix. Fails if the
-- input prefix is not actually a prefix of the encoded tuple.
decodeTupleElemsWPrefix ::
  -- | expected prefix
  ByteString ->
  -- | encoded tuple
  ByteString ->
  Either String [Elem]
decodeTupleElemsWPrefix :: ByteString -> ByteString -> Either String [Elem]
decodeTupleElemsWPrefix ByteString
prefix ByteString
bs = ByteString -> Get [Elem] -> Either String [Elem]
forall a. ByteString -> Get a -> Either String a
runGetComplete ByteString
bs (Get [Elem] -> Either String [Elem])
-> Get [Elem] -> Either String [Elem]
forall a b. (a -> b) -> a -> b
$ do
  ByteString
gotPrefix <- Int -> Get ByteString
getByteString (ByteString -> Int
BS.length ByteString
prefix)
  Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString
gotPrefix ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
prefix)
  Get Elem -> Get [Elem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Bool -> Get Elem
decodeElem Bool
False)

runGetComplete :: ByteString -> Get a -> Either String a
runGetComplete :: ByteString -> Get a -> Either String a
runGetComplete ByteString
bs Get a
decoder = do
  (a
result, ByteString
rest) <- Get a -> ByteString -> Int -> Either String (a, ByteString)
forall a.
Get a -> ByteString -> Int -> Either String (a, ByteString)
runGetState Get a
decoder ByteString
bs Int
0
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
rest) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"could not decode " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
rest) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes from the end of the bytestring"
  a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

decodeElem :: Bool -> Get Elem
decodeElem :: Bool -> Get Elem
decodeElem Bool
nested =
  Get Word8
getWord8 Get Word8 -> (Word8 -> Get Elem) -> Get Elem
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
c
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nullCode Bool -> Bool -> Bool
&& Bool
nested -> Word8 -> Get ()
expectCode Word8
0xff Get () -> Get Elem -> Get Elem
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return Elem
None
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nullCode -> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return Elem
None
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bytesCode -> Get Elem
decodeBytesElem
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
stringCode -> Get Elem
decodeTextElem
      | Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
zeroCode Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
posEndCode -> Word8 -> Get Elem
decodeSmallPosInt Word8
c
      | Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
negStartCode Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
zeroCode -> Word8 -> Get Elem
decodeSmallNegInt Word8
c
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
posEndCode -> Get Elem
decodeLargePosInt
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
negStartCode -> Get Elem
decodeLargeNegInt
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
floatCode -> Get Elem
decodeFloatElem
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleCode -> Get Elem
decodeDoubleElem
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
trueCode -> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Elem
Bool Bool
True)
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
falseCode -> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Elem
Bool Bool
False)
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
uuidCode -> Get Elem
decodeUUIDElem
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nestedCode -> Get Elem
decodeTupleElem
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
versionstampCode -> Get Elem
decodeVersionstamp
    Word8
c -> String -> Get Elem
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Elem) -> String -> Get Elem
forall a b. (a -> b) -> a -> b
$ String
"got unknown tuple code: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c

expectCode :: Word8 -> Get ()
expectCode :: Word8 -> Get ()
expectCode Word8
c = do
  Word8
c' <- Get Word8
getWord8
  Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c')

bytesTerminator :: Get ()
bytesTerminator :: Get ()
bytesTerminator =
  do
    Int
n <- Get Int
remaining
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    Get () -> Get () -> Get ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
      Word8
c <- Get Word8
getWord8
      Int
n <- Get Int
remaining
      Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    Get () -> Get () -> Get ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
      Word8
c <- Get Word8
getWord8
      Word8
d <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
getWord8
      Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00 Bool -> Bool -> Bool
&& Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0xff)

-- | Reads all bytes up to (but not including) the terminator byte
getBytesUntilTerminator :: Get ByteString
getBytesUntilTerminator :: Get ByteString
getBytesUntilTerminator = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Get [Word8] -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8 -> Get [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get Word8
nonTerminator
  where
    nonTerminator :: Get Word8
nonTerminator = do
      Word8
a <- Get Word8
getWord8
      if Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
        then do
          Word8
b <- Get Word8
getWord8
          Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff)
          Word8 -> Get Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
0
        else do
          Word8 -> Get Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
a

decodeBytesElem :: Get Elem
decodeBytesElem :: Get Elem
decodeBytesElem =
  ByteString -> Elem
Bytes (ByteString -> Elem) -> Get ByteString -> Get Elem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get ByteString
getBytesUntilTerminator Get ByteString -> Get () -> Get ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
bytesTerminator)

decodeTextElem :: Get Elem
decodeTextElem :: Get Elem
decodeTextElem =
  Text -> Elem
Text (Text -> Elem) -> (ByteString -> Text) -> ByteString -> Elem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Elem) -> Get ByteString -> Get Elem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get ByteString
getBytesUntilTerminator Get ByteString -> Get () -> Get ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
bytesTerminator)

decodeSmallPosInt :: Word8 -> Get Elem
decodeSmallPosInt :: Word8 -> Get Elem
decodeSmallPosInt Word8
code = do
  let n :: Int
n = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
code Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
20
  ByteString
bs <- ([Word8] -> ByteString
BS.pack (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Word8
0x00) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
n
  let subres :: Either String Word64
subres = Get Word64 -> ByteString -> Either String Word64
forall a. Get a -> ByteString -> Either String a
runGet Get Word64
getWord64be ByteString
bs
  case Either String Word64
subres of
    Left String
e -> String -> Get Elem
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right Word64
x -> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> Get Elem) -> Elem -> Get Elem
forall a b. (a -> b) -> a -> b
$ Integer -> Elem
Int (Integer -> Elem) -> Integer -> Elem
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x

decodeSmallNegInt :: Word8 -> Get Elem
decodeSmallNegInt :: Word8 -> Get Elem
decodeSmallNegInt Word8
code = do
  let n :: Int
n = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
20 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
code
  ByteString
bs <- ([Word8] -> ByteString
BS.pack (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Word8
0x00) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
n
  let subres :: Either String Word64
subres = Get Word64 -> ByteString -> Either String Word64
forall a. Get a -> ByteString -> Either String a
runGet Get Word64
getWord64be ByteString
bs
  case Either String Word64
subres of
    Left String
e -> String -> Get Elem
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right Word64
x -> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> Get Elem) -> Elem -> Get Elem
forall a b. (a -> b) -> a -> b
$ Integer -> Elem
Int (Integer -> Elem) -> Integer -> Elem
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Array Int Integer
sizeLimits Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Int
n

decodeLargeNegInt :: Get Elem
decodeLargeNegInt :: Get Elem
decodeLargeNegInt = do
  (Int
n :: Int) <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (Word8 -> Word8) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0xff (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  Integer
val <- Int -> Int -> Integer -> Get Integer
forall t t. (Num t, Num t, Bits t, Eq t) => t -> t -> t -> Get t
go Int
0 Int
n Integer
0
  Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> Get Elem) -> Elem -> Get Elem
forall a b. (a -> b) -> a -> b
$ Integer -> Elem
Int (Integer
val Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
  where
    go :: t -> t -> t -> Get t
go !t
i !t
n !t
x
      | t
i t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
n = t -> Get t
forall (m :: * -> *) a. Monad m => a -> m a
return t
x
      | Bool
otherwise = do
        t
d <- Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> t) -> Get Word8 -> Get t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        t -> t -> t -> Get t
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t
n (t
d t -> t -> t
forall a. Num a => a -> a -> a
+ (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
8))

decodeLargePosInt :: Get Elem
decodeLargePosInt :: Get Elem
decodeLargePosInt = do
  (Int
n :: Int) <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  Int -> Int -> Integer -> Get Elem
forall t. (Eq t, Num t) => t -> t -> Integer -> Get Elem
go Int
0 Int
n Integer
0
  where
    go :: t -> t -> Integer -> Get Elem
go !t
i !t
n !Integer
x
      | t
i t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
n = Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> Get Elem) -> Elem -> Get Elem
forall a b. (a -> b) -> a -> b
$ Integer -> Elem
Int Integer
x
      | Bool
otherwise = do
        Integer
d <- Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Integer) -> Get Word8 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        t -> t -> Integer -> Get Elem
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t
n (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8))

decodeFloatElem :: Get Elem
decodeFloatElem :: Get Elem
decodeFloatElem = do
  ByteString
fBytes <- Bool -> ByteString -> ByteString
floatAdjust Bool
False (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
4
  let subres :: Either String Float
subres = Get Float -> ByteString -> Either String Float
forall a. Get a -> ByteString -> Either String a
runGet Get Float
getFloat32be ByteString
fBytes
  case Either String Float
subres of
    Left String
e -> String -> Get Elem
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right Float
x -> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> Get Elem) -> Elem -> Get Elem
forall a b. (a -> b) -> a -> b
$ Float -> Elem
Float Float
x

decodeDoubleElem :: Get Elem
decodeDoubleElem :: Get Elem
decodeDoubleElem = do
  ByteString
fBytes <- Bool -> ByteString -> ByteString
floatAdjust Bool
False (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
8
  let subres :: Either String Double
subres = Get Double -> ByteString -> Either String Double
forall a. Get a -> ByteString -> Either String a
runGet Get Double
getFloat64be ByteString
fBytes
  case Either String Double
subres of
    Left String
e -> String -> Get Elem
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right Double
x -> Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> Get Elem) -> Elem -> Get Elem
forall a b. (a -> b) -> a -> b
$ Double -> Elem
Double Double
x

decodeUUIDElem :: Get Elem
decodeUUIDElem :: Get Elem
decodeUUIDElem =
  Word32 -> Word32 -> Word32 -> Word32 -> Elem
UUID (Word32 -> Word32 -> Word32 -> Word32 -> Elem)
-> Get Word32 -> Get (Word32 -> Word32 -> Word32 -> Elem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
    Get (Word32 -> Word32 -> Word32 -> Elem)
-> Get Word32 -> Get (Word32 -> Word32 -> Elem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
    Get (Word32 -> Word32 -> Elem)
-> Get Word32 -> Get (Word32 -> Elem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
    Get (Word32 -> Elem) -> Get Word32 -> Get Elem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be

decodeTupleElem :: Get Elem
decodeTupleElem :: Get Elem
decodeTupleElem = do
  [Elem]
ts <- Get [Elem]
loop
  Word8
terminator <- Get Word8
getWord8
  Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
terminator Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
  Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return ([Elem] -> Elem
Tuple [Elem]
ts)
  where
    loop :: Get [Elem]
loop = do
      Bool
isEnd <- Get Bool
checkEnd
      if Bool
isEnd
        then [Elem] -> Get [Elem]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
          Elem
next <- Bool -> Get Elem
decodeElem Bool
True
          [Elem]
rest <- Get [Elem]
loop
          [Elem] -> Get [Elem]
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem
next Elem -> [Elem] -> [Elem]
forall a. a -> [a] -> [a]
: [Elem]
rest)

    checkEnd :: Get Bool
    checkEnd :: Get Bool
checkEnd = Get Bool -> Get Bool
forall a. Get a -> Get a
lookAhead (Get Bool -> Get Bool) -> Get Bool -> Get Bool
forall a b. (a -> b) -> a -> b
$ do
      Word8
c <- Get Word8
getWord8
      if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00
        then ((Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0xff) (Word8 -> Bool) -> Get Word8 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) Get Bool -> Get Bool -> Get Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

decodeVersionstamp :: Get Elem
decodeVersionstamp :: Get Elem
decodeVersionstamp = do
  Word64
tv <- Get Word64
getWord64be
  Word16
bo <- Get Word16
getWord16be
  Word16
uv <- Get Word16
getWord16be
  let tvs :: TransactionVersionstamp
tvs = Word64 -> Word16 -> TransactionVersionstamp
TransactionVersionstamp Word64
tv Word16
bo
  Elem -> Get Elem
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> Get Elem) -> Elem -> Get Elem
forall a b. (a -> b) -> a -> b
$ Versionstamp 'Complete -> Elem
CompleteVS (Versionstamp 'Complete -> Elem) -> Versionstamp 'Complete -> Elem
forall a b. (a -> b) -> a -> b
$ TransactionVersionstamp -> Word16 -> Versionstamp 'Complete
CompleteVersionstamp TransactionVersionstamp
tvs Word16
uv