diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Changelog for `mempack`
+
+## 0.1.0.0
+
+* Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Alexey Kuleshevich (c) 2024
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Alexey Kuleshevich nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,22 @@
+# mempack
+
+## Overview
+
+Extremely efficient serialization library that works on pinned and unpinned memory alike.
+
+## Status
+
+| Github Actions | Coveralls | Hackage | Nightly | LTS |
+|:--------------:|:---------:|:-------:|:-------:|:---:|
+| [![Build Status][GA-badge]][GA-link] | [![Coverage Status][Coveralls-badge]][Coveralls-link] | [![Hackage][Hackage-badge]][Hackage-link] | [![Nightly][Nightly-badge]][Nightly-link] | [![LTS][LTS-badge]][LTS-link]
+
+[GA-badge]: https://github.com/lehins/mempack/workflows/CI/badge.svg
+[GA-link]: https://github.com/lehins/mempack/actions
+[Coveralls-badge]: https://coveralls.io/repos/github/lehins/mempack/badge.svg?branch=master
+[Coveralls-link]: https://coveralls.io/github/lehins/mempack?branch=master
+[Hackage-badge]: https://img.shields.io/hackage/v/mempack.svg
+[Hackage-link]: https://hackage.haskell.org/package/mempack
+[Nightly-badge]: https://www.stackage.org/package/mempack/badge/nightly
+[Nightly-link]: https://www.stackage.org/nightly/package/mempack
+[LTS-badge]: https://www.stackage.org/package/mempack/badge/lts
+[LTS-link]: https://www.stackage.org/lts/package/mempack
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,4 @@
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/bench/Bench.hs b/bench/Bench.hs
new file mode 100644
--- /dev/null
+++ b/bench/Bench.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import qualified Codec.Serialise as Serialise
+import Criterion.Main
+import qualified Data.Binary as Binary
+import Data.ByteString.Lazy (fromStrict, toStrict)
+import Data.ByteString.Short (fromShort, toShort)
+import Data.MemPack
+import qualified Data.Serialize as Cereal
+import qualified Data.Store as Store
+import qualified Flat as Flat
+
+main :: IO ()
+main = do
+  defaultMain
+    [ env (pure [1 :: Int .. 100000]) $ \xs ->
+        bgroup
+          "Pack"
+          [ bgroup
+              "ByteString"
+              [ bench "MemPack" $ nf packByteString xs
+              , bench "Store" $ nf Store.encode xs
+              , bench "Flat" $ nf Flat.flat xs
+              , bench "Cereal" $ nf Cereal.encode xs
+              , bench "Binary" $ nf (toStrict . Binary.encode) xs
+              , bench "Serialise" $ nf (toStrict . Serialise.serialise) xs
+              ]
+          ]
+    , env (pure [1 :: Int .. 100000]) $ \xs ->
+        bgroup
+          "RoundTrip"
+          [ bgroup
+              "ByteString"
+              [ bench "MemPack" $ nf (unpackError @[Int] . packByteString) xs
+              , bench "Store" $ nf (Store.decodeEx @[Int] . Store.encode) xs
+              , bench "Flat" $ nf (either (error . show) id . Flat.unflat @[Int] . Flat.flat) xs
+              , bench "Cereal" $ nf (either (error . show) id . Cereal.decode @[Int] . Cereal.encode) xs
+              , bench "Binary" $ nf (Binary.decode @[Int] . fromStrict . toStrict . Binary.encode) xs
+              , bench "Serialise" $
+                  nf (Serialise.deserialiseOrFail @[Int] . fromStrict . toStrict . Serialise.serialise) xs
+              ]
+          , bgroup
+              "ShortByteString"
+              [ bench "MemPack" $ nf (unpackError @[Int] . packShortByteString) xs
+              , bench "Store" $ nf (Store.decodeEx @[Int] . fromShort . toShort . Store.encode) xs
+              , bench "Flat" $
+                  nf (either (error . show) id . Flat.unflat @[Int] . fromShort . toShort . Flat.flat) xs
+              , bench "Cereal" $
+                  nf (either (error . show) id . Cereal.decode @[Int] . fromShort . toShort . Cereal.encode) xs
+              , bench "Binary" $
+                  nf
+                    ( Binary.decode @[Int]
+                        . fromStrict
+                        . fromShort
+                        . toShort
+                        . toStrict
+                        . Binary.encode
+                    )
+                    xs
+              , bench "Serialise" $
+                  nf
+                    ( Serialise.deserialiseOrFail @[Int]
+                        . fromStrict
+                        . fromShort
+                        . toShort
+                        . toStrict
+                        . Serialise.serialise
+                    )
+                    xs
+              ]
+          ]
+    ]
diff --git a/mempack.cabal b/mempack.cabal
new file mode 100644
--- /dev/null
+++ b/mempack.cabal
@@ -0,0 +1,96 @@
+name:                mempack
+version:             0.1.0.0
+synopsis:            Short description
+description:         Please see the README on GitHub at <https://github.com/lehins/mempack#readme>
+homepage:            https://github.com/lehins/mempack
+license:             BSD3
+license-file:        LICENSE
+author:              Alexey Kuleshevich
+maintainer:          alexey@kuleshevi.ch
+copyright:           2024 Alexey Kuleshevich
+category:            Algorithms
+build-type:          Simple
+extra-source-files:  README.md
+                   , CHANGELOG.md
+cabal-version:       1.18
+tested-with:         GHC == 8.6.5
+                   , GHC == 8.8.4
+                   , GHC == 8.10.7
+                   , GHC == 9.0.2
+                   , GHC == 9.2.8
+                   , GHC == 9.4.8
+                   , GHC == 9.6.6
+                   , GHC == 9.8.2
+                   , GHC == 9.10.1
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Data.MemPack
+                     , Data.MemPack.Buffer
+                     , Data.MemPack.Error
+
+  other-modules:
+  build-depends:       base >= 4.12 && < 5
+                     , bytestring
+                     , FailT
+                     , mtl
+                     , text
+  if !impl(ghc >= 9.4)
+    build-depends:     data-array-byte
+  if !impl(ghc >= 9.0)
+    build-depends:     integer-gmp
+
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+                       -Wincomplete-record-updates
+                       -Wincomplete-uni-patterns
+                       -Wredundant-constraints
+
+test-suite tests
+  type:               exitcode-stdio-1.0
+  hs-source-dirs:     tests
+  main-is:            Main.hs
+  other-modules:      Test.Common
+                    , Test.MemPackSpec
+  build-depends:      base
+                    , bytestring
+                    , FailT
+                    , hspec
+                    , mempack
+                    , mtl
+                    , QuickCheck
+                    , random >=1.2.1
+  if !impl(ghc >= 9.4)
+    build-depends:     data-array-byte
+
+  default-language:   Haskell2010
+  ghc-options:        -Wall
+                      -Wincomplete-record-updates
+                      -Wincomplete-uni-patterns
+                      -Wredundant-constraints
+                      -fno-warn-orphans
+                      -threaded
+                      -with-rtsopts=-N2
+
+benchmark bench
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      bench
+  main-is:             Bench.hs
+  ghc-options:         -Wall
+                       -threaded
+                       -O2
+                       -with-rtsopts=-N
+  build-depends:       base
+                     , binary
+                     , bytestring
+                     , cereal
+                     , criterion
+                     , flat
+                     , mempack
+                     , serialise
+                     , store
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/lehins/mempack
diff --git a/src/Data/MemPack.hs b/src/Data/MemPack.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/MemPack.hs
@@ -0,0 +1,1293 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+-- |
+-- Module      : Data.MemPack
+-- Copyright   : (c) Alexey Kuleshevich 2024
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
+-- Stability   : experimental
+-- Portability : non-portable
+module Data.MemPack (
+  Pack (..),
+  Unpack (..),
+  MemPack (..),
+
+  -- * Packing
+  pack,
+  packByteArray,
+  packByteString,
+  packShortByteString,
+  packMutableByteArray,
+
+  -- ** Helpers
+  packIncrement,
+  guardAdvanceUnpack,
+
+  -- * Unpacking
+  unpack,
+  unpackFail,
+  unpackMonadFail,
+  unpackError,
+  unpackLeftOver,
+
+  -- ** Helpers
+  failUnpack,
+  unpackByteArray,
+
+  -- * Helper packers
+  VarLen (..),
+  Length (..),
+  Tag (..),
+  packTagM,
+  unpackTagM,
+  unknownTagM,
+  packedTagByteCount,
+
+  -- * Internal utilities
+  replicateTailM,
+  lift_#,
+  st_,
+
+  -- * Re-exports for @GeneralizedNewtypeDeriving@
+  StateT (..),
+  FailT (..),
+) where
+
+#include "MachDeps.h"
+
+import Control.Applicative (Alternative (..))
+import Control.Monad (join, unless, when)
+import qualified Control.Monad.Fail as F
+import Control.Monad.Reader (MonadReader (..), lift)
+import Control.Monad.State.Strict (MonadState (..), StateT (..), execStateT)
+import Control.Monad.Trans.Fail (Fail, FailT (..), errorFail, failT, runFailAgg)
+import Data.Array.Byte (ByteArray (..), MutableByteArray (..))
+import Data.Bifunctor (first)
+import Data.Bits (Bits (..), FiniteBits (..))
+import Data.ByteString (ByteString)
+import Data.ByteString.Short (ShortByteString)
+import Data.Char (ord)
+import Data.Complex (Complex (..))
+import Data.List (intercalate)
+import Data.MemPack.Buffer
+import Data.MemPack.Error
+import Data.Ratio
+import Data.Semigroup (Sum (..))
+import Data.Typeable
+import GHC.Exts
+import GHC.Int
+import GHC.ST (ST (..), runST)
+import GHC.Stable (StablePtr (..))
+import GHC.Stack (HasCallStack)
+import GHC.Word
+import Numeric (showHex)
+import Prelude hiding (fail)
+#if __GLASGOW_HASKELL__ >= 900
+import GHC.Num.Integer (Integer (..), integerCheck)
+import GHC.Num.Natural (Natural (..), naturalCheck)
+#elif defined(MIN_VERSION_integer_gmp)
+import GHC.Integer.GMP.Internals (Integer (..), BigNat(BN#), isValidInteger#)
+import GHC.Natural (Natural (..), isValidNatural)
+#else
+#error "Only integer-gmp is supported for now for older compilers"
+#endif
+#if !(MIN_VERSION_base(4,13,0))
+import Prelude (fail)
+#endif
+
+-- | Monad that is used for serializing data into a `MutableByteArray`. It is based on
+-- `StateT` that tracks the current index into the `MutableByteArray` where next write is
+-- expected to happen.
+newtype Pack s a = Pack
+  { runPack :: MutableByteArray s -> StateT Int (ST s) a
+  }
+
+instance Functor (Pack s) where
+  fmap f (Pack p) = Pack $ \buf -> fmap f (p buf)
+  {-# INLINE fmap #-}
+instance Applicative (Pack s) where
+  pure = Pack . const . pure
+  {-# INLINE pure #-}
+  Pack a1 <*> Pack a2 =
+    Pack $ \buf -> a1 buf <*> a2 buf
+  {-# INLINE (<*>) #-}
+  Pack a1 *> Pack a2 =
+    Pack $ \buf -> a1 buf *> a2 buf
+  {-# INLINE (*>) #-}
+instance Monad (Pack s) where
+  Pack m1 >>= p =
+    Pack $ \buf -> m1 buf >>= \res -> runPack (p res) buf
+  {-# INLINE (>>=) #-}
+instance MonadReader (MutableByteArray s) (Pack s) where
+  ask = Pack pure
+  {-# INLINE ask #-}
+  local f (Pack p) = Pack (p . f)
+  {-# INLINE local #-}
+  reader f = Pack (pure . f)
+  {-# INLINE reader #-}
+instance MonadState Int (Pack s) where
+  get = Pack $ const get
+  {-# INLINE get #-}
+  put = Pack . const . put
+  {-# INLINE put #-}
+  state = Pack . const . state
+  {-# INLINE state #-}
+
+-- | Monad that is used for deserializing data from a memory `Buffer`. It is based on
+-- `StateT` that tracks the current index into the @`Buffer` a@, from where the next read
+-- suppose to happen. Unpacking can `F.fail` with `F.MonadFail` instance or with
+-- `failUnpack` that provides a more type safe way of failing using `Error` interface.
+newtype Unpack b a = Unpack
+  { runUnpack :: b -> StateT Int (Fail SomeError) a
+  }
+
+instance Functor (Unpack s) where
+  fmap f (Unpack p) = Unpack $ \buf -> fmap f (p buf)
+  {-# INLINE fmap #-}
+instance Applicative (Unpack b) where
+  pure = Unpack . const . pure
+  {-# INLINE pure #-}
+  Unpack a1 <*> Unpack a2 =
+    Unpack $ \buf -> a1 buf <*> a2 buf
+  {-# INLINE (<*>) #-}
+  Unpack a1 *> Unpack a2 =
+    Unpack $ \buf -> a1 buf *> a2 buf
+  {-# INLINE (*>) #-}
+instance Monad (Unpack b) where
+  Unpack m1 >>= p =
+    Unpack $ \buf -> m1 buf >>= \res -> runUnpack (p res) buf
+  {-# INLINE (>>=) #-}
+#if !(MIN_VERSION_base(4,13,0))
+  fail = Unpack . const . F.fail
+#endif
+instance F.MonadFail (Unpack b) where
+  fail = Unpack . const . F.fail
+instance MonadReader b (Unpack b) where
+  ask = Unpack pure
+  {-# INLINE ask #-}
+  local f (Unpack p) = Unpack (p . f)
+  {-# INLINE local #-}
+  reader f = Unpack (pure . f)
+  {-# INLINE reader #-}
+instance MonadState Int (Unpack b) where
+  get = Unpack $ const get
+  {-# INLINE get #-}
+  put = Unpack . const . put
+  {-# INLINE put #-}
+  state = Unpack . const . state
+  {-# INLINE state #-}
+
+instance Alternative (Unpack b) where
+  empty = Unpack $ \_ -> lift empty
+  {-# INLINE empty #-}
+  Unpack r1 <|> Unpack r2 =
+    Unpack $ \buf ->
+      case r1 buf of
+        StateT m1 ->
+          case r2 buf of
+            StateT m2 -> StateT $ \s -> m1 s <|> m2 s
+  {-# INLINE (<|>) #-}
+
+-- | Failing unpacking with an `Error`.
+failUnpack :: Error e => e -> Unpack b a
+failUnpack e = Unpack $ \_ -> lift $ failT (toSomeError e)
+
+-- | Efficient serialization interface that operates directly on memory buffers.
+class MemPack a where
+  -- | Name of the type that is being deserialized for error reporting. Default
+  -- implementation relies on `Typeable`.
+  typeName :: String
+  default typeName :: Typeable a => String
+  typeName = show (typeRep (Proxy @a))
+
+  -- | Report the exact size in number of bytes that packed version of this type will
+  -- occupy. It is very important to get this right, otherwise `packM` will result in a
+  -- runtime exception. Another words this is the expected property that it should hold:
+  --
+  -- prop> packedByteCount a == bufferByteCount (pack a)
+  packedByteCount :: a -> Int
+
+  -- | Write binary representation of a type into the `MutableByteArray` which can be
+  -- accessed with `ask`, whenever direct operations on it are necessary.
+  packM :: a -> Pack s ()
+
+  -- | Read binary representation of the type directly from the buffer, which can be
+  -- accessed with `ask` when necessary. Direct reads from the buffer should be preceded
+  -- with advancing the buffer offset with `MonadState` by the number of bytes that will
+  -- be consumed from the buffer and making sure that no reads outside of the buffer can
+  -- happen. Violation of these rules will lead to segfaults.
+  unpackM :: Buffer b => Unpack b a
+
+instance MemPack () where
+  packedByteCount _ = 0
+  {-# INLINE packedByteCount #-}
+  packM _ = pure ()
+  {-# INLINE packM #-}
+  unpackM = pure ()
+  {-# INLINE unpackM #-}
+
+instance MemPack Bool where
+  packedByteCount _ = packedTagByteCount
+  {-# INLINE packedByteCount #-}
+  packM x = packTagM $ if x then 1 else 0
+  {-# INLINE packM #-}
+  unpackM =
+    unpackTagM >>= \case
+      0 -> pure False
+      1 -> pure True
+      n -> F.fail $ "Invalid value detected for Bool: " ++ show n
+  {-# INLINE unpackM #-}
+
+instance MemPack a => MemPack (Maybe a) where
+  typeName = "Maybe " ++ typeName @a
+  packedByteCount = \case
+    Nothing -> packedTagByteCount
+    Just a -> packedTagByteCount + packedByteCount a
+  {-# INLINE packedByteCount #-}
+  packM = \case
+    Nothing -> packTagM 0
+    Just a -> packTagM 1 >> packM a
+  {-# INLINE packM #-}
+  unpackM =
+    unpackTagM >>= \case
+      0 -> pure Nothing
+      1 -> Just <$> unpackM
+      n -> unknownTagM @(Maybe a) n
+  {-# INLINE unpackM #-}
+
+instance (MemPack a, MemPack b) => MemPack (Either a b) where
+  typeName = "Either " ++ typeName @a ++ " " ++ typeName @b
+  packedByteCount = \case
+    Left a -> packedTagByteCount + packedByteCount a
+    Right b -> packedTagByteCount + packedByteCount b
+  {-# INLINE packedByteCount #-}
+  packM = \case
+    Left a -> packTagM 0 >> packM a
+    Right b -> packTagM 1 >> packM b
+  {-# INLINE packM #-}
+  unpackM =
+    unpackTagM >>= \case
+      0 -> Left <$> unpackM
+      1 -> Right <$> unpackM
+      n -> unknownTagM @(Either a b) n
+  {-# INLINE unpackM #-}
+
+instance MemPack Char where
+  packedByteCount _ = SIZEOF_HSCHAR
+  {-# INLINE packedByteCount #-}
+  packM a@(C# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsWideChar# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_HSCHAR
+    buf <- ask
+    let c =
+          buffer
+            buf
+            (\ba# -> C# (indexWord8ArrayAsWideChar# ba# i#))
+            (\addr# -> C# (indexWideCharOffAddr# (addr# `plusAddr#` i#) 0#))
+    when (ord c > 0x10FFFF) $
+      F.fail $
+        "Out of bounds Char was detected: '\\x" ++ showHex (fromEnum c) "'"
+    pure c
+  {-# INLINE unpackM #-}
+
+instance MemPack Float where
+  packedByteCount _ = SIZEOF_FLOAT
+  {-# INLINE packedByteCount #-}
+  packM a@(F# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsFloat# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_FLOAT
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> F# (indexWord8ArrayAsFloat# ba# i#))
+        (\addr# -> F# (indexFloatOffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Double where
+  packedByteCount _ = SIZEOF_DOUBLE
+  {-# INLINE packedByteCount #-}
+  packM a@(D# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsDouble# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_DOUBLE
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> D# (indexWord8ArrayAsDouble# ba# i#))
+        (\addr# -> D# (indexDoubleOffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack (Ptr a) where
+  typeName = "Ptr"
+  packedByteCount _ = SIZEOF_HSPTR
+  {-# INLINE packedByteCount #-}
+  packM a@(Ptr a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsAddr# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_HSPTR
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> Ptr (indexWord8ArrayAsAddr# ba# i#))
+        (\addr# -> Ptr (indexAddrOffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack (StablePtr a) where
+  typeName = "StablePtr"
+  packedByteCount _ = SIZEOF_HSSTABLEPTR
+  {-# INLINE packedByteCount #-}
+  packM a@(StablePtr a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsStablePtr# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_HSSTABLEPTR
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> StablePtr (indexWord8ArrayAsStablePtr# ba# i#))
+        (\addr# -> StablePtr (indexStablePtrOffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Int where
+  packedByteCount _ = SIZEOF_HSINT
+  {-# INLINE packedByteCount #-}
+  packM a@(I# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsInt# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_HSINT
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> I# (indexWord8ArrayAsInt# ba# i#))
+        (\addr# -> I# (indexIntOffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Int8 where
+  packedByteCount _ = SIZEOF_INT8
+  {-# INLINE packedByteCount #-}
+  packM a@(I8# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeInt8Array# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_INT8
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> I8# (indexInt8Array# ba# i#))
+        (\addr# -> I8# (indexInt8OffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Int16 where
+  packedByteCount _ = SIZEOF_INT16
+  {-# INLINE packedByteCount #-}
+  packM a@(I16# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsInt16# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    buf <- ask
+    I# i# <- guardAdvanceUnpack SIZEOF_INT16
+    pure $!
+      buffer
+        buf
+        (\ba# -> I16# (indexWord8ArrayAsInt16# ba# i#))
+        (\addr# -> I16# (indexInt16OffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Int32 where
+  packedByteCount _ = SIZEOF_INT32
+  {-# INLINE packedByteCount #-}
+  packM a@(I32# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsInt32# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    buf <- ask
+    I# i# <- guardAdvanceUnpack SIZEOF_INT32
+    pure $!
+      buffer
+        buf
+        (\ba# -> I32# (indexWord8ArrayAsInt32# ba# i#))
+        (\addr# -> I32# (indexInt32OffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Int64 where
+  packedByteCount _ = SIZEOF_INT64
+  {-# INLINE packedByteCount #-}
+  packM a@(I64# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsInt64# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    buf <- ask
+    I# i# <- guardAdvanceUnpack SIZEOF_INT64
+    pure $!
+      buffer
+        buf
+        (\ba# -> I64# (indexWord8ArrayAsInt64# ba# i#))
+        (\addr# -> I64# (indexInt64OffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Word where
+  packedByteCount _ = SIZEOF_HSWORD
+  {-# INLINE packedByteCount #-}
+  packM a@(W# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsWord# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_HSWORD
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> W# (indexWord8ArrayAsWord# ba# i#))
+        (\addr# -> W# (indexWordOffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Word8 where
+  packedByteCount _ = SIZEOF_WORD8
+  {-# INLINE packedByteCount #-}
+  packM a@(W8# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8Array# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_WORD8
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> W8# (indexWord8Array# ba# i#))
+        (\addr# -> W8# (indexWord8OffAddr# addr# i#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Word16 where
+  packedByteCount _ = SIZEOF_WORD16
+  {-# INLINE packedByteCount #-}
+  packM a@(W16# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsWord16# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    buf <- ask
+    I# i# <- guardAdvanceUnpack SIZEOF_WORD16
+    pure $!
+      buffer
+        buf
+        (\ba# -> W16# (indexWord8ArrayAsWord16# ba# i#))
+        (\addr# -> W16# (indexWord16OffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Word32 where
+  packedByteCount _ = SIZEOF_WORD32
+  {-# INLINE packedByteCount #-}
+  packM a@(W32# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsWord32# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_WORD32
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> W32# (indexWord8ArrayAsWord32# ba# i#))
+        (\addr# -> W32# (indexWord32OffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+instance MemPack Word64 where
+  packedByteCount _ = SIZEOF_WORD64
+  {-# INLINE packedByteCount #-}
+  packM a@(W64# a#) = do
+    MutableByteArray mba# <- ask
+    I# i# <- packIncrement a
+    lift_# (writeWord8ArrayAsWord64# mba# i# a#)
+  {-# INLINE packM #-}
+  unpackM = do
+    I# i# <- guardAdvanceUnpack SIZEOF_WORD64
+    buf <- ask
+    pure $!
+      buffer
+        buf
+        (\ba# -> W64# (indexWord8ArrayAsWord64# ba# i#))
+        (\addr# -> W64# (indexWord64OffAddr# (addr# `plusAddr#` i#) 0#))
+  {-# INLINE unpackM #-}
+
+#if __GLASGOW_HASKELL__ >= 900
+instance MemPack Integer where
+  packedByteCount =
+    (+ packedTagByteCount) . \case
+      IS i# -> packedByteCount (I# i#)
+      IP ba# -> packedByteCount (ByteArray ba#)
+      IN ba# -> packedByteCount (ByteArray ba#)
+  {-# INLINE packedByteCount #-}
+  packM = \case
+    IS i# -> packTagM 0 >> packM (I# i#)
+    IP ba# -> packTagM 1 >> packM (ByteArray ba#)
+    IN ba# -> packTagM 2 >> packM (ByteArray ba#)
+  {-# INLINE packM #-}
+  unpackM = do
+    i <-
+      unpackTagM >>= \case
+        0 -> do
+          I# i# <- unpackM
+          pure $ IS i#
+        1 -> do
+          ByteArray ba# <- unpackM
+          pure $ IP ba#
+        2 -> do
+          ByteArray ba# <- unpackM
+          pure $ IN ba#
+        t -> unknownTagM @Integer t
+    unless (integerCheck i) $ F.fail $ "Invalid Integer decoded " ++ showInteger i
+    pure i
+    where
+      showInteger = \case
+        IS i# -> "IS " ++ show (I# i#)
+        IP ba# -> "IP " ++ show (ByteArray ba#)
+        IN ba# -> "IN " ++ show (ByteArray ba#)
+  {-# INLINE unpackM #-}
+
+instance MemPack Natural where
+  packedByteCount =
+    (+ packedTagByteCount) . \case
+      NS w# -> packedByteCount (W# w#)
+      NB ba# -> packedByteCount (ByteArray ba#)
+  {-# INLINE packedByteCount #-}
+  packM = \case
+    NS w# -> packTagM 0 >> packM (W# w#)
+    NB ba# -> packTagM 1 >> packM (ByteArray ba#)
+  {-# INLINE packM #-}
+  unpackM = do
+    n <-
+      unpackTagM >>= \case
+        0 -> do
+          W# w# <- unpackM
+          pure $ NS w#
+        1 -> do
+          ByteArray ba# <- unpackM
+          pure $ NB ba#
+        t -> unknownTagM @Natural t
+    unless (naturalCheck n) $ F.fail $ "Invalid Natural decoded " ++ showNatural n
+    pure n
+    where
+      showNatural = \case
+        NS w# -> "NS " ++ show (W# w#)
+        NB ba# -> "NB " ++ show (ByteArray ba#)
+  {-# INLINE unpackM #-}
+
+#elif defined(MIN_VERSION_integer_gmp)
+
+instance MemPack Integer where
+  packedByteCount =
+    (+ packedTagByteCount) . \case
+      S# i# -> packedByteCount (I# i#)
+      Jp# (BN# ba#) -> packedByteCount (ByteArray ba#)
+      Jn# (BN# ba#) -> packedByteCount (ByteArray ba#)
+  {-# INLINE packedByteCount #-}
+  packM = \case
+    S# i# -> packTagM 0 >> packM (I# i#)
+    Jp# (BN# ba#) -> packTagM 1 >> packM (ByteArray ba#)
+    Jn# (BN# ba#) -> packTagM 2 >> packM (ByteArray ba#)
+  {-# INLINE packM #-}
+  unpackM = do
+    i <-
+      unpackTagM >>= \case
+        0 -> do
+          I# i# <- unpackM
+          pure $ S# i#
+        1 -> do
+          ByteArray ba# <- unpackM
+          pure $ Jp# (BN# ba#)
+        2 -> do
+          ByteArray ba# <- unpackM
+          pure $ Jn# (BN# ba#)
+        t -> unknownTagM @Integer t
+    unless (isTrue# (isValidInteger# i)) $ F.fail $ "Invalid Integer decoded " ++ showInteger i
+    pure i
+    where
+      showInteger = \case
+        S# i# -> "S# " ++ show (I# i#)
+        Jp# (BN# ba#) -> "Jp# " ++ show (ByteArray ba#)
+        Jn# (BN# ba#) -> "Jn# " ++ show (ByteArray ba#)
+  {-# INLINE unpackM #-}
+
+instance MemPack Natural where
+  packedByteCount =
+    (+ packedTagByteCount) . \case
+      NatS# w# -> packedByteCount (W# w#)
+      NatJ# (BN# ba#) -> packedByteCount (ByteArray ba#)
+  {-# INLINE packedByteCount #-}
+  packM = \case
+    NatS# w# -> packTagM 0 >> packM (W# w#)
+    NatJ# (BN# ba#) -> packTagM 1 >> packM (ByteArray ba#)
+  {-# INLINE packM #-}
+  unpackM = do
+    n <-
+      unpackTagM >>= \case
+        0 -> do
+          W# w# <- unpackM
+          pure $ NatS# w#
+        1 -> do
+          ByteArray ba# <- unpackM
+          pure $ NatJ# (BN# ba#)
+        t -> unknownTagM @Natural t
+    unless (isValidNatural n) $ F.fail $ "Invalid Natural decoded " ++ showNatural n
+    pure n
+    where
+      showNatural = \case
+        NatS# w# -> "NatS# " ++ show (W# w#)
+        NatJ# (BN#  ba#) -> "NatJ# " ++ show (ByteArray ba#)
+  {-# INLINE unpackM #-}
+
+#endif
+
+instance MemPack a => MemPack (Complex a) where
+  typeName = "Complex " ++ typeName @a
+  packedByteCount (a :+ b) = packedByteCount a + packedByteCount b
+  {-# INLINE packedByteCount #-}
+  packM (a :+ b) = packM a >> packM b
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    pure (a :+ b)
+  {-# INLINE unpackM #-}
+
+instance (MemPack a, Integral a) => MemPack (Ratio a) where
+  typeName = "Ratio " ++ typeName @a
+  packedByteCount r = packedByteCount (numerator r) + packedByteCount (denominator r)
+  {-# INLINE packedByteCount #-}
+  packM r = packM (numerator r) >> packM (denominator r)
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    when (b == 0) $ F.fail $ "Zero denominator was detected when unpacking " ++ typeName @(Ratio a)
+    pure (a % b)
+  {-# INLINE unpackM #-}
+
+instance (MemPack a, MemPack b) => MemPack (a, b) where
+  typeName = "(" ++ typeName @a ++ "," ++ typeName @b ++ ")"
+  packedByteCount (a, b) = packedByteCount a + packedByteCount b
+  {-# INLINE packedByteCount #-}
+  packM (a, b) = packM a >> packM b
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    pure (a, b)
+  {-# INLINE unpackM #-}
+
+instance (MemPack a, MemPack b, MemPack c) => MemPack (a, b, c) where
+  typeName = "(" ++ typeName @a ++ "," ++ typeName @b ++ "," ++ typeName @c ++ ")"
+  packedByteCount (a, b, c) = packedByteCount a + packedByteCount b + packedByteCount c
+  {-# INLINE packedByteCount #-}
+  packM (a, b, c) = packM a >> packM b >> packM c
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    !c <- unpackM
+    pure (a, b, c)
+  {-# INLINE unpackM #-}
+
+instance (MemPack a, MemPack b, MemPack c, MemPack d) => MemPack (a, b, c, d) where
+  typeName = "(" ++ typeName @a ++ "," ++ typeName @b ++ "," ++ typeName @c ++ "," ++ typeName @d ++ ")"
+  packedByteCount (a, b, c, d) = packedByteCount a + packedByteCount b + packedByteCount c + packedByteCount d
+  {-# INLINE packedByteCount #-}
+  packM (a, b, c, d) =
+    packM a >> packM b >> packM c >> packM d
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    !c <- unpackM
+    !d <- unpackM
+    pure (a, b, c, d)
+  {-# INLINE unpackM #-}
+
+instance (MemPack a, MemPack b, MemPack c, MemPack d, MemPack e) => MemPack (a, b, c, d, e) where
+  typeName =
+    "("
+      ++ intercalate
+        ","
+        [ typeName @a
+        , typeName @b
+        , typeName @c
+        , typeName @d
+        , typeName @e
+        ]
+      ++ ")"
+  packedByteCount (a, b, c, d, e) =
+    packedByteCount a + packedByteCount b + packedByteCount c + packedByteCount d + packedByteCount e
+  {-# INLINE packedByteCount #-}
+  packM (a, b, c, d, e) =
+    packM a >> packM b >> packM c >> packM d >> packM e
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    !c <- unpackM
+    !d <- unpackM
+    !e <- unpackM
+    pure (a, b, c, d, e)
+  {-# INLINE unpackM #-}
+
+instance (MemPack a, MemPack b, MemPack c, MemPack d, MemPack e, MemPack f) => MemPack (a, b, c, d, e, f) where
+  typeName =
+    "("
+      ++ intercalate
+        ","
+        [ typeName @a
+        , typeName @b
+        , typeName @c
+        , typeName @d
+        , typeName @e
+        , typeName @f
+        ]
+      ++ ")"
+  packedByteCount (a, b, c, d, e, f) =
+    packedByteCount a
+      + packedByteCount b
+      + packedByteCount c
+      + packedByteCount d
+      + packedByteCount e
+      + packedByteCount f
+  {-# INLINE packedByteCount #-}
+  packM (a, b, c, d, e, f) =
+    packM a >> packM b >> packM c >> packM d >> packM e >> packM f
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    !c <- unpackM
+    !d <- unpackM
+    !e <- unpackM
+    !f <- unpackM
+    pure (a, b, c, d, e, f)
+  {-# INLINE unpackM #-}
+
+instance
+  (MemPack a, MemPack b, MemPack c, MemPack d, MemPack e, MemPack f, MemPack g) =>
+  MemPack (a, b, c, d, e, f, g)
+  where
+  typeName =
+    "("
+      ++ intercalate
+        ","
+        [ typeName @a
+        , typeName @b
+        , typeName @c
+        , typeName @d
+        , typeName @e
+        , typeName @f
+        , typeName @g
+        ]
+      ++ ")"
+  packedByteCount (a, b, c, d, e, f, g) =
+    packedByteCount a
+      + packedByteCount b
+      + packedByteCount c
+      + packedByteCount d
+      + packedByteCount e
+      + packedByteCount f
+      + packedByteCount g
+  {-# INLINE packedByteCount #-}
+  packM (a, b, c, d, e, f, g) =
+    packM a >> packM b >> packM c >> packM d >> packM e >> packM f >> packM g
+  {-# INLINE packM #-}
+  unpackM = do
+    !a <- unpackM
+    !b <- unpackM
+    !c <- unpackM
+    !d <- unpackM
+    !e <- unpackM
+    !f <- unpackM
+    !g <- unpackM
+    pure (a, b, c, d, e, f, g)
+  {-# INLINE unpackM #-}
+
+instance MemPack a => MemPack [a] where
+  typeName = "[" ++ typeName @a ++ "]"
+  packedByteCount es = packedByteCount (Length (length es)) + getSum (foldMap (Sum . packedByteCount) es)
+  {-# INLINE packedByteCount #-}
+  packM as = do
+    packM (Length (length as))
+    mapM_ packM as
+  {-# INLINE packM #-}
+  unpackM = do
+    Length n <- unpackM
+    replicateTailM n unpackM
+  {-# INLINE unpackM #-}
+
+-- | Tail recursive version of `replicateM`
+replicateTailM :: Monad m => Int -> m a -> m [a]
+replicateTailM n f = go n []
+  where
+    go i !acc
+      | i <= 0 = pure $ reverse acc
+      | otherwise = f >>= \x -> go (i - 1) (x : acc)
+{-# INLINE replicateTailM #-}
+
+instance MemPack ByteArray where
+  packedByteCount ba =
+    let len = bufferByteCount ba
+     in packedByteCount (Length len) + len
+  {-# INLINE packedByteCount #-}
+  packM ba@(ByteArray ba#) = do
+    let !len@(I# len#) = bufferByteCount ba
+    packM (Length len)
+    I# curPos# <- state $ \i -> (i, i + len)
+    MutableByteArray mba# <- ask
+    lift_# (copyByteArray# ba# 0# mba# curPos# len#)
+  {-# INLINE packM #-}
+  unpackM = unpackByteArray False
+  {-# INLINE unpackM #-}
+
+instance MemPack ShortByteString where
+  packedByteCount ba =
+    let len = bufferByteCount ba
+     in packedByteCount (Length len) + len
+  {-# INLINE packedByteCount #-}
+  packM = packM . byteArrayFromShortByteString
+  {-# INLINE packM #-}
+  unpackM = byteArrayToShortByteString <$> unpackByteArray False
+  {-# INLINE unpackM #-}
+
+instance MemPack ByteString where
+  packedByteCount ba =
+    let len = bufferByteCount ba
+     in packedByteCount (Length len) + len
+  {-# INLINE packedByteCount #-}
+  packM bs = do
+    let !len@(I# len#) = bufferByteCount bs
+    packM (Length len)
+    I# curPos# <- state $ \i -> (i, i + len)
+    Pack $ \(MutableByteArray mba#) -> lift $ withPtrByteStringST bs $ \(Ptr addr#) ->
+      st_ (copyAddrToByteArray# addr# mba# curPos# len#)
+  {-# INLINE packM #-}
+  unpackM = pinnedByteArrayToByteString <$> unpackByteArray True
+  {-# INLINE unpackM #-}
+
+-- | This is the implementation of `unpackM` for `ByteArray` and `ByteString`
+unpackByteArray :: Buffer b => Bool -> Unpack b ByteArray
+unpackByteArray isPinned = do
+  Length len@(I# len#) <- unpackM
+  I# curPos# <- guardAdvanceUnpack len
+  buf <- ask
+  pure $! runST $ do
+    mba@(MutableByteArray mba#) <- newMutableByteArray isPinned len
+    buffer
+      buf
+      (\ba# -> st_ (copyByteArray# ba# curPos# mba# 0# len#))
+      (\addr# -> st_ (copyAddrToByteArray# (addr# `plusAddr#` curPos#) mba# 0# len#))
+    freezeMutableByteArray mba
+{-# INLINE unpackByteArray #-}
+
+-- | Increment the offset counter of `Pack` monad by then number of `packedByteCount` and
+-- return the starting offset.
+packIncrement :: MemPack a => a -> Pack s Int
+packIncrement a =
+  state $ \i ->
+    let !n = i + packedByteCount a
+     in (i, n)
+{-# INLINE packIncrement #-}
+
+-- | Increment the offset counter of `Unpack` monad by the supplied number of
+-- bytes. Returns the original offset or fails with `RanOutOfBytesError` whenever there is
+-- not enough bytes in the `Buffer`.
+guardAdvanceUnpack :: Buffer b => Int -> Unpack b Int
+guardAdvanceUnpack n@(I# n#) = do
+  buf <- ask
+  let len = bufferByteCount buf
+      failOutOfBytes i =
+        failUnpack $
+          toSomeError $
+            RanOutOfBytesError
+              { ranOutOfBytesRead = i
+              , ranOutOfBytesAvailable = len
+              , ranOutOfBytesRequested = n
+              }
+  -- Check that we still have enough bytes, while guarding against integer overflow.
+  join $ state $ \i@(I# i#) ->
+    case addIntC# i# n# of
+      (# adv#, 0# #) ->
+        if len < I# adv#
+          then (failOutOfBytes i, i)
+          else (pure i, I# adv#)
+      _ -> (failOutOfBytes i, i)
+{-# INLINE guardAdvanceUnpack #-}
+
+-- | Serialize a type into an unpinned `ByteArray`
+--
+-- ====__Examples__
+--
+-- >>> :set -XTypeApplications
+-- >>> unpack @[Int] $ pack ([1,2,3,4,5] :: [Int])
+-- Right [1,2,3,4,5]
+pack :: forall a. (MemPack a, HasCallStack) => a -> ByteArray
+pack = packByteArray False
+{-# INLINE pack #-}
+
+-- | Serialize a type into a pinned `ByteString`
+packByteString :: forall a. (MemPack a, HasCallStack) => a -> ByteString
+packByteString = pinnedByteArrayToByteString . packByteArray True
+{-# INLINE packByteString #-}
+
+-- | Serialize a type into an unpinned `ShortByteString`
+packShortByteString :: forall a. (MemPack a, HasCallStack) => a -> ShortByteString
+packShortByteString = byteArrayToShortByteString . pack
+{-# INLINE packShortByteString #-}
+
+-- | Same as `pack`, but allows controlling the pinnedness of allocated memory
+packByteArray ::
+  forall a.
+  (MemPack a, HasCallStack) =>
+  -- | Should the array be allocated in pinned memory?
+  Bool ->
+  a ->
+  ByteArray
+packByteArray isPinned a =
+  runST $ packMutableByteArray isPinned a >>= freezeMutableByteArray
+{-# INLINE packByteArray #-}
+
+-- | Same as `packByteArray`, but produces a mutable array instead
+packMutableByteArray ::
+  forall a s.
+  (MemPack a, HasCallStack) =>
+  -- | Should the array be allocated in pinned memory?
+  Bool ->
+  a ->
+  ST s (MutableByteArray s)
+packMutableByteArray isPinned a = do
+  let len = packedByteCount a
+  mba <- newMutableByteArray isPinned len
+  filledBytes <- execStateT (runPack (packM a) mba) 0
+  when (filledBytes /= len) $
+    if (filledBytes < len)
+      then
+        error $
+          "Some bug in 'packM' was detected. Buffer of length " <> showBytes len
+            ++ " was not fully filled while packing " <> typeName @a
+            ++ ". Unfilled " <> showBytes (len - filledBytes) <> "."
+      else
+        -- This is a critical error, therefore we are not gracefully failing this unpacking
+        error $
+          "Potential buffer overflow. Some bug in 'packM' was detected while packing " <> typeName @a
+            ++ ". Filled " <> showBytes (filledBytes - len) <> " more than allowed into a buffer of length "
+            ++ show len
+  pure mba
+{-# INLINEABLE packMutableByteArray #-}
+
+-- | Unpack a memory `Buffer` into a type using its `MemPack` instance. Besides the
+-- unpacked type it also returns an index into a buffer where unpacked has stopped.
+unpackLeftOver :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> Fail SomeError (a, Int)
+unpackLeftOver b = do
+  let len = bufferByteCount b
+  res@(_, consumedBytes) <- runStateT (runUnpack unpackM b) 0
+  when (consumedBytes > len) $
+    -- This is a critical error, therefore we are not gracefully failing this unpacking
+    error $
+      "Potential buffer overflow. Some bug in 'unpackM' was detected while unpacking " <> typeName @a
+        ++ ". Consumed " <> showBytes (consumedBytes - len) <> " more than allowed from a buffer of length "
+        ++ show len
+  pure res
+{-# INLINEABLE unpackLeftOver #-}
+
+-- | Unpack a memory `Buffer` into a type using its `MemPack` instance. Besides potential
+-- unpacking failures due to a malformed buffer it will also fail the supplied `Buffer`
+-- was not fully consumed. Use `unpackLeftOver`, whenever a partially consumed buffer is
+-- possible.
+unpack :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> Either SomeError a
+unpack = first fromMultipleErrors . runFailAgg . unpackFail
+{-# INLINE unpack #-}
+
+-- | Same as `unpack` except fails in a `Fail` monad, instead of `Either`.
+unpackFail :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> Fail SomeError a
+unpackFail b = do
+  let len = bufferByteCount b
+  (a, consumedBytes) <- unpackLeftOver b
+  when (consumedBytes /= len) $
+    failT $
+      toSomeError $
+        NotFullyConsumedError
+          { notFullyConsumedRead = consumedBytes
+          , notFullyConsumedAvailable = len
+          , notFullyConsumedTypeName = typeName @a
+          }
+  pure a
+{-# INLINEABLE unpackFail #-}
+
+-- | Same as `unpackFail` except fails in any `MonadFail`, instead of `Fail`.
+unpackMonadFail :: forall a b m. (MemPack a, Buffer b, F.MonadFail m) => b -> m a
+unpackMonadFail = either (F.fail . show) pure . unpack
+{-# INLINE unpackMonadFail #-}
+
+-- | Same as `unpack` except throws a runtime exception upon a failure
+unpackError :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> a
+unpackError = errorFail . unpackFail
+{-# INLINE unpackError #-}
+
+-- | Variable length encoding for bounded types. This type of encoding will use less
+-- memory for small values, but for larger values it will consume more memory and will be
+-- slower during packing/unpacking.
+newtype VarLen a = VarLen {unVarLen :: a}
+  deriving (Eq, Ord, Show, Bounded, Enum, Num, Real, Integral, Bits, FiniteBits)
+
+instance MemPack (VarLen Word16) where
+  packedByteCount = packedVarLenByteCount
+  {-# INLINE packedByteCount #-}
+  packM v@(VarLen x) = p7 (p7 (p7 (errorTooManyBits "Word16"))) (numBits - 7)
+    where
+      p7 = packIntoCont7 x
+      {-# INLINE p7 #-}
+      numBits = packedVarLenByteCount v * 7
+  {-# INLINE packM #-}
+  unpackM = do
+    let d7 = unpack7BitVarLen
+        {-# INLINE d7 #-}
+    VarLen <$> d7 (d7 (unpack7BitVarLenLast 0b_1111_1100)) 0 0
+  {-# INLINE unpackM #-}
+
+instance MemPack (VarLen Word32) where
+  packedByteCount = packedVarLenByteCount
+  {-# INLINE packedByteCount #-}
+  packM v@(VarLen x) = p7 (p7 (p7 (p7 (p7 (errorTooManyBits "Word32"))))) (numBits - 7)
+    where
+      p7 = packIntoCont7 x
+      {-# INLINE p7 #-}
+      numBits = packedVarLenByteCount v * 7
+  {-# INLINE packM #-}
+  unpackM = do
+    let d7 = unpack7BitVarLen
+        {-# INLINE d7 #-}
+    VarLen <$> d7 (d7 (d7 (d7 (unpack7BitVarLenLast 0b_1111_0000)))) 0 0
+  {-# INLINE unpackM #-}
+
+instance MemPack (VarLen Word64) where
+  packedByteCount = packedVarLenByteCount
+  {-# INLINE packedByteCount #-}
+  packM v@(VarLen x) =
+    p7 (p7 (p7 (p7 (p7 (p7 (p7 (p7 (p7 (p7 (errorTooManyBits "Word64")))))))))) (numBits - 7)
+    where
+      p7 = packIntoCont7 x
+      {-# INLINE p7 #-}
+      numBits = packedVarLenByteCount v * 7
+  {-# INLINE packM #-}
+  unpackM = do
+    let d7 = unpack7BitVarLen
+        {-# INLINE d7 #-}
+    VarLen <$> d7 (d7 (d7 (d7 (d7 (d7 (d7 (d7 (d7 (unpack7BitVarLenLast 0b_1111_1110))))))))) 0 0
+  {-# INLINE unpackM #-}
+
+instance MemPack (VarLen Word) where
+  packedByteCount = packedVarLenByteCount
+  {-# INLINE packedByteCount #-}
+#if WORD_SIZE_IN_BITS == 32
+  packM mba v@(VarLen x) = p7 (p7 (p7 (p7 (p7 (errorTooManyBits "Word"))))) (numBits - 7)
+    where
+      p7 = packIntoCont7 mba x
+      {-# INLINE p7 #-}
+      numBits = packedVarLenByteCount v * 7
+  {-# INLINE packM #-}
+  unpackM buf = do
+    let d7 = unpack7BitVarLen buf
+        {-# INLINE d7 #-}
+    VarLen <$> d7 (d7 (d7 (d7 (unpack7BitVarLenLast buf 0b_1111_0000)))) 0 0
+  {-# INLINE unpackM #-}
+#elif WORD_SIZE_IN_BITS == 64
+  packM v@(VarLen x) =
+    p7 (p7 (p7 (p7 (p7 (p7 (p7 (p7 (p7 (p7 (errorTooManyBits "Word")))))))))) (numBits - 7)
+    where
+      p7 = packIntoCont7 x
+      {-# INLINE p7 #-}
+      numBits = packedVarLenByteCount v * 7
+  {-# INLINE packM #-}
+  unpackM = do
+    let d7 = unpack7BitVarLen
+        {-# INLINE d7 #-}
+    VarLen <$> d7 (d7 (d7 (d7 (d7 (d7 (d7 (d7 (d7 (unpack7BitVarLenLast 0b_1111_1110))))))))) 0 0
+  {-# INLINE unpackM #-}
+#else
+#error "Only 32bit and 64bit systems are supported"
+#endif
+
+packedVarLenByteCount :: FiniteBits b => VarLen b -> Int
+packedVarLenByteCount (VarLen x) =
+  case (finiteBitSize x - countLeadingZeros x) `quotRem` 7 of
+    (0, 0) -> 1
+    (q, 0) -> q
+    (q, _) -> q + 1
+{-# INLINE packedVarLenByteCount #-}
+
+errorTooManyBits :: [Char] -> a
+errorTooManyBits name =
+  error $ "Bug detected. Trying to pack more bits for " ++ name ++ " than it should be posssible"
+
+packIntoCont7 ::
+  (Bits t, Integral t) => t -> (Int -> Pack s ()) -> Int -> Pack s ()
+packIntoCont7 x cont n
+  | n <= 0 = packM (fromIntegral @_ @Word8 x .&. complement topBit8)
+  | otherwise = do
+      packM (fromIntegral @_ @Word8 (x `shiftR` n) .|. topBit8)
+      cont (n - 7)
+  where
+    topBit8 :: Word8
+    topBit8 = 0b_1000_0000
+{-# INLINE packIntoCont7 #-}
+
+-- | Decode a variable length integral value that is encoded with 7 bits of data
+-- and the most significant bit (MSB), the 8th bit is set whenever there are
+-- more bits following. Continuation style allows us to avoid
+-- recursion. Removing loops is good for performance.
+unpack7BitVarLen ::
+  (Num a, Bits a, Buffer b) =>
+  -- | Continuation that will be invoked if MSB is set
+  (Word8 -> a -> Unpack b a) ->
+  -- | Will be set either to 0 initially or to the very first unmodified byte, which is
+  -- guaranteed to have the first bit set.
+  Word8 ->
+  -- | Accumulator
+  a ->
+  Unpack b a
+unpack7BitVarLen cont firstByte !acc = do
+  b8 :: Word8 <- unpackM
+  if b8 `testBit` 7
+    then
+      cont (if firstByte == 0 then b8 else firstByte) (acc `shiftL` 7 .|. fromIntegral (b8 `clearBit` 7))
+    else pure (acc `shiftL` 7 .|. fromIntegral b8)
+{-# INLINE unpack7BitVarLen #-}
+
+unpack7BitVarLenLast ::
+  forall t b.
+  (Num t, Bits t, MemPack t, Buffer b) =>
+  Word8 ->
+  Word8 ->
+  t ->
+  Unpack b t
+unpack7BitVarLenLast mask firstByte acc = do
+  res <- unpack7BitVarLen (\_ _ -> F.fail "Too many bytes.") firstByte acc
+  -- Only while decoding the last 7bits we check if there was too many
+  -- bits supplied at the beginning.
+  unless (firstByte .&. mask == 0b_1000_0000) $
+    F.fail $
+      "Unexpected bits for "
+        ++ typeName @t
+        ++ " were set in the first byte of 'VarLen': 0x" <> showHex firstByte ""
+  pure res
+{-# INLINE unpack7BitVarLenLast #-}
+
+-- | This is a helper type useful for serializing number of elements in data
+-- structures. It uses `VarLen` underneath, since sizes of common data structures aren't
+-- too big. It also prevents negative values from being serialized and deserialized.
+newtype Length = Length {unLength :: Int}
+  deriving (Eq, Show, Num)
+
+instance Bounded Length where
+  minBound = 0
+  maxBound = Length maxBound
+
+instance Enum Length where
+  toEnum n
+    | n < 0 = error $ "toEnum: Length cannot be negative: " ++ show n
+    | otherwise = Length n
+  fromEnum = unLength
+
+instance MemPack Length where
+  packedByteCount = packedByteCount . VarLen . fromIntegral @Int @Word . unLength
+  packM (Length n)
+    | n < 0 = error $ "Length cannot be negative. Supplied: " ++ show n
+    | otherwise = packM (VarLen (fromIntegral @Int @Word n))
+  {-# INLINE packM #-}
+  unpackM = do
+    VarLen (w :: Word) <- unpackM
+    when (testBit w (finiteBitSize w)) $
+      F.fail $
+        "Attempt to unpack negative length was detected: " ++ show (fromIntegral @Word @Int w)
+    pure $ Length $ fromIntegral @Word @Int w
+  {-# INLINE unpackM #-}
+
+-- | This is a helper type that is useful for creating `MemPack` instances for sum types.
+newtype Tag = Tag {unTag :: Word8}
+  deriving (Eq, Ord, Show, Num, Enum, Bounded)
+
+-- Manually defined instance, since ghc-8.6 has issues with deriving MemPack
+instance MemPack Tag where
+  packedByteCount _ = packedTagByteCount
+  {-# INLINE packedByteCount #-}
+  unpackM = unpackTagM
+  {-# INLINE unpackM #-}
+  packM = packTagM
+  {-# INLINE packM #-}
+
+packedTagByteCount :: Int
+packedTagByteCount = SIZEOF_WORD8
+{-# INLINE packedTagByteCount #-}
+
+unpackTagM :: Buffer b => Unpack b Tag
+unpackTagM = Tag <$> unpackM
+{-# INLINE unpackTagM #-}
+
+packTagM :: Tag -> Pack s ()
+packTagM = packM . unTag
+{-# INLINE packTagM #-}
+
+unknownTagM :: forall a m b. (MemPack a, F.MonadFail m) => Tag -> m b
+unknownTagM (Tag t) = F.fail $ "Unrecognized Tag: " ++ show t ++ " while decoding " ++ typeName @a
+
+lift_# :: (State# s -> State# s) -> Pack s ()
+lift_# f = Pack $ \_ -> lift $ st_ f
+{-# INLINE lift_# #-}
+
+st_ :: (State# s -> State# s) -> ST s ()
+st_ f = ST $ \s# -> (# f s#, () #)
+{-# INLINE st_ #-}
diff --git a/src/Data/MemPack/Buffer.hs b/src/Data/MemPack/Buffer.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/MemPack/Buffer.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+
+-- |
+-- Module      : Data.MemPack.Buffer
+-- Copyright   : (c) Alexey Kuleshevich 2024
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
+-- Stability   : experimental
+-- Portability : non-portable
+module Data.MemPack.Buffer where
+
+import Data.Array.Byte
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Short.Internal as SBS
+import qualified Data.ByteString.Internal as BS
+import GHC.Exts
+import GHC.ST
+import GHC.ForeignPtr
+
+-- | Immutable memory buffer
+class Buffer b where
+  bufferByteCount :: b -> Int
+
+  buffer :: b -> (ByteArray# -> a) -> (Addr# -> a) -> a
+
+instance Buffer ByteArray where
+  bufferByteCount (ByteArray ba#) = I# (sizeofByteArray# ba#)
+  {-# INLINE bufferByteCount #-}
+
+  buffer (ByteArray ba#) f _ = f ba#
+  {-# INLINE buffer #-}
+
+instance Buffer SBS.ShortByteString where
+  bufferByteCount = SBS.length
+  {-# INLINE bufferByteCount #-}
+
+  buffer (SBS.SBS ba#) f _ = f ba#
+  {-# INLINE buffer #-}
+
+instance Buffer BS.ByteString where
+  bufferByteCount = BS.length
+  {-# INLINE bufferByteCount #-}
+
+  buffer bs _ f =
+    runST $ withPtrByteStringST bs $ \(Ptr addr#) -> pure $! f addr#
+  {-# INLINE buffer #-}
+
+
+newMutableByteArray :: Bool -> Int -> ST s (MutableByteArray s)
+newMutableByteArray isPinned (I# len#) =
+  ST $ \s# -> case (if isPinned then newPinnedByteArray# else newByteArray#) len# s# of
+    (# s'#, mba# #) -> (# s'#, MutableByteArray mba# #)
+{-# INLINE newMutableByteArray #-}
+
+freezeMutableByteArray :: MutableByteArray d -> ST d ByteArray
+freezeMutableByteArray (MutableByteArray mba#) =
+  ST $ \s# -> case unsafeFreezeByteArray# mba# s# of
+    (# s'#, ba# #) -> (# s'#, ByteArray ba# #)
+
+-- | It is ok to use ByteString withing ST, as long as underlying pointer is never mutated
+-- or returned from the supplied action.
+withPtrByteStringST :: BS.ByteString -> (Ptr a -> ST s b) -> ST s b
+#if MIN_VERSION_bytestring(0,11,0)
+withPtrByteStringST (BS.BS (ForeignPtr addr# ptrContents) _) f = do
+#else
+withPtrByteStringST (BS.PS (ForeignPtr addr0# ptrContents) (I# offset#) _) f = do
+  let !addr# = addr0# `plusAddr#` offset#
+#endif
+  !r <- f (Ptr addr#)
+  -- It is safe to use `touch#` within ST, so `unsafeCoerce#` is OK
+  ST $ \s# -> (# unsafeCoerce# (touch# ptrContents (unsafeCoerce# s#)), () #)
+  pure r
+{-# INLINE withPtrByteStringST #-}
+
+pinnedByteArrayToByteString :: ByteArray -> BS.ByteString
+pinnedByteArrayToByteString (ByteArray ba#) =
+  BS.PS (pinnedByteArrayToForeignPtr ba#) 0 (I# (sizeofByteArray# ba#))
+{-# INLINE pinnedByteArrayToByteString #-}
+
+pinnedByteArrayToForeignPtr :: ByteArray# -> ForeignPtr a
+pinnedByteArrayToForeignPtr ba# =
+  ForeignPtr (byteArrayContents# ba#) (PlainPtr (unsafeCoerce# ba#))
+{-# INLINE pinnedByteArrayToForeignPtr #-}
+
+
+byteArrayToShortByteString :: ByteArray -> SBS.ShortByteString
+byteArrayToShortByteString (ByteArray ba#) = SBS.SBS ba#
+{-# INLINE byteArrayToShortByteString #-}
+
+byteArrayFromShortByteString :: SBS.ShortByteString -> ByteArray
+byteArrayFromShortByteString (SBS.SBS ba#) = ByteArray ba#
+{-# INLINE byteArrayFromShortByteString #-}
diff --git a/src/Data/MemPack/Error.hs b/src/Data/MemPack/Error.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/MemPack/Error.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- |
+-- Module      : Data.MemPack.Error
+-- Copyright   : (c) Alexey Kuleshevich 2024
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
+-- Stability   : experimental
+-- Portability : non-portable
+module Data.MemPack.Error where
+
+import Control.Exception
+import Data.List.NonEmpty as NE
+import Data.Text (Text)
+import Data.Typeable
+import GHC.Exts
+
+data SomeError where
+  SomeError :: (Typeable e, Error e) => e -> SomeError
+
+instance Show SomeError where
+  showsPrec p (SomeError e) = showsPrec p e
+
+instance Exception SomeError
+
+-- | Very similar interface to `Exceptions`, except not intended for run time exceptions.
+class Show e => Error e where
+  toSomeError :: e -> SomeError
+  default toSomeError :: Typeable e => e -> SomeError
+  toSomeError = SomeError
+
+  fromSomeError :: SomeError -> Maybe e
+  default fromSomeError :: Typeable e => SomeError -> Maybe e
+  fromSomeError (SomeError t) = cast t
+
+instance Error SomeError where
+  toSomeError = id
+  fromSomeError = Just
+
+newtype TextError = TextError Text
+  deriving newtype (Eq, Show, IsString)
+
+instance Error TextError
+
+instance IsString SomeError where
+  fromString = toSomeError . TextError . fromString
+
+newtype ManyErrors = ManyErrors (NonEmpty SomeError)
+  deriving (Show)
+
+instance Error ManyErrors
+
+data UnknownError = UnknownError
+  deriving (Show)
+
+instance Error UnknownError
+
+fromMultipleErrors :: [SomeError] -> SomeError
+fromMultipleErrors es =
+  case es of
+    [] -> toSomeError UnknownError
+    [e] -> e
+    e : rest -> toSomeError $ ManyErrors (e :| rest)
+
+data RanOutOfBytesError = RanOutOfBytesError
+  { ranOutOfBytesRead :: Int
+  , ranOutOfBytesAvailable :: Int
+  , ranOutOfBytesRequested :: Int
+  }
+  deriving (Eq, Ord)
+
+instance Show RanOutOfBytesError where
+  show RanOutOfBytesError{..} =
+    "Ran out of bytes. Read "
+      <> showBytes ranOutOfBytesRead
+      <> " out of "
+      <> showBytes ranOutOfBytesAvailable
+      <> ". Requested to read "
+      <> showBytes ranOutOfBytesRequested
+      <> " more."
+
+instance Error RanOutOfBytesError
+
+data NotFullyConsumedError = NotFullyConsumedError
+  { notFullyConsumedRead :: Int
+  , notFullyConsumedAvailable :: Int
+  , notFullyConsumedTypeName :: String
+  }
+  deriving (Eq, Ord)
+
+instance Show NotFullyConsumedError where
+  show NotFullyConsumedError{..} =
+    "Buffer of length " <> showBytes notFullyConsumedAvailable
+      ++ " was not fully consumed while unpacking '" <> notFullyConsumedTypeName
+      ++ "'. Unconsumed " <> showBytes (notFullyConsumedAvailable - notFullyConsumedRead)
+      ++ " was leftover."
+
+instance Error NotFullyConsumedError
+
+showBytes :: Int -> String
+showBytes 1 = "1 byte"
+showBytes n = show n ++ " bytes"
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+import qualified Test.MemPackSpec as MemPack (spec)
+import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8)
+import Test.Hspec.Runner
+
+config :: Config
+#if !(MIN_VERSION_hspec(2,8,0))
+config = defaultConfig
+#else
+config =
+  defaultConfig
+    { configTimes = True
+    , configColorMode = ColorAlways
+    }
+#endif
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  hSetEncoding stdout utf8
+  hspecWith config $ do
+    MemPack.spec
diff --git a/tests/Test/Common.hs b/tests/Test/Common.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Common.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Test.Common (
+  module X,
+  QC (..),
+) where
+
+import Data.Array.Byte (ByteArray (..))
+import Data.ByteString (ByteString)
+import Data.ByteString.Short.Internal as SBS (ShortByteString (..))
+import Data.MemPack.Buffer (byteArrayFromShortByteString)
+import System.Random.Stateful
+import Test.Hspec as X
+import Test.Hspec.QuickCheck as X
+import Test.QuickCheck as X
+import Test.QuickCheck.Gen (Gen (MkGen))
+
+data QC = QC
+
+instance StatefulGen QC Gen where
+  uniformWord32 QC = MkGen (\r _n -> runStateGen_ r uniformWord32)
+  {-# INLINE uniformWord32 #-}
+  uniformWord64 QC = MkGen (\r _n -> runStateGen_ r uniformWord64)
+  {-# INLINE uniformWord64 #-}
+  uniformShortByteString k QC =
+    MkGen (\r _n -> runStateGen_ r (uniformShortByteString k))
+  {-# INLINE uniformShortByteString #-}
+
+instance Arbitrary ByteArray where
+  arbitrary = qcByteArray . getNonNegative =<< arbitrary
+
+instance Arbitrary ByteString where
+  arbitrary = qcByteString . getNonNegative =<< arbitrary
+
+instance Arbitrary SBS.ShortByteString where
+  arbitrary = qcShortByteString . getNonNegative =<< arbitrary
+
+qcByteArray :: Int -> Gen ByteArray
+qcByteArray n = byteArrayFromShortByteString <$> qcShortByteString n
+
+qcByteString :: Int -> Gen ByteString
+qcByteString n = uniformByteStringM (fromIntegral n) QC
+
+qcShortByteString :: Int -> Gen SBS.ShortByteString
+qcShortByteString n = uniformShortByteString (fromIntegral n) QC
diff --git a/tests/Test/MemPackSpec.hs b/tests/Test/MemPackSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/MemPackSpec.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Test.MemPackSpec (spec) where
+
+import Numeric.Natural
+import Control.Applicative ((<|>))
+import Control.Monad hiding (fail)
+import qualified Control.Monad.Fail as F
+import Data.Array.Byte (ByteArray)
+import Data.Bits
+import Data.ByteString (ByteString)
+import Data.ByteString.Short (ShortByteString)
+import Data.Complex
+import Data.Either (isLeft)
+import Data.Function (fix)
+import Data.Int
+import Data.MemPack
+import Data.MemPack.Buffer
+import Data.MemPack.Error
+import Data.Ratio
+import Data.Word
+import Foreign.Ptr (IntPtr (..), Ptr, intPtrToPtr)
+import Foreign.StablePtr (StablePtr, castPtrToStablePtr, castStablePtrToPtr)
+import System.Random.Stateful
+import Test.Common
+
+-- | Generate extrema around boundaries
+newtype E a = E {unE :: a}
+  deriving (Eq, Ord, Show, Num, Real, Enum, Bounded, Integral)
+#if __GLASGOW_HASKELL__ >= 808
+  -- We also want to test GND for compiler versions that can handle it
+  deriving newtype MemPack
+#else
+-- Manually defined instance, since ghc-8.6 has issues with deriving MemPack
+instance MemPack a => MemPack (E a) where
+  typeName = typeName @a
+  packedByteCount = packedByteCount . unE
+  unpackM = E <$> unpackM
+  packM = packM . unE
+#endif
+
+instance Random Length
+
+deriving instance Random Tag
+
+instance Uniform Length where
+  uniformM = uniformEnumM
+instance UniformRange Length where
+  uniformRM = uniformEnumRM
+
+instance Arbitrary Length where
+  -- Fun fact: `abs minBound == minBound` for Int, so instead of abs we clear top most
+  arbitrary = Length . (\x -> x `clearBit` (finiteBitSize x - 1)) <$> arbitrary
+
+deriving instance Arbitrary Tag
+
+instance Arbitrary (Ptr a) where
+  arbitrary = intPtrToPtr . IntPtr . unE <$> arbitrary
+
+instance Arbitrary (StablePtr a) where
+  arbitrary = castPtrToStablePtr <$> arbitrary
+
+instance Show (StablePtr a) where
+  show = show . castStablePtrToPtr
+
+instance (Arbitrary a, Bounded a, Enum a, Random a) => Arbitrary (E a) where
+  arbitrary =
+    E
+      <$> frequency
+        [ (25, arbitrary)
+        , (25, chooseAny)
+        , (25, choose (minBound, iter succ minBound 100)) -- add a 100
+        , (25, choose (iter pred maxBound 100, maxBound)) -- subtract a 100
+        ]
+    where
+      iter :: (a -> a) -> a -> Int -> a
+      iter f = fix (\loop c i -> if i <= 0 then c else loop (f c) (i - 1))
+
+instance {-# OVERLAPPING #-} Arbitrary (E Integer) where
+  arbitrary =
+    E
+      <$> frequency
+        [ (15, arbitrary)
+        , (25, chooseAny)
+        , (25, choose (fromIntegral (maxBound :: Int), fromIntegral (maxBound :: Word)))
+        , (25, choose (negate (fromIntegral (maxBound :: Word)), fromIntegral (minBound :: Int)))
+        , (5, fact <$> choose (21, 300))
+        , (5, negate . fact <$> choose (21, 300))
+        ]
+    where
+
+instance {-# OVERLAPPING #-} Arbitrary (E Natural) where
+  arbitrary =
+    E
+      <$> frequency
+        [ (15, fromInteger . getNonNegative <$> arbitrary)
+        , (25, uniformRM (0, fromIntegral (maxBound :: Word)) QC)
+        , (25, uniformRM (fromIntegral (maxBound :: Word), 2 * fromIntegral (maxBound :: Word)) QC)
+        , (5, fact . fromInteger <$> choose (21, 300))
+        ]
+
+
+-- factorial for generating some large numbers
+fact :: (Ord a, Num a) => a -> a
+fact = go 1
+  where
+    go !acc n
+      | n <= 1 = acc
+      | otherwise = go (acc * n) (n - 1)
+
+deriving instance Random a => Random (VarLen a)
+deriving instance Arbitrary a => Arbitrary (VarLen a)
+
+data Backtrack
+  = IntCase Int
+  | Word16Case Word16
+  deriving (Show, Eq)
+
+instance Arbitrary Backtrack where
+  arbitrary =
+    oneof [IntCase . unE <$> arbitrary, Word16Case . unE <$> arbitrary]
+
+instance MemPack Backtrack where
+  packedByteCount =
+    (+ 1) . \case
+      IntCase i -> packedByteCount i
+      Word16Case i -> packedByteCount i
+  packM = \case
+    IntCase i -> packM (Tag 0) >> packM i
+    Word16Case i -> packM (Tag 1) >> packM i
+  unpackM =
+    (IntCase <$> unpackCase 0) <|> (Word16Case <$> unpackCase 1)
+    where
+      unpackCase :: (Buffer b, MemPack a) => Tag -> Unpack b a
+      unpackCase t = do
+        t' <- unpackM
+        unless (t == t') $ F.fail "Tag mismatch"
+        unpackM
+
+expectRoundTrip :: forall a. (MemPack a, Eq a, Show a) => a -> Expectation
+expectRoundTrip a = do
+  unpackError (pack a) `shouldBe` a
+  unpackError (packByteString a) `shouldBe` a
+
+expectNotFullyConsumed ::
+  forall a. (MemPack a, Show a) => a -> NonEmptyList Word8 -> Expectation
+expectNotFullyConsumed a (NonEmpty xs) = do
+  let extraByteCount = length xs
+      failOnExtra :: (Buffer b, Semigroup b) => b -> b -> Expectation
+      failOnExtra buf extra =
+        case unpack (buf <> extra) :: Either SomeError a of
+          Left e
+            | Just err <- fromSomeError e -> do
+                notFullyConsumedRead err `shouldBe` bufferByteCount buf
+                notFullyConsumedAvailable err `shouldBe` bufferByteCount buf
+                  + packedByteCount (Length extraByteCount) -- account for list length
+                  + extraByteCount
+                notFullyConsumedTypeName err `shouldBe` typeName @a
+            | otherwise -> expectationFailure $ "Unexpected failure: " ++ show e
+          Right res -> expectationFailure $ "Unexpectedly unpacked: " ++ show res
+  failOnExtra (pack a) (pack xs)
+  failOnExtra (packByteString a) (packByteString xs)
+
+memPackSpec :: forall a. (MemPack a, Arbitrary a, Eq a, Show a) => Spec
+memPackSpec =
+  describe (typeName @a) $ do
+    prop "RoundTrip" $ expectRoundTrip @a
+    describe "Fail on empty" $ do
+      let checkRanOutOfBytes someErr
+            | Just err <- fromSomeError someErr = do
+                ranOutOfBytesRead err `shouldBe` 0
+                ranOutOfBytesAvailable err `shouldBe` 0
+                ranOutOfBytesRequested err `shouldSatisfy` (> 0)
+            | otherwise = expectationFailure $ "Unexpected failure: " ++ show someErr
+          -- Check that the only kind of failure we get is RanOutOfBytes
+          failOnEmpty emptyBuffer =
+            case unpack emptyBuffer :: Either SomeError a of
+              Left e
+                | Just (ManyErrors errs) <- fromSomeError e -> mapM_ checkRanOutOfBytes errs
+                | otherwise -> checkRanOutOfBytes e
+              Right res -> expectationFailure $ "Unexpectedly unpacked: " ++ show res
+      it "ByteArray" $ failOnEmpty (mempty :: ByteArray)
+      it "ByteString" $ failOnEmpty (mempty :: ByteString)
+      it "ShortByteString" $ failOnEmpty (mempty :: ShortByteString)
+    prop "Fail on too much" $ expectNotFullyConsumed @a
+
+spec :: Spec
+spec = do
+  prop "RoundTrip" $ expectRoundTrip @()
+  memPackSpec @(Ptr ())
+  memPackSpec @(StablePtr ())
+  memPackSpec @Float
+  memPackSpec @Double
+  memPackSpec @Bool
+  memPackSpec @(E Char)
+  memPackSpec @(E Int)
+  memPackSpec @(E Int8)
+  memPackSpec @(E Int16)
+  memPackSpec @(E Int32)
+  memPackSpec @(E Int64)
+  memPackSpec @(E Word)
+  memPackSpec @(E Word8)
+  memPackSpec @(E Word16)
+  memPackSpec @(E Word32)
+  memPackSpec @(E Word64)
+  memPackSpec @[E Int]
+  memPackSpec @[E Word]
+  memPackSpec @(E Int, E Word)
+  memPackSpec @(E Int8, E Word8, E Char)
+  memPackSpec @(E Int16, E Word16, Float, Double)
+  memPackSpec @(E Int32, E Word32, Float, Double, Ptr Char)
+  memPackSpec @(E Int64, E Word64, Length, VarLen Word, StablePtr Char, [VarLen Word32])
+  memPackSpec @(Tag, Int, Int8, Int16, Int32, Int64, Backtrack)
+  memPackSpec @(E (VarLen Word))
+  memPackSpec @(E (VarLen Word16))
+  memPackSpec @(E (VarLen Word32))
+  memPackSpec @(E (VarLen Word64))
+  memPackSpec @(E Tag)
+  memPackSpec @(E Length)
+  memPackSpec @(E Integer)
+  memPackSpec @(E Natural)
+  memPackSpec @(Maybe String)
+  memPackSpec @(Either Float Double)
+  memPackSpec @(Complex (E Int))
+  memPackSpec @(Ratio (E Int))
+  memPackSpec @ByteArray
+  memPackSpec @ByteString
+  memPackSpec @ShortByteString
+  memPackSpec @Backtrack
+  prop "Out of bound char" $ forAll (choose (0x110000, maxBound :: Word32)) $ \w32 ->
+    unpack @Char (pack w32) `shouldSatisfy` isLeft
+  prop "Zero denominator" $ \x -> do
+    unpack @(Ratio Int8) (pack (x :: Int8, 0 :: Int8)) `shouldSatisfy` isLeft