76a6db5 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add debug mode array bound checks to Unbox methods

76a6db5Harendra Kumar3 years ago

core/src/Streamly/Internal/Data/Serialize/Type.hs+5−8

compare with master

unifiedsplit

@@ -151,20 +151,17 @@ class Serialize a where

151-- Instances

152--------------------------------------------------------------------------------

153

154−-- XXX We do not need to pass the end of data offset, we can just check the

154+-- _size is the length from array start to the last accessed byte.

155−-- mutable array end here to avoid a crash, and when we return from deserialize

156−-- we can check if the offset returned is beyond the bound or not.

157−--

158#ifdef DEBUG

155#ifdef DEBUG

159{-# INLINE checkBounds #-}

156{-# INLINE checkBounds #-}

160checkBounds :: String -> Int -> MutByteArray -> IO ()

157checkBounds :: String -> Int -> MutByteArray -> IO ()

161−checkBounds _label _off _arr = do

158+checkBounds _label _size _arr = do

162− sz <- sizeOfMutableByteArray _arr

159+ sz <- MBA.sizeOfMutableByteArray _arr

163− if (_off > sz)

160+ if (_size > sz)

164 then error

161 then error

165 $ _label

162 $ _label

166 ++ ": accessing array at offset = "

163 ++ ": accessing array at offset = "

167− ++ show (_off - 1)

164+ ++ show (_size - 1)

168 ++ " max valid offset = " ++ show (sz - 1)

165 ++ " max valid offset = " ++ show (sz - 1)

169 else return ()

166 else return ()

170#endif

167#endif

core/src/Streamly/Internal/Data/Unbox.hs+71−38

@@ -47,9 +47,6 @@ import Data.Functor.Const (Const(..))

47import Data.Functor.Identity (Identity(..))

48import Data.Kind (Type)

49import Data.Proxy (Proxy (..))

50−#ifdef DEBUG

51−import Debug.Trace (trace)

52−#endif

53import Foreign.Ptr (IntPtr(..), WordPtr(..))

50import Foreign.Ptr (IntPtr(..), WordPtr(..))

54import GHC.Base (IO(..))

51import GHC.Base (IO(..))

55import GHC.Fingerprint.Type (Fingerprint(..))

52import GHC.Fingerprint.Type (Fingerprint(..))

@@ -68,6 +65,9 @@ import GHC.TypeLits

68import Prelude hiding (read)

65import Prelude hiding (read)

70import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))

67import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))

68+#ifdef DEBUG

69+import Streamly.Internal.Data.MutByteArray.Type (sizeOfMutableByteArray)

70+#endif

72--------------------------------------------------------------------------------

73-- The Unbox type class

@@ -266,43 +266,66 @@ class Unbox a where

266{-# DEPRECATED peekByteIndex "Use peekAt." #-}

267{-# DEPRECATED pokeByteIndex "Use pokeAt." #-}

268

269−-- XXX Add asserts to check bounds

269+-- _size is the length from array start to the last accessed byte.

270+{-# INLINE checkBounds #-}

271+checkBounds :: String -> Int -> MutByteArray -> IO ()

272+checkBounds _label _size _arr = do

273+#ifdef DEBUG

274+ sz <- sizeOfMutableByteArray _arr

275+ if (_size > sz)

276+ then error

277+ $ _label

278+ ++ ": accessing array at offset = "

279+ ++ show (_size - 1)

280+ ++ " max valid offset = " ++ show (sz - 1)

281+ else return ()

282+#else

283+ return ()

284+#endif

270

285

271#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \

286#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \

272−instance Unbox _type where { \

287+instance Unbox _type where { \

273−; {-# INLINE peekAt #-} \

288+; {-# INLINE peekAt #-} \

274−; peekAt (I# n) (MutByteArray mbarr) = IO $ \s -> \

289+; peekAt off@(I# n) arr@(MutByteArray mbarr) = \

290+ checkBounds "peek" (off + sizeOf (Proxy :: Proxy _type)) arr \

291+ >> (IO $ \s -> \

275− case _readArray mbarr n s of \

292+ case _readArray mbarr n s of \

276− { (# s1, i #) -> (# s1, _constructor i #) } \

293+ { (# s1, i #) -> (# s1, _constructor i #) }) \

277−; {-# INLINE pokeAt #-} \

294+; {-# INLINE pokeAt #-} \

278−; pokeAt (I# n) (MutByteArray mbarr) (_constructor val) = \

295+; pokeAt off@(I# n) arr@(MutByteArray mbarr) (_constructor val) = \

296+ checkBounds "poke" (off + sizeOf (Proxy :: Proxy _type)) arr \

279− IO $ \s -> (# _writeArray mbarr n val s, () #) \

297+ >> (IO $ \s -> (# _writeArray mbarr n val s, () #)) \

280−; {-# INLINE sizeOf #-} \

298+; {-# INLINE sizeOf #-} \

281−; sizeOf _ = _sizeOf \

299+; sizeOf _ = _sizeOf \

282}

300}

283

301

284#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType) \

302#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType) \

285instance _constraint Unbox _type where \

303instance _constraint Unbox _type where \

286−; {-# INLINE peekAt #-} \

304+; {-# INLINE peekAt #-} \

305+; peekAt i arr = \

306+ checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr \

287−; peekAt i arr = _constructor <$> peekAt i arr \

307+ >> _constructor <$> peekAt i arr \

288−; {-# INLINE pokeAt #-} \

308+; {-# INLINE pokeAt #-} \

289−; pokeAt i arr (_constructor a) = pokeAt i arr a \

309+; pokeAt i arr (_constructor a) = \

310+ checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr \

311+ >> pokeAt i arr a \

290; {-# INLINE sizeOf #-} \

312; {-# INLINE sizeOf #-} \

291; sizeOf _ = SIZE_OF(_innerType)

313; sizeOf _ = SIZE_OF(_innerType)

292

314

293−#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \

315+#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \

294−instance _constraint Unbox _type where { \

316+instance _constraint Unbox _type where { \

295−; {-# INLINE peekAt #-} \

317+; {-# INLINE peekAt #-} \

296−; peekAt i arr = \

318+; peekAt i arr = \

319+ checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr >> \

297− peekAt i arr >>= \

320+ peekAt i arr >>= \

298− (\p1 -> peekAt (i + SIZE_OF(_innerType)) arr \

321+ (\p1 -> peekAt (i + SIZE_OF(_innerType)) arr <&> _constructor p1) \

299− <&> _constructor p1) \

300−; {-# INLINE pokeAt #-} \

322+; {-# INLINE pokeAt #-} \

301−; pokeAt i arr (_constructor p1 p2) = \

323+; pokeAt i arr (_constructor p1 p2) = \

324+ checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr >> \

302− pokeAt i arr p1 >> \

325+ pokeAt i arr p1 >> \

303− pokeAt (i + SIZE_OF(_innerType)) arr p2 \

326+ pokeAt (i + SIZE_OF(_innerType)) arr p2 \

304−; {-# INLINE sizeOf #-} \

327+; {-# INLINE sizeOf #-} \

305−; sizeOf _ = 2 * SIZE_OF(_innerType) \

328+; sizeOf _ = 2 * SIZE_OF(_innerType) \

306}

329}

307

330

308-------------------------------------------------------------------------------

331-------------------------------------------------------------------------------

@@ -423,10 +446,12 @@ DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)

423instance Unbox () where

446instance Unbox () where

424

447

425 {-# INLINE peekAt #-}

448 {-# INLINE peekAt #-}

426− peekAt _ _ = return ()

449+ peekAt i arr =

450+ checkBounds "peek ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()

427

451

428 {-# INLINE pokeAt #-}

452 {-# INLINE pokeAt #-}

429− pokeAt _ _ _ = return ()

453+ pokeAt i arr _ =

454+ checkBounds "poke ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()

430

455

431 {-# INLINE sizeOf #-}

456 {-# INLINE sizeOf #-}

432 sizeOf _ = 1

457 sizeOf _ = 1

@@ -435,10 +460,16 @@ instance Unbox () where

435instance Unbox IoSubSystem where

460instance Unbox IoSubSystem where

436

461

437 {-# INLINE peekAt #-}

462 {-# INLINE peekAt #-}

463+ peekAt i arr =

464+ checkBounds

465+ "peek IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr

438− peekAt i arr = toEnum <$> peekAt i arr

466+ >> toEnum <$> peekAt i arr

439

467

440 {-# INLINE pokeAt #-}

468 {-# INLINE pokeAt #-}

469+ pokeAt i arr a =

470+ checkBounds

471+ "poke IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr

441− pokeAt i arr a = pokeAt i arr (fromEnum a)

472+ >> pokeAt i arr (fromEnum a)

442

473

443 {-# INLINE sizeOf #-}

474 {-# INLINE sizeOf #-}

444 sizeOf _ = sizeOf (Proxy :: Proxy Int)

475 sizeOf _ = sizeOf (Proxy :: Proxy Int)

@@ -448,14 +479,16 @@ instance Unbox Bool where

448

479

449 {-# INLINE peekAt #-}

480 {-# INLINE peekAt #-}

450 peekAt i arr = do

481 peekAt i arr = do

482+ checkBounds "peek Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr

451 res <- peekAt i arr

483 res <- peekAt i arr

452 return $ res /= (0 :: Int8)

484 return $ res /= (0 :: Int8)

453

485

454 {-# INLINE pokeAt #-}

486 {-# INLINE pokeAt #-}

455 pokeAt i arr a =

487 pokeAt i arr a =

488+ checkBounds "poke Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr

456− if a

489+ >> if a

457− then pokeAt i arr (1 :: Int8)

490+ then pokeAt i arr (1 :: Int8)

458− else pokeAt i arr (0 :: Int8)

491+ else pokeAt i arr (0 :: Int8)

459

492

460 {-# INLINE sizeOf #-}

493 {-# INLINE sizeOf #-}

461 sizeOf _ = 1

494 sizeOf _ = 1