diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# ChangeLog
+
+## 0.1.0.0
+
+* `Data.Store.Streaming` forked from `store-0.4.3.2`
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,7 @@
+Copyright 2016-2018 FP Complete
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Data/Store/Streaming.hs b/src/Data/Store/Streaming.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store/Streaming.hs
@@ -0,0 +1,223 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module: Data.Store.Streaming
+Description: A thin streaming layer that uses 'Store' for serialisation.
+
+For efficiency reasons, 'Store' does not provide facilities for
+incrementally consuming input.  In order to avoid partial input, this
+module introduces 'Message's that wrap values of instances of 'Store'.
+
+In addition to the serialisation of a value, the serialised message
+also contains the length of the serialisation.  This way, instead of
+consuming input incrementally, more input can be demanded before
+serialisation is attempted in the first place.
+
+Each message starts with a fixed magic number, in order to detect
+(randomly) invalid data.
+
+-}
+module Data.Store.Streaming
+       ( -- * 'Message's to stream data using 'Store' for serialisation.
+         Message (..)
+         -- * Encoding 'Message's
+       , encodeMessage
+         -- * Decoding 'Message's
+       , PeekMessage
+       , FillByteBuffer
+       , peekMessage
+       , decodeMessage
+       , peekMessageBS
+       , decodeMessageBS
+#ifndef mingw32_HOST_OS
+       , ReadMoreData(..)
+       , peekMessageFd
+       , decodeMessageFd
+#endif
+         -- * Conduits for encoding and decoding
+       , conduitEncode
+       , conduitDecode
+       ) where
+
+import           Control.Exception (throwIO)
+import           Control.Monad (unless)
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Resource (MonadResource)
+import           Data.ByteString (ByteString)
+import qualified Data.Conduit as C
+import qualified Data.Conduit.List as C
+import           Data.Store
+import           Data.Store.Core (decodeIOWithFromPtr, unsafeEncodeWith)
+import           Data.Store.Internal (getSize)
+import qualified Data.Text as T
+import           Data.Word
+import           Foreign.Ptr
+import           Prelude
+import           System.IO.ByteBuffer (ByteBuffer)
+import qualified System.IO.ByteBuffer as BB
+import           Control.Monad.Trans.Free.Church (FT, iterTM, wrap)
+import           Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
+import           Control.Monad.Trans.Class (lift)
+import           System.Posix.Types (Fd(..))
+import           GHC.Conc (threadWaitRead)
+import           Data.Store.Streaming.Internal
+
+-- | If @a@ is an instance of 'Store', @Message a@ can be serialised
+-- and deserialised in a streaming fashion.
+newtype Message a = Message { fromMessage :: a } deriving (Eq, Show)
+
+-- | Encode a 'Message' to a 'ByteString'.
+encodeMessage :: Store a => Message a -> ByteString
+encodeMessage (Message x) =
+    unsafeEncodeWith pokeFunc totalLength
+  where
+    bodyLength = getSize x
+    totalLength = headerLength + bodyLength
+    pokeFunc = do
+        poke messageMagic
+        poke bodyLength
+        poke x
+
+-- | The result of peeking at the next message can either be a
+-- successfully deserialised object, or a request for more input.
+type PeekMessage i m a = FT ((->) i) m a
+
+needMoreInput :: PeekMessage i m i
+needMoreInput = wrap return
+
+-- | Given some sort of input, fills the 'ByteBuffer' with it.
+--
+-- The 'Int' is how many bytes we'd like: this is useful when the filling
+-- function is 'fillFromFd', where we can specify a max size.
+type FillByteBuffer i m = ByteBuffer -> Int -> i -> m ()
+
+-- | Decode a value, given a 'Ptr' and the number of bytes that make
+-- up the encoded message.
+decodeFromPtr :: (MonadIO m, Store a) => Ptr Word8 -> Int -> m a
+decodeFromPtr ptr n = liftIO $ decodeIOWithFromPtr peek ptr n
+
+peekSized :: (MonadIO m, Store a) => FillByteBuffer i m -> ByteBuffer -> Int -> PeekMessage i m a
+peekSized fill bb n = go
+  where
+    go = do
+      mbPtr <- BB.unsafeConsume bb n
+      case mbPtr of
+        Left needed -> do
+          inp <- needMoreInput
+          lift (fill bb needed inp)
+          go
+        Right ptr -> decodeFromPtr ptr n
+
+-- | Read and check the magic number from a 'ByteBuffer'
+peekMessageMagic :: MonadIO m => FillByteBuffer i m -> ByteBuffer -> PeekMessage i m ()
+peekMessageMagic fill bb =
+    peekSized fill bb magicLength >>= \case
+      mm | mm == messageMagic -> return ()
+      mm -> liftIO . throwIO $ PeekException 0 . T.pack $
+          "Wrong message magic, " ++ show mm
+
+-- | Decode a 'SizeTag' from a 'ByteBuffer'.
+peekMessageSizeTag :: MonadIO m => FillByteBuffer i m -> ByteBuffer -> PeekMessage i m SizeTag
+peekMessageSizeTag fill bb = peekSized fill bb sizeTagLength
+
+-- | Decode some object from a 'ByteBuffer', by first reading its
+-- header, and then the actual data.
+peekMessage :: (MonadIO m, Store a) => FillByteBuffer i m -> ByteBuffer -> PeekMessage i m (Message a)
+peekMessage fill bb =
+  fmap Message $ do
+    peekMessageMagic fill bb
+    peekMessageSizeTag fill bb >>= peekSized fill bb
+
+-- | Decode a 'Message' from a 'ByteBuffer' and an action that can get
+-- additional inputs to refill the buffer when necessary.
+--
+-- The only conditions under which this function will give 'Nothing',
+-- is when the 'ByteBuffer' contains zero bytes, and refilling yields
+-- 'Nothing'.  If there is some data available, but not enough to
+-- decode the whole 'Message', a 'PeekException' will be thrown.
+decodeMessage :: (Store a, MonadIO m) => FillByteBuffer i m -> ByteBuffer -> m (Maybe i) -> m (Maybe (Message a))
+decodeMessage fill bb getInp =
+  maybeDecode (peekMessageMagic fill bb) >>= \case
+    Just () -> maybeDecode (peekMessageSizeTag fill bb >>= peekSized fill bb) >>= \case
+      Just x -> return (Just (Message x))
+      Nothing -> do
+        -- We have already read the message magic, so a failure to
+        -- read the whole message means we have an incomplete message.
+        available <- BB.availableBytes bb
+        liftIO $ throwIO $ PeekException available $ T.pack
+          "Data.Store.Streaming.decodeMessage: could not get enough bytes to decode message"
+    Nothing -> do
+      available <- BB.availableBytes bb
+      -- At this point, we have not consumed anything yet, so if bb is
+      -- empty, there simply was no message to read.
+      unless (available == 0) $ liftIO $ throwIO $ PeekException available $ T.pack
+        "Data.Store.Streaming.decodeMessage: could not get enough bytes to decode message"
+      return Nothing
+  where
+    maybeDecode m = runMaybeT (iterTM (\consumeInp -> consumeInp =<< MaybeT getInp) m)
+
+-- | Decode some 'Message' from a 'ByteBuffer', by first reading its
+-- header, and then the actual 'Message'.
+peekMessageBS :: (MonadIO m, Store a) => ByteBuffer -> PeekMessage ByteString m (Message a)
+peekMessageBS = peekMessage (\bb _ bs -> BB.copyByteString bb bs)
+
+decodeMessageBS :: (MonadIO m, Store a)
+            => ByteBuffer -> m (Maybe ByteString) -> m (Maybe (Message a))
+decodeMessageBS = decodeMessage (\bb _ bs -> BB.copyByteString bb bs)
+
+#ifndef mingw32_HOST_OS
+
+-- | We use this type as a more descriptive unit to signal that more input
+-- should be read from the Fd.
+--
+-- This data-type is only available on POSIX systems (essentially, non-windows)
+data ReadMoreData = ReadMoreData
+  deriving (Eq, Show)
+
+-- | Peeks a message from a _non blocking_ 'Fd'.
+--
+-- This function is only available on POSIX systems (essentially, non-windows)
+peekMessageFd :: (MonadIO m, Store a) => ByteBuffer -> Fd -> PeekMessage ReadMoreData m (Message a)
+peekMessageFd bb fd =
+  peekMessage (\bb_ needed ReadMoreData -> do _ <- BB.fillFromFd bb_ fd needed; return ()) bb
+
+-- | Decodes all the message using 'registerFd' to find out when a 'Socket' is
+-- ready for reading.
+--
+-- This function is only available on POSIX systems (essentially, non-windows)
+decodeMessageFd :: (MonadIO m, Store a) => ByteBuffer -> Fd -> m (Message a)
+decodeMessageFd bb fd = do
+  mbMsg <- decodeMessage
+    (\bb_ needed ReadMoreData -> do _ <- BB.fillFromFd bb_ fd needed; return ()) bb
+    (liftIO (threadWaitRead fd) >> return (Just ReadMoreData))
+  case mbMsg of
+    Just msg -> return msg
+    Nothing -> liftIO (fail "decodeMessageFd: impossible: got Nothing")
+
+#endif
+
+-- | Conduit for encoding 'Message's to 'ByteString's.
+conduitEncode :: (Monad m, Store a) => C.Conduit (Message a) m ByteString
+conduitEncode = C.map encodeMessage
+
+-- | Conduit for decoding 'Message's from 'ByteString's.
+conduitDecode :: (MonadResource m, Store a)
+              => Maybe Int
+              -- ^ Initial length of the 'ByteBuffer' used for
+              -- buffering the incoming 'ByteString's.  If 'Nothing',
+              -- use the default value of 4MB.
+              -> C.Conduit ByteString m (Message a)
+conduitDecode bufSize =
+    C.bracketP
+      (BB.new bufSize)
+      BB.free
+      go
+  where
+    go buffer = do
+        mmessage <- decodeMessageBS buffer C.await
+        case mmessage of
+            Nothing -> return ()
+            Just message -> C.yield message >> go buffer
diff --git a/src/Data/Store/Streaming/Internal.hs b/src/Data/Store/Streaming/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store/Streaming/Internal.hs
@@ -0,0 +1,26 @@
+module Data.Store.Streaming.Internal
+  ( messageMagic
+  , magicLength
+  , sizeTagLength
+  , headerLength
+  , SizeTag
+  ) where
+
+import           Data.Word (Word64)
+import qualified Foreign.Storable as Storable
+
+-- | Type used to store the length of a 'Message'.
+type SizeTag = Int
+
+-- | Some fixed arbitrary magic number that precedes every 'Message'.
+messageMagic :: Word64
+messageMagic = 18205256374652458875
+
+magicLength :: Int
+magicLength = Storable.sizeOf messageMagic
+
+sizeTagLength :: Int
+sizeTagLength = Storable.sizeOf (undefined :: SizeTag)
+
+headerLength :: Int
+headerLength = sizeTagLength + magicLength
diff --git a/store-streaming.cabal b/store-streaming.cabal
new file mode 100644
--- /dev/null
+++ b/store-streaming.cabal
@@ -0,0 +1,75 @@
+-- This file has been generated from package.yaml by hpack version 0.28.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: b0f16693a79e5a6c8fc78c811d1173f5f53f4f2be86cbadb0b4712cacbca61b9
+
+name:           store-streaming
+version:        0.1.0.0
+synopsis:       Streaming interfaces for `store`
+category:       Serialization, Data
+homepage:       https://github.com/fpco/store#readme
+bug-reports:    https://github.com/fpco/store/issues
+maintainer:     Michael Sloan <sloan@fpcomplete.com>
+copyright:      2016 FP Complete
+license:        MIT
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/fpco/store
+
+library
+  exposed-modules:
+      Data.Store.Streaming
+      Data.Store.Streaming.Internal
+  other-modules:
+      Paths_store_streaming
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2
+  build-depends:
+      async >=2.0.2
+    , base >=4.7 && <5
+    , bytestring >=0.10.4.0
+    , conduit >=1.2.3.1
+    , free >=4.11
+    , resourcet >=1.1.3.3
+    , store >=0.4.3.4
+    , store-core >=0.4.1
+    , streaming-commons >=0.1.10.0
+    , text >=1.2.0.4
+    , transformers >=0.3.0.0
+  default-language: Haskell2010
+
+test-suite store-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Data.Store.StreamingSpec
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      async >=2.0.2
+    , base >=4.7 && <5
+    , bytestring >=0.10.4.0
+    , conduit >=1.2.3.1
+    , free >=4.11
+    , hspec
+    , hspec-smallcheck
+    , network
+    , resourcet >=1.1.3.3
+    , smallcheck
+    , store
+    , store-core >=0.4.1
+    , store-streaming
+    , streaming-commons >=0.1.10.0
+    , text >=1.2.0.4
+    , transformers >=0.3.0.0
+    , void
+  default-language: Haskell2010
diff --git a/test/Data/Store/StreamingSpec.hs b/test/Data/Store/StreamingSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Store/StreamingSpec.hs
@@ -0,0 +1,206 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+module Data.Store.StreamingSpec where
+
+import           Control.Concurrent (threadDelay)
+import           Control.Concurrent.Async (race, concurrently)
+import           Control.Concurrent.MVar
+import           Control.Exception (try)
+import           Control.Monad (void, (<=<), forM_)
+import           Control.Monad.Trans.Free (runFreeT, FreeF(..))
+import           Control.Monad.Trans.Free.Church (fromFT)
+import           Control.Monad.Trans.Resource
+import qualified Data.ByteString as BS
+import           Data.Conduit ((=$=), ($$))
+import qualified Data.Conduit.List as C
+import           Data.List (unfoldr)
+import           Data.Monoid
+import           Data.Store.Internal
+import           Data.Store.Streaming
+import           Data.Store.Streaming.Internal
+import           Data.Streaming.Network (runTCPServer, runTCPClient, clientSettingsTCP, serverSettingsTCP, setAfterBind)
+import           Data.Streaming.Network.Internal (AppData(..))
+import           Data.Void (absurd, Void)
+import           Network.Socket (Socket(..), socketPort)
+import           Network.Socket.ByteString (send)
+import qualified System.IO.ByteBuffer as BB
+import           System.Posix.Types (Fd(..))
+import           Test.Hspec
+import           Test.Hspec.SmallCheck
+import           Test.SmallCheck
+
+spec :: Spec
+spec = do
+  describe "conduitEncode and conduitDecode" $ do
+    it "Roundtrips ([Int])." $ property roundtrip
+    it "Roundtrips ([Int]), with chunked transfer." $ property roundtripChunked
+    it "Throws an Exception on incomplete messages." conduitIncomplete
+    it "Throws an Exception on excess input." $ property conduitExcess
+  describe "peekMessage" $ do
+    describe "ByteString" $ do
+      it "demands more input when needed." $ property (askMoreBS (headerLength + 1))
+      it "demands more input on incomplete message magic." $ property (askMoreBS 1)
+      it "demands more input on incomplete SizeTag." $ property (askMoreBS (headerLength - 1))
+      it "successfully decodes valid input." $ property canPeekBS
+  describe "decodeMessage" $ do
+    describe "ByteString" $ do
+      it "Throws an Exception on incomplete messages." decodeIncomplete
+      it "Throws an Exception on messages that are shorter than indicated." decodeTooShort
+#ifndef mingw32_HOST_OS
+    describe "Socket" $ do
+      it "Decodes data trickling through a socket." $ property decodeTricklingMessageFd
+#endif
+
+roundtrip :: [Int] -> Property IO
+roundtrip xs = monadic $ do
+  xs' <- runResourceT $ C.sourceList xs
+    =$= C.map Message
+    =$= conduitEncode
+    =$= conduitDecode Nothing
+    =$= C.map fromMessage
+    $$ C.consume
+  return $ xs' == xs
+
+roundtripChunked :: [Int] -> Property IO
+roundtripChunked input = monadic $ do
+  let (xs, chunkLengths) = splitAt (length input `div` 2) input
+  bs <- C.sourceList xs
+    =$= C.map Message
+    =$= conduitEncode
+    $$ C.fold (<>) mempty
+  let chunks = unfoldr takeChunk (bs, chunkLengths)
+  xs' <- runResourceT $ C.sourceList chunks
+    =$= conduitDecode (Just 10)
+    =$= C.map fromMessage
+    $$ C.consume
+  return $ xs' == xs
+  where
+    takeChunk (x, _) | BS.null x = Nothing
+    takeChunk (x, []) = Just (x, (BS.empty, []))
+    takeChunk (x, l:ls) =
+        let (chunk, rest) = BS.splitAt l x
+        in Just (chunk, (rest, ls))
+
+conduitIncomplete :: Expectation
+conduitIncomplete =
+    (runResourceT (C.sourceList [incompleteInput]
+                  =$= conduitDecode (Just 10)
+                  $$ C.consume)
+    :: IO [Message Integer]) `shouldThrow` \PeekException{} -> True
+
+conduitExcess :: [Int] -> Property IO
+conduitExcess xs = monadic $ do
+  bs <- C.sourceList xs
+    =$= C.map Message
+    =$= conduitEncode
+    $$ C.fold (<>) mempty
+  res <- try (runResourceT (C.sourceList [bs `BS.append` "excess bytes"]
+                            =$= conduitDecode (Just 10)
+                            $$ C.consume) :: IO [Message Int])
+  case res of
+      Right _ -> return False
+      Left (PeekException _ _) -> return True
+
+-- splits an encoded message after n bytes.  Feeds the first part to
+-- peekResult, expecting it to require more input.  Then, feeds the
+-- second part and checks if the decoded result is the original
+-- message.
+askMoreBS :: Int -> Integer -> Property IO
+askMoreBS n x = monadic $ BB.with (Just 10) $ \ bb -> do
+  let bs = encodeMessage (Message x)
+      (start, end) = BS.splitAt n $ bs
+  BB.copyByteString bb start
+  peekResult <- runFreeT (fromFT (peekMessageBS bb))
+  case peekResult of
+    Free cont ->
+      runFreeT (cont end) >>= \case
+        Pure (Message x') -> return $ x' == x
+        Free _ -> return False
+    Pure _ -> return False
+
+canPeekBS :: Integer -> Property IO
+canPeekBS x = monadic $ BB.with (Just 10) $ \ bb -> do
+  let bs = encodeMessage (Message x)
+  BB.copyByteString bb bs
+  peekResult <- runFreeT (fromFT (peekMessageBS bb))
+  case peekResult of
+    Free _ -> return False
+    Pure (Message x') -> return $ x' == x
+
+#ifndef mingw32_HOST_OS
+
+socketFd :: Socket -> Fd
+socketFd (MkSocket fd _ _ _ _) = Fd fd
+
+withServer :: (Socket -> Socket -> IO a) -> IO a
+withServer cont = do
+  sock1Var :: MVar Socket <- newEmptyMVar
+  sock2Var :: MVar Socket <- newEmptyMVar
+  portVar :: MVar Int <- newEmptyMVar
+  doneVar :: MVar Void <- newEmptyMVar
+  let adSocket ad = case appRawSocket' ad of
+        Nothing -> error "withServer.adSocket: no raw socket in AppData"
+        Just sock -> sock
+  let ss = setAfterBind
+        (putMVar portVar . fromIntegral <=< socketPort)
+        (serverSettingsTCP 0 "127.0.0.1")
+  x <- fmap (either (either absurd absurd) id) $ race
+    (race
+      (runTCPServer ss $ \ad -> do
+        putMVar sock1Var (adSocket ad)
+        void (readMVar doneVar))
+      (do port <- takeMVar portVar
+          runTCPClient (clientSettingsTCP port "127.0.0.1") $ \ad -> do
+            putMVar sock2Var (adSocket ad)
+            readMVar doneVar))
+    (do sock1 <- takeMVar sock1Var
+        sock2 <- takeMVar sock2Var
+        cont sock1 sock2)
+  putMVar doneVar (error "withServer: impossible: read from doneVar")
+  return x
+
+decodeTricklingMessageFd :: Integer -> Property IO
+decodeTricklingMessageFd v = monadic $ do
+  let bs = encodeMessage (Message v)
+  BB.with Nothing $ \bb ->
+    withServer $ \sock1 sock2 -> do
+      let generateChunks :: [Int] -> BS.ByteString -> [BS.ByteString]
+          generateChunks xs0 bs_ = case xs0 of
+            [] -> generateChunks [1,3,10] bs_
+            x : xs -> if BS.null bs_
+              then []
+              else BS.take x bs_ : generateChunks xs (BS.drop x bs_)
+      let chunks = generateChunks [] bs
+      ((), Message v') <- concurrently
+        (forM_ chunks $ \chunk -> do
+          void (send sock1 chunk)
+          threadDelay (10 * 1000))
+        (decodeMessageFd bb (socketFd sock2))
+      return (v == v')
+
+#endif
+
+decodeIncomplete :: IO ()
+decodeIncomplete = BB.with (Just 0) $ \ bb -> do
+  BB.copyByteString bb (BS.take 1 incompleteInput)
+  (decodeMessageBS bb (return Nothing) :: IO (Maybe (Message Integer)))
+    `shouldThrow` \PeekException{} -> True
+
+incompleteInput :: BS.ByteString
+incompleteInput =
+  let bs = encodeMessage (Message (42 :: Integer))
+  in BS.take (BS.length bs - 1) bs
+
+decodeTooShort :: IO ()
+decodeTooShort = BB.with Nothing $ \bb -> do
+    BB.copyByteString bb (encodeMessageTooShort . Message $ (1 :: Int))
+    (decodeMessageBS bb (return Nothing) :: IO (Maybe (Message Int)))
+        `shouldThrow` \PeekException{} -> True
+
+encodeMessageTooShort :: Message Int -> BS.ByteString
+encodeMessageTooShort msg =
+    BS.take (BS.length encoded - (getSize (0 :: Int))) encoded
+  where
+    encoded = encodeMessage msg
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}