fix max int tuple encoding

src/FoundationDB/Layer/Directory/Internal.hs

@@ -22,7 +22,7 @@ import FoundationDB.Layer.Directory.Internal.Node
 import FoundationDB.Layer.Subspace
 import qualified FoundationDB.Layer.Tuple as Tuple
 
-_SUBDIRS :: Int
+_SUBDIRS :: Integer
 _SUBDIRS = 0
 
 majorVersion, minorVersion, microVersion :: Word32

src/FoundationDB/Layer/Directory/Internal/HCA.hs

@@ -63,12 +63,13 @@ findStartAndWindow hca@HCA{..} windowAdvanced start = do
  else findStartAndWindow hca True (start + window)
 
  where getCount = do
+ let start' = fromIntegral start
  when windowAdvanced $ do
- clearRange (pack counters []) (pack counters [IntElem start])
+ clearRange (pack counters []) (pack counters [IntElem start'])
  setOption nextWriteNoWriteConflictRange
- clearRange (pack recent []) (pack recent [IntElem start])
- atomicOp Add (pack counters [IntElem start]) oneBytes
- withSnapshot $ get (pack counters [IntElem start])
+ clearRange (pack recent []) (pack recent [IntElem start'])
+ atomicOp Add (pack counters [IntElem start']) oneBytes
+ withSnapshot $ get (pack counters [IntElem start'])
 
  parseCount Nothing = return 0
  parseCount (Just bs) =
@@ -83,7 +84,7 @@ findSubspaceLoop :: HCA
  -> Transaction (Maybe Subspace)
 findSubspaceLoop hca@HCA{..} s start window = do
  candidate <- liftIO $ getStdRandom (randomR (start, start + window))
- let key = pack recent [IntElem candidate]
+ let key = pack recent [IntElem $ fromIntegral candidate]
  (latestCounter, candidateValueF) <- withAllocLock $ do
  latestCounter <- withSnapshot $ getLast counters
  candidateValueF <- get key
@@ -95,20 +96,20 @@ findSubspaceLoop hca@HCA{..} s start window = do
  Right (IntElem x:_) -> return x
  _ -> throwDirInternalError $ "bad counter format: " ++ show k
  _ -> throwDirInternalError "failed to find latestCounter"
- if currentStart > start
+ if currentStart > fromIntegral start
  then return Nothing
  else await candidateValueF >>= \case
  Just _ -> findSubspaceLoop hca s start window
  Nothing -> do
  addConflictRange key (key <> "0x00") ConflictRangeTypeWrite
- return $ Just $ extend s [IntElem candidate]
+ return $ Just $ extend s [IntElem $ fromIntegral candidate]
 
 initStart :: HCA -> Transaction Int
 initStart HCA{..} = do
  mkv <- withSnapshot $ getLast counters
  case mkv of
  Just (k,_) -> case unpack counters k of
- Right (IntElem start: _) -> return start
+ Right (IntElem start: _) -> return $ fromIntegral start
  _ -> return 0
  Nothing -> return 0
 

src/FoundationDB/Layer/Tuple/Internal.hs

@@ -56,10 +56,16 @@ data UUID = UUID Word32 Word32 Word32 Word32
 -- enforces this restriction.
 data Elem =
  NoneElem
+ -- ^ Corresponds to null or nil types in other language bindings.
+ | TupleElem [Elem]
+ -- ^ Nested tuples.
  | BytesElem ByteString
  | TextElem T.Text
- | TupleElem [Elem]
- | IntElem Int
+ | IntElem Integer
+ -- ^ 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.
  | FloatElem Float
  | DoubleElem Double
  | BoolElem Bool
@@ -72,12 +78,14 @@ deriving instance Ord Elem
 deriving instance Eq Elem
 deriving instance Generic Elem
 
-sizeLimits :: Array Int Int
-sizeLimits = A.listArray (0,7) [shiftL 1 (i*8) - 1 | i <- [0..7]]
+sizeLimits :: Array Int Integer
+sizeLimits = A.listArray (0,8) [shiftL 1 (i*8) - 1 | i <- [0..8]]
 
+-- TODO: dep on search algo lib is overkill for searching 9-elem array.
 -- | Returns smallest size limit greater than input.
-bisectSize :: Int -> Int
-bisectSize n = fromMaybe 8 $ searchFromTo (\x -> (sizeLimits A.! x) > n) 0 7
+bisectSize :: Integer -> Int
+bisectSize n =
+ fromMaybe 8 $ searchFromTo (\x -> (sizeLimits A.! x) > fromIntegral n) 0 8
 
 -- | Returns the minimum number of bits needed to encode the given int.
 bitLen :: Integral a => a -> Int
@@ -161,12 +169,12 @@ encodeBytes bs = mapM_ f (BS.unpack bs) >> putWord8 0x00
  f x = putWord8 x
 
 -- @truncatedInt n v@ returns the last n bytes of v, encoded big endian.
-truncatedInt :: Int -> Int -> ByteString
+truncatedInt :: Int -> Integer -> ByteString
 truncatedInt n v = BS.drop (8-n) (Put.runPut (Put.putWord64be $ fromIntegral v))
 
-encodePosInt :: Int -> PutTuple ()
+encodePosInt :: Integer -> PutTuple ()
 encodePosInt v =
- if v >= sizeLimits A.! 7
+ if fromIntegral v > sizeLimits A.! snd (A.bounds sizeLimits)
  then do let l = fromIntegral (bitLen v + 7 `div` 8)
  putWord8 posEndCode
  putWord8 l
@@ -176,9 +184,9 @@ encodePosInt v =
  putWord8 (zeroCode + fromIntegral n)
  putByteString $ truncatedInt n v
 
-encodeNegInt :: Int -> PutTuple ()
+encodeNegInt :: Integer -> PutTuple ()
 encodeNegInt v =
- if negate v >= sizeLimits A.! 7
+ if fromIntegral (negate v) > sizeLimits A.! snd (A.bounds sizeLimits)
  then do let l = fromIntegral (bitLen v + 7 `div` 8)
  let v' = fromIntegral $ v + (1 `shiftL` fromIntegral (8*l)) - 1
  putWord8 negStartCode
@@ -379,19 +387,19 @@ decodeLargeNegInt = do
  (n :: Int) <- fromIntegral . xor 0xff <$> getWord8
  go 0 n 0
 
- where go i n x | i == n = return $ IntElem x
- | otherwise = do d <- fromIntegral <$> getWord8
- go (i+1) n (d + (x `shiftL` 8))
+ where go !i !n !x | i == n = return $ IntElem x
+  | otherwise = do d <- fromIntegral <$> getWord8
+  go (i+1) n (d + (x `shiftL` 8))
 
 decodeLargePosInt :: Get Elem
 decodeLargePosInt = do
  expectCode posEndCode
  (n :: Int) <- fromIntegral <$> getWord8
  go 0 n 0
 
- where go i n x | i == n = return $ IntElem x
- | otherwise = do d <- fromIntegral <$> getWord8
- go (i+1) n (d + (x `shiftL` 8))
+ where go !i !n !x | i == n = return $ IntElem x
+  | otherwise = do d <- fromIntegral <$> getWord8
+  go (i+1) n (d + (x `shiftL` 8))
 
 decodeIntElem :: Get Elem
 decodeIntElem =

tests/Properties/FoundationDB/Layer/Tuple.hs

@@ -8,6 +8,7 @@ module Properties.FoundationDB.Layer.Tuple where
 import FoundationDB.Layer.Tuple.Internal
 import FoundationDB.Versionstamp
 
+import Control.Monad (forM_)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Data.Maybe (fromJust)
@@ -90,7 +91,7 @@ exampleZero :: ByteString
 exampleZero = BS.pack [20]
 
 exampleLargeInt :: ByteString
-exampleLargeInt = BS.pack [24, 7, 91, 205, 21]
+exampleLargeInt = "\x1c\x7f\xff\xff\xff\xff\xff\xff\xff"
 
 exampleFloat :: ByteString
 exampleFloat = " \xbf\xc0\x00\x00"
@@ -123,6 +124,48 @@ encodeDecode elems encoded desc = do
  it ("decodes " ++ desc) $
  decodeTupleElems encoded `shouldBe` Right elems
 
+describeIntegerTypeCodes :: SpecWith ()
+describeIntegerTypeCodes = do
+ let codes = [0x0c..0x1c]
+ let byteLengths = [-8..8]
+ forM_ (zip codes byteLengths) go
+
+ where
+ go (code, 0) = do
+ let encoded = encodeTupleElems [IntElem 0]
+ describe "Encoding 0" $
+ it ("Uses expected code " ++ show code)
+ (BS.unpack encoded `shouldBe` [code])
+
+ go (code, byteLength) = do
+ let sign = fromIntegral $ signum byteLength
+ let numBits = 8 * abs byteLength - 1
+ let num = sign * 2^numBits - 1 :: Integer
+ let encoded = encodeTupleElems [IntElem num]
+ describe ("Encoding "
+ ++ (if sign > 0 then "positive " else "negative ")
+ ++ show (abs byteLength)
+ ++ "-byte int: "
+ ++ show sign
+ ++ " * 2^"
+ ++ show numBits
+ ++ " - 1"
+ ++ " = "
+ ++ show num) $ do
+ it ("Uses expected code " ++ show code)
+ (BS.head encoded `shouldBe` code)
+ it "Uses correct number of bytes" $
+ BS.length encoded `shouldBe` abs byteLength + 1
+
+issue12 :: SpecWith ()
+issue12 = describe "Max 8-byte encoded ints" $ do
+ it "encodes 2^64 - 1 correctly" $
+ encodeTupleElems [IntElem $ 2^64 - 1]
+ `shouldBe` "\x1c\xff\xff\xff\xff\xff\xff\xff\xff"
+ it "encodes - 2^64 - 1 correctly" $
+ encodeTupleElems [IntElem $ negate $ 2^64 - 1]
+ `shouldBe` "\x0c\x00\x00\x00\x00\x00\x00\x00\x00"
+
 encodeDecodeSpecs :: SpecWith ()
 encodeDecodeSpecs = describe "Tuple encoding" $ do
  encodeDecode [] exampleEmpty "empty tuples"
@@ -132,7 +175,7 @@ encodeDecodeSpecs = describe "Tuple encoding" $ do
  encodeDecode [IntElem 1] examplePosInt "postive int"
  encodeDecode [IntElem (-5)] exampleNegInt "negative int"
  encodeDecode [IntElem 0] exampleZero "zero"
- encodeDecode [IntElem 123456789] exampleLargeInt "large int"
+ encodeDecode [IntElem (2 ^ (63 :: Int) - 1)] exampleLargeInt "large int"
  encodeDecode [FloatElem 1.5] exampleFloat "float"
  encodeDecode [DoubleElem 1.5] exampleDouble "double"
  encodeDecode [BoolElem True] exampleTrue "True"
@@ -153,6 +196,8 @@ encodeDecodeSpecs = describe "Tuple encoding" $ do
  -- no encodeDecode for incomplete version stamps because the encoding adds
  -- two bytes at the end that the C FFI bindings remove. The Python code
  -- doesn't roundtrip either.
+ describeIntegerTypeCodes
+ issue12
 
 encodeDecodeProps :: SpecWith ()
 encodeDecodeProps = prop "decode . encode == id" $