git.iko.soy/streamly
on cedc81c help sign in
streamly/core/src/Streamly/Internal/Data/Serialize.hs
265 lines 9.7 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Serialize
3-- Copyright : (c) 2023 Composewell Technologies
4-- License : BSD3-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Portability : GHC
7--
9module Streamly.Internal.Data.Serialize
10 ( Serialize(..)
11 , encode
12 , pinnedEncode
13 , decode
14 ) where
16--------------------------------------------------------------------------------
17-- Imports
18--------------------------------------------------------------------------------
20#include "assert.hs"
22#ifdef DEBUG
23import Control.Exception (assert)
24#endif
26import Control.Monad (void)
27import Data.List (foldl')
28import Data.Proxy (Proxy (..))
29import Streamly.Internal.Data.Unbox
30 ( MutableByteArray(..)
31 , PinnedState(..)
32 , Unbox
33 )
34import Streamly.Internal.Data.Array.Type (Array(..))
35import Streamly.Internal.System.IO (unsafeInlineIO)
36import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
37import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))
38import GHC.Stable (StablePtr(..))
40import qualified Streamly.Internal.Data.Unbox as Unbox
41import qualified Streamly.Internal.Data.Array as Array
43import GHC.Exts
45--------------------------------------------------------------------------------
46-- Types
47--------------------------------------------------------------------------------
49-- | A type implementing the 'Serialize' interface supplies operations for
50-- reading and writing the type from and to a mutable byte array (an unboxed
51-- representation of the type) in memory. The read operation 'deserialize'
52-- deserializes the boxed type from the mutable byte array. The write operation
53-- 'serialize' serializes the boxed type to the mutable byte array.
54--
55-- IMPORTANT: The serialized data's byte ordering is not normalized, which means
56-- it remains the same as the machine's byte order where the function is
57-- executed. Consequently, it may not be compatible across machines with
58-- different byte ordering.
59--
60-- 'Serialize' contains enough information to serialize and deserialize variable
61-- length types.
62--
63-- >>> import Streamly.Internal.Data.Serialize (Serialize(..))
64--
65-- >>> :{
66-- data Object = Object
67-- { _obj1 :: [Int]
68-- , _obj2 :: Int
69-- }
70-- :}
71--
72-- >>> :{
73-- instance Serialize Object where
74-- size acc obj = size (size acc (_obj1 obj)) (_obj2 obj)
75-- deserialize i arr len = do
76-- (i1, x0) <- deserialize i arr len
77-- (i2, x1) <- deserialize i1 arr len
78-- pure (i2, Object x0 x1)
79-- serialize i arr (Object x0 x1) = do
80-- i1 <- serialize i arr x0
81-- i2 <- serialize i1 arr x1
82-- pure i2
83-- :}
84--
85class Serialize a where
86 -- XXX Use (a -> Sum Int) instead, remove the Size type
88 -- A left fold step to fold a generic structure to its serializable size.
89 -- It is of the form @Int -> a -> Int@ because you can have tail-recursive
90 -- traversal of the structures.
92 -- | Get the size, in bytes, reqired to store the serialized
93 -- representation of the type. Size cannot be zero.
94 size :: Int -> a -> Int
96 -- We can implement the following functions without returning the `Int`
97 -- offset but that may require traversing the Haskell structure again to get
98 -- the size. Therefore, this is a performance optimization.
100 -- | @deserialize offset array arrayLen@ deserializes a value from the
101 -- given byte-index in the array. Returns a tuple of the next byte-index
102 -- and the deserialized value.
103 deserialize :: Int -> MutableByteArray -> Int -> IO (Int, a)
105 -- | Write the serialized representation of the value in the array at the
106 -- given byte-index. Returns the next byte-index. This is an unsafe
107 -- operation, the programmer must ensure that the array has enough space
108 -- available in the array to serialize the value as determined by the
109 -- @size@ operation.
110 serialize :: Int -> MutableByteArray -> a -> IO Int
112--------------------------------------------------------------------------------
113-- Instances
114--------------------------------------------------------------------------------
116-- XXX We do not need to pass the end of data offset, we can just check the
117-- mutable array end here to avoid a crash, and when we return from deserialize
118-- we can check if the offset returned is beyond the bound or not.
119--
120#ifdef DEBUG
121{-# INLINE checkBounds #-}
122checkBounds :: String -> Int -> MutableByteArray -> IO ()
123checkBounds _label _off _arr = do
124 sz <- sizeOfMutableByteArray _arr
125 if (_off > sz)
126 then error
127 $ _label
128 ++ ": accessing array at offset = "
129 ++ show (_off - 1)
130 ++ " max valid offset = " ++ show (sz - 1)
131 else return ()
132#endif
134-- Note: Instead of passing around the size parameter, we can use
135-- (sizeOfMutableByteArray arr) for checking the array bound, but that turns
136-- out to be more expensive.
137--
138-- Another way to optimize this is to avoid the check for fixed size
139-- structures. For fixed size structures we can do a check at the top level and
140-- then use checkless deserialization using the Unbox type class. That will
141-- require ConstSize and VarSize constructors in size. The programmer can
142-- bundle all const size fields in a newtype to make serialization faster. This
143-- can speed up the computation of size when serializing and checking size when
144-- deserialing.
145--
146-- For variable size non-recursive structures a separate size validation method
147-- could be used to validate the size before deserializing. "validate" can also
148-- be used to collpase multiple chunks of arrays coming from network into a
149-- single array for deserializing. But that can also be done by framing the
150-- serialized value with a size header.
151--
152{-# INLINE deserializeUnsafe #-}
153deserializeUnsafe :: forall a. Unbox a => Int -> MutableByteArray -> Int -> IO (Int, a)
154deserializeUnsafe off arr sz =
155 let next = off + Unbox.sizeOf (Proxy :: Proxy a)
156 in do
157 -- Keep likely path in the straight branch.
158 if (next <= sz)
159 then Unbox.peekByteIndex off arr >>= \val -> pure (next, val)
160 else error
161 $ "deserialize: accessing array at offset = "
162 ++ show (next - 1)
163 ++ " max valid offset = " ++ show (sz - 1)
165{-# INLINE serializeUnsafe #-}
166serializeUnsafe :: forall a. Unbox a => Int -> MutableByteArray -> a -> IO Int
167serializeUnsafe off arr val =
168 let next = off + Unbox.sizeOf (Proxy :: Proxy a)
169 in do
170#ifdef DEBUG
171 checkBounds "serialize" next arr
172#endif
173 Unbox.pokeByteIndex off arr val
174 pure next
176#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \
177instance Serialize _type where \
178; {-# INLINE size #-} \
179; size acc _ = acc + Unbox.sizeOf (Proxy :: Proxy _type) \
180; {-# INLINE deserialize #-} \
181; deserialize off arr end = deserializeUnsafe off arr end :: IO (Int, _type) \
182; {-# INLINE serialize #-} \
183; serialize = \
184 serializeUnsafe :: Int -> MutableByteArray -> _type -> IO Int
186DERIVE_SERIALIZE_FROM_UNBOX(Bool)
187DERIVE_SERIALIZE_FROM_UNBOX(Char)
188DERIVE_SERIALIZE_FROM_UNBOX(Int8)
189DERIVE_SERIALIZE_FROM_UNBOX(Int16)
190DERIVE_SERIALIZE_FROM_UNBOX(Int32)
191DERIVE_SERIALIZE_FROM_UNBOX(Int)
192DERIVE_SERIALIZE_FROM_UNBOX(Int64)
193DERIVE_SERIALIZE_FROM_UNBOX(Word)
194DERIVE_SERIALIZE_FROM_UNBOX(Word8)
195DERIVE_SERIALIZE_FROM_UNBOX(Word16)
196DERIVE_SERIALIZE_FROM_UNBOX(Word32)
197DERIVE_SERIALIZE_FROM_UNBOX(Word64)
198DERIVE_SERIALIZE_FROM_UNBOX(Double)
199DERIVE_SERIALIZE_FROM_UNBOX(Float)
200DERIVE_SERIALIZE_FROM_UNBOX((StablePtr a))
201DERIVE_SERIALIZE_FROM_UNBOX((Ptr a))
202DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a))
204instance forall a. Serialize a => Serialize [a] where
206 -- {-# INLINE size #-}
207 size acc xs = foldl' size (acc + (Unbox.sizeOf (Proxy :: Proxy Int))) xs
209 -- Inlining this causes large compilation times for tests
210 {-# INLINABLE deserialize #-}
211 deserialize off arr sz = do
212 (off1, len) <- deserialize off arr sz :: IO (Int, Int)
213 let
214 peekList f o i | i >= 3 = do
215 -- Unfold the loop three times
216 (o1, x1) <- deserialize o arr sz
217 (o2, x2) <- deserialize o1 arr sz
218 (o3, x3) <- deserialize o2 arr sz
219 peekList (f . (\xs -> x1:x2:x3:xs)) o3 (i - 3)
220 peekList f o 0 = pure (o, f [])
221 peekList f o i = do
222 (o1, x) <- deserialize o arr sz
223 peekList (f . (x:)) o1 (i - 1)
224 peekList id off1 len
226 -- Inlining this causes large compilation times for tests
227 {-# INLINABLE serialize #-}
228 serialize off arr val = do
229 void $ serialize off arr (length val)
230 let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int)
231 let pokeList o [] = pure o
232 pokeList o (x:xs) = do
233 o1 <- serialize o arr x
234 pokeList o1 xs
235 pokeList off1 val
237--------------------------------------------------------------------------------
238-- High level functions
239--------------------------------------------------------------------------------
241{-# INLINE encodeAs #-}
242encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8
243encodeAs ps a =
244 unsafeInlineIO $ do
245 let len = size 0 a
246 mbarr <- Unbox.newBytesAs ps len
247 off <- serialize 0 mbarr a
248 assertM(len == off)
249 pure $ Array mbarr 0 off
251{-# INLINE encode #-}
252encode :: Serialize a => a -> Array Word8
253encode = encodeAs Unpinned
255{-# INLINE pinnedEncode #-}
256pinnedEncode :: Serialize a => a -> Array Word8
257pinnedEncode = encodeAs Pinned
259{-# INLINE decode #-}
260decode :: Serialize a => Array Word8 -> a
261decode arr@(Array {..}) = unsafeInlineIO $ do
262 let lenArr = Array.length arr
263 (off, val) <- deserialize 0 arrContents lenArr
264 assertM(lenArr == off)
265 pure val