TOSQUASH

IntersectMBO · Apr 30, 2024 · fa1d907 · fa1d907
1 parent 640e4fe
commit fa1d907
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 65 deletions.
diff --git a/src-extras/Database/LSMTree/Extras/Orphans.hs b/src-extras/Database/LSMTree/Extras/Orphans.hs
@@ -44,21 +44,19 @@ instance SerialiseKey Word256 where
       ba <- P.newByteArray 32
       P.writeByteArray ba 0 $ byteSwapWord256 w256
       return ba
-  deserialiseKey (RawBytes (PV.Vector off len ba))
-    | len >= expected = byteSwapWord256 $ indexWord8ArrayAsWord256 ba off
-    | otherwise = error $ deserialiseKeyInputBytesNotPrecise "Word256" len expected
-    where expected = 32
+  deserialiseKey (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "Word256" 32 len $
+      byteSwapWord256 $ indexWord8ArrayAsWord256 ba off
 
 instance SerialiseValue Word256 where
   serialiseValue w256 =
     RB.RawBytes $ mkPrimVector 0 32 $ P.runByteArray $ do
       ba <- P.newByteArray 32
       P.writeByteArray ba 0 w256
       return ba
-  deserialiseValue (RawBytes (PV.Vector off len ba))
-    | len >= expected = indexWord8ArrayAsWord256 ba off
-    | otherwise = error $ deserialiseValueInputBytesNotPrecise "Word256" len expected
-    where expected = 32
+  deserialiseValue (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "Word256" 32 len $
+      indexWord8ArrayAsWord256 ba off
   deserialiseValueN = deserialiseValue . mconcat -- TODO: optimise
 
 instance Arbitrary Word256 where
@@ -96,21 +94,19 @@ instance SerialiseKey Word128 where
       ba <- P.newByteArray 16
       P.writeByteArray ba 0 $ byteSwapWord128 w128
       return ba
-  deserialiseKey (RawBytes (PV.Vector off len ba))
-    | len >= expected = byteSwapWord128 $ indexWord8ArrayAsWord128 ba off
-    | otherwise = error $ deserialiseKeyInputBytesNotPrecise "Word128" len expected
-    where expected = 16
+  deserialiseKey (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "Word128" 16 len $
+      byteSwapWord128 $ indexWord8ArrayAsWord128 ba off
 
 instance SerialiseValue Word128 where
   serialiseValue w128 =
     RB.RawBytes $ mkPrimVector 0 16 $ P.runByteArray $ do
       ba <- P.newByteArray 16
       P.writeByteArray ba 0 w128
       return ba
-  deserialiseValue (RawBytes (PV.Vector off len ba))
-    | len >= expected = indexWord8ArrayAsWord128 ba off
-    | otherwise = error $ deserialiseValueInputBytesNotPrecise "Word128" len expected
-    where expected = 16
+  deserialiseValue (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "Word128" 16 len $
+      indexWord8ArrayAsWord128 ba off
   deserialiseValueN = deserialiseValue . mconcat -- TODO: optimise
 
 instance Arbitrary Word128 where

diff --git a/src-extras/Database/LSMTree/Extras/UTxO.hs b/src-extras/Database/LSMTree/Extras/UTxO.hs
@@ -47,13 +47,10 @@ instance SerialiseKey UTxOKey where
       P.writeByteArray ba 0 $ byteSwapWord256 txId
       P.writeByteArray ba 16 $ byteSwap16 txIx
       return ba
-  deserialiseKey (RawBytes (PV.Vector off len ba))
-    | len == expected
-    = UTxOKey (byteSwapWord256 $ indexWord8ArrayAsWord256 ba off)
+  deserialiseKey (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "UTxOKey" 34 len $
+      UTxOKey (byteSwapWord256 $ indexWord8ArrayAsWord256 ba off)
               (byteSwap16      $ indexWord8ArrayAsWord16  ba (off + 32))
-    | otherwise
-    = error $ deserialiseKeyInputBytesNotPrecise "UTxOKey" len expected
-    where expected = 34
 
 instance Arbitrary UTxOKey where
   arbitrary = UTxOKey <$> arbitrary <*> arbitrary
@@ -82,15 +79,12 @@ instance SerialiseValue UTxOValue where
       P.writeByteArray ba 6 utxoValue64
       P.writeByteArray ba 14 utxoValue32
       return ba
-  deserialiseValue (RawBytes (PV.Vector off len ba))
-    | len >= expected
-    = UTxOValue (indexWord8ArrayAsWord256 ba off)
+  deserialiseValue (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "UTxOValue" 60 len $
+      UTxOValue (indexWord8ArrayAsWord256 ba off)
                 (indexWord8ArrayAsWord128 ba (off + 32))
                 (indexWord8ArrayAsWord64  ba (off + 48))
                 (indexWord8ArrayAsWord32  ba (off + 56))
-    | otherwise
-    = error $ deserialiseValueInputBytesNotPrecise "UTxOValue" len expected
-    where expected = 60
   deserialiseValueN = deserialiseValue . mconcat -- TODO: optimise
 
 instance Arbitrary UTxOValue where

diff --git a/src/Database/LSMTree/Internal/Serialise/Class.hs b/src/Database/LSMTree/Internal/Serialise/Class.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE MagicHash           #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications    #-}
-
 -- | Public API for serialisation of keys, blobs and values
 module Database.LSMTree.Internal.Serialise.Class (
     SerialiseKey (..)
@@ -15,9 +11,8 @@ module Database.LSMTree.Internal.Serialise.Class (
   , serialiseValueConcatDistributes
   , RawBytes (..)
   , packSlice
-    -- * Error messages
-  , deserialiseKeyInputBytesNotPrecise
-  , deserialiseValueInputBytesNotPrecise
+    -- * Errors
+  , requireBytesExactly
   ) where
 
 import qualified Data.ByteString as BS
@@ -34,9 +29,6 @@ import           Database.LSMTree.Internal.Primitive (indexWord8ArrayAsWord64)
 import           Database.LSMTree.Internal.RawBytes (RawBytes (..))
 import qualified Database.LSMTree.Internal.RawBytes as RB
 import           Database.LSMTree.Internal.Vector
-import           GHC.Exts (Int (..), indexWord8ArrayAsWord64#)
-import           GHC.Show (showSpace)
-import           GHC.Word (Word64 (..))
 import           Numeric (showInt)
 
 -- | Serialisation of keys.
@@ -127,27 +119,22 @@ packSlice prefix x suffix =
     RB.take (RB.size x) (RB.drop (RB.size prefix) (prefix <> x <> suffix))
 
 {-------------------------------------------------------------------------------
-  Error messages
+  Errors
 -------------------------------------------------------------------------------}
 
-inputBytesNotPrecisely :: String -> String -> Int -> Int -> String
-inputBytesNotPrecisely funcName tyName actual expected =
-      showString funcName
-    . showSpace
-    . showParen True (showString tyName)
-    . showString ": expected "
-    . showInt actual
-    . showString " bytes, but got "
-    . showInt expected
-    $ ""
-
--- | @'serialiseKeyInputBytesNotPrecise' tyName actual expected@
-deserialiseKeyInputBytesNotPrecise :: String -> Int -> Int -> String
-deserialiseKeyInputBytesNotPrecise = inputBytesNotPrecisely "deserialiseKey"
-
--- | @'serialiseValueInputBytesNotPrecise' tyName actual expected@
-deserialiseValueInputBytesNotPrecise :: String -> Int -> Int -> String
-deserialiseValueInputBytesNotPrecise = inputBytesNotPrecisely "deserialiseValue"
+-- | @'requireBytesExactly' tyName expected actual x@
+requireBytesExactly :: String -> Int -> Int -> a -> a
+requireBytesExactly tyName expected actual x
+  | expected == actual = x
+  | otherwise          =
+        error
+      $ showString "deserialise "
+      . showString tyName
+      . showString ": expected "
+      . showInt expected
+      . showString " bytes, but got "
+      . showInt actual
+      $ ""
 
 {-------------------------------------------------------------------------------
   Word64
@@ -160,10 +147,8 @@ instance SerialiseKey Word64 where
       P.writeByteArray ba 0 $ byteSwap64 x
       return ba
 
-  deserialiseKey (RawBytes (PV.Vector (I# off#) len (P.ByteArray ba#)))
-    | len >= expected = byteSwap64 (W64# (indexWord8ArrayAsWord64# ba# off# ))
-    | otherwise = error $ deserialiseKeyInputBytesNotPrecise "Word64" len expected
-    where expected = 8
+  deserialiseKey (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "Word64" 8 len $ byteSwap64 (indexWord8ArrayAsWord64 ba off)
 
 instance SerialiseValue Word64 where
   serialiseValue x =
@@ -172,10 +157,8 @@ instance SerialiseValue Word64 where
       P.writeByteArray ba 0 x
       return ba
 
-  deserialiseValue (RawBytes (PV.Vector off len ba))
-    | len >= expected = indexWord8ArrayAsWord64 ba off
-    | otherwise = error $ deserialiseValueInputBytesNotPrecise "Word64" len expected
-    where expected = 8
+  deserialiseValue (RawBytes (PV.Vector off len ba)) =
+    requireBytesExactly "Word64" 8 len $ indexWord8ArrayAsWord64 ba off
   deserialiseValueN = deserialiseValue . mconcat
 
 {-------------------------------------------------------------------------------