diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,19 @@
+# Revision history for disk-bytes
+
+All notable changes to this project will (hopefully) be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org).
+
+## Unreleased
+
+(This section tracks upcoming changes.)
+
+## 0.1.0.0 — 2022-09-25
+
+Initial release.
+
+### Added
+
+* Module `System.Mem.Disk` which introduces the `DiskBytes` and `Disk` data types.
+* Benchmark `memory` that tests whether RAM usage and garbage collection work as claimed.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2022, Heinrich Apfelmus
+
+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 Heinrich Apfelmus 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,52 @@
+# disk-bytes
+
+This package provides a data type `DiskBytes` which represents a sequence of bytes that is stored on disk — but in a referentially transparent manner.
+
+The key invariant is that a value of type `DiskBytes` that has been evaluated *to weak-head normal form* (WHNF) occupies just a few words of RAM, but many bytes of on-disk storage. (We can't guarantee anything about expressions that are not in WHNF.)
+
+The main use case for `DiskBytes` is when you have a pure Haskell program which is storing too much data, and you want to offload some of this data in a controlled, yet transparent way to disk — without `IO` doing violence to your beautiful, pure Haskell code.
+
+The interface for `DiskBytes` consists of two *pure* functions which convert to/from an in-memory (RAM) `ByteString`:
+
+```hs
+toDiskBytes :: Disk -> ByteString -> DiskBytes
+fromDiskBytes :: DiskBytes -> ByteString
+```
+
+Here, `Disk` represents the on-disk storage, typically obtained by opening a file on the file system. One can interpret `Disk` as virtual memory.
+
+## Implementation Details
+
+### Disk storage
+
+Currently, the `Disk` data type is implemented as an open sqlite database file. In other words, sqlite is used to manage on-disk memory in a file. I decided to use an existing library for on-disk storage, because managing the on-disk storage (B+ trees, trade-offs between read and write speed, …) is an interesting problem, but it's not a problem that I want to solve *here*.
+
+However, sqlite is a bit overkill, because all that we need is a key-value store. In the future, one might consider on-disk storage libraries such as [lmdb][] or [RocksDB][] — I picked sqlite simply because it has Haskell bindings that I have used before. Pull requests (with benchmarks) are welcome.
+
+### Sqlite
+
+TODO: Implement batching? We may want to batch *insertions* and *deletions* until the total number of bytes to process reaches a certain threshold, e.g. 10kB? Rumor has it that sequences of database operations such as `INSERT INTO` become faster if they are batched into a single transaction, rather than run as separate queries with just a few bytes each.
+
+### Referential transparency
+
+Internally, the `DiskBytes` type uses `unsafePerformIO`. However, this use is referentially transparent as long as the library has exclusive access to the on-disk storage. In other words, we assume that the on-disk memory is as exclusive to the Haskell run-time as we assume that RAM is exclusive to the Haskell run-time. 
+
+TODO: Make an honest attempt to ensure that no other process can read or write to the file, e.g. by setting file permissions.
+
+### Testing
+
+Currently, the benchmark `memory` serves as a basic test that everything is working as intended. You can run the benchmark and look at its heap profile by executing the commands
+
+```shell
+$ cabal bench
+$ hp2pretty memory.hp
+```
+
+This tests the following properties:
+
+* `DiskBytes` that are alive do not use much RAM. (Currently, ~`100` bytes per WHNF of `DiskBytes`.)
+* `DiskBytes` that are not alive are garbage collected and disk memory is freed. (This works as the value returned by `getDiskSize` stops growing.)
+* The bytes of 'DiskBytes' that are alive can be loaded back into RAM. (`fromDiskBytes` does not throw an error.)
+
+  [lmdb]: https://en.wikipedia.org/wiki/Lightning_Memory-Mapped_Database
+  [rocksdb]: https://en.wikipedia.org/wiki/RocksDB
diff --git a/disk-bytes.cabal b/disk-bytes.cabal
new file mode 100644
--- /dev/null
+++ b/disk-bytes.cabal
@@ -0,0 +1,58 @@
+cabal-version:      2.4
+name:               disk-bytes
+version:            0.1.0.0
+synopsis:           On-disk storage, but referentially transparent
+description:
+    This package provides a data type 'DiskBytes' which represents a sequence of bytes that is stored on disk — but in a referentially transparent manner.
+category:           Memory
+
+license:            BSD-3-Clause
+license-file:       LICENSE
+copyright:          Copyright (c) 2022 Heinrich Apfelmus
+author:             Heinrich Apfelmus
+maintainer:         apfelmus@quantentunnel.de
+homepage:           https://github.com/HeinrichApfelmus/disk-bytes
+bug-reports:        https://github.com/HeinrichApfelmus/disk-bytes/issues
+
+extra-source-files:
+    CHANGELOG.md
+    README.md
+
+library
+    exposed-modules:
+        System.Mem.Disk
+    other-modules:
+        System.Mem.Disk.Bytes
+        System.Mem.Disk.BytesPlain
+        System.Mem.Disk.DiskApi
+        System.Mem.Disk.Memory
+        System.Mem.Disk.Sqlite
+    default-extensions:
+        NamedFieldPuns
+    other-extensions:
+        MagicHash
+        OverloadedStrings
+        UnboxedTuples
+    build-depends:
+          base >= 4.14.3.0 && < 4.18
+        , bytestring >= 0.10.12.0 && < 0.12 
+        , containers ^>= 0.6.5.1
+        , directory ^>= 1.3.6.0
+        , direct-sqlite ^>=2.3.27
+        , stm ^>= 2.5.0.1
+        , text >= 1.2.4.1 && < 2.1
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+benchmark memory
+    type:             exitcode-stdio-1.0
+    main-is:          bench-memory.hs
+    hs-source-dirs:   src-bench
+    build-depends:
+          base
+        , disk-bytes
+        , bytestring
+        , text
+    ghc-options:
+        "-with-rtsopts=-p -s -h -i0.05"
+    default-language: Haskell2010
diff --git a/src-bench/bench-memory.hs b/src-bench/bench-memory.hs
new file mode 100644
--- /dev/null
+++ b/src-bench/bench-memory.hs
@@ -0,0 +1,67 @@
+module Main where
+
+import Control.Concurrent
+    ( threadDelay )
+import Control.Exception
+    ( evaluate )
+import Control.Monad
+    ( forM )
+import Data.ByteString
+    ( ByteString )
+import System.Mem.Disk
+import System.Mem
+    ( performGC )
+import Data.IORef
+
+import qualified Data.ByteString as BS
+
+{-----------------------------------------------------------------------------
+    Benchmark parameters ------------------------------------------------------------------------------}
+chunkSize, totalSize, maxSize :: Int
+chunkSize = 2000 -- bytes
+maxSize   = 1000 * chunkSize -- bytes
+totalSize = 3 * maxSize -- bytes
+
+{-----------------------------------------------------------------------------
+    Benchmark execution ------------------------------------------------------------------------------}
+main :: IO ()
+main = withDiskSqlite "bench-mem.db" $ \disk -> do
+    let batches = totalSize `div` maxSize
+        batchSize = maxSize `div` chunkSize
+
+    xss <- forM [1 .. batches] $ \i -> do
+        say $ "Batch number " <> show i
+        say $ ".. create `DiskBytes` and garbage collect `ByteString`"
+        say $ "   invariant: `DiskBytes` in WHNF does not use RAM"
+        xs <- forM [1 .. batchSize] $ \j -> do
+            let x = toDiskBytes disk (mkBytes chunkSize j) :: DiskBytes
+            x `seq` performGC
+            pure x
+
+        say $ ".. evaluate and discard `fromDiskBytes`"
+        say $ "   invariant: `DiskBytes` store valid data"
+        mapM_ (evaluate . fromDiskBytes) xs
+
+        say $ ".. [pause]"
+        threadDelaySeconds 2
+
+        say $ ".. garbage collect on-disk `DiskBytes`"
+        say $ "   invariant: disk memory is released for `DiskBytes`"
+              <> " that are not alive"
+        performGC
+
+        say . (\x -> "Disk size: " <> show x <> " bytes") =<< getDiskSize disk
+        pure []
+
+    evaluate $ concat xss
+
+    pure ()
+
+mkBytes :: Int -> Int -> ByteString
+mkBytes n seed = BS.pack $ map (\x -> toEnum $ (x+seed) `mod` 2^8) [1..n]
+
+say :: String -> IO ()
+say = putStrLn
+
+threadDelaySeconds :: Int -> IO ()
+threadDelaySeconds s = threadDelay (s * 1000 * 1000)
diff --git a/src/System/Mem/Disk.hs b/src/System/Mem/Disk.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Mem/Disk.hs
@@ -0,0 +1,43 @@
+module System.Mem.Disk
+    ( -- * Synopsis
+      -- $synopsis
+
+      -- * DiskBytes 
+      DiskBytes
+    , toDiskBytes
+    , fromDiskBytes
+      -- * Disk storage space
+    , Disk
+    , getDiskSize
+    , withDiskSqlite
+    , withDiskMemory
+    ) where
+
+import Data.ByteString
+    ( ByteString )
+import System.Mem.Disk.Bytes
+import System.Mem.Disk.DiskApi
+    ( Disk, getDiskSize )
+import System.Mem.Disk.Memory
+    ( withDiskMemory )
+import System.Mem.Disk.Sqlite
+    ( withDiskSqlite )
+
+{- $synopsis
+
+This module introduces a data type 'DiskBytes' which represents a sequence
+of bytes.
+However, unlike most Haskell data types, values of this type
+are not stored in volatile RAM, but on the hard disk (e.g. magnetic or SSD).
+But just like ordinary Haskell data types,
+this type is referentially transparent — no 'IO' is needed to access the disk!
+
+The purpose of this data type is to allow you to make
+trade-offs between RAM (scarce but fast) and disk (plenty but slow)
+simply by switching between the 'ByteString' and 'DiskBytes' types —
+while keeping the Haskell code pure. In order to test whether this worked out in your favor, you can use the 'withDiskMemory' function.
+
+The on-disk storage space is represented by the 'Disk' type.
+Typically, this storage is managed through a file on the file system,
+e.g. using 'withDiskSqlite'.
+-}
diff --git a/src/System/Mem/Disk/Bytes.hs b/src/System/Mem/Disk/Bytes.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Mem/Disk/Bytes.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+-- | Implementation of 'DiskBytes' using GHC-specific primitives
+-- like 'mkWeak#'. Unfortunately,
+-- I have not been able to bring down the RAM size of 'DiskByte'
+-- significantly below 100 bytes yet.
+module System.Mem.Disk.Bytes
+    ( DiskBytes
+    , toDiskBytes
+    , fromDiskBytes
+    ) where
+
+import Data.ByteString
+    ( ByteString )
+import Data.Int
+    ( Int64 )
+import System.IO.Unsafe
+    ( unsafePerformIO )
+import System.Mem.Disk.DiskApi
+    ( Disk (..) )
+
+import GHC.Exts (Int#, Int(I#))
+import GHC.Base
+import GHC.Weak
+
+{-----------------------------------------------------------------------------
+    DiskBytes
+------------------------------------------------------------------------------}
+-- | A sequence of bytes that is stored on disk
+-- — if and only if the value is evaluated to WHNF.
+--
+-- The value is subject to normal garbage collection:
+-- When the value is no longer referenced,
+-- the disk memory will be freed (eventually).
+--
+-- For estimating the memory cost:
+-- Even though the bulk of the data is kept on disk,
+-- each WHNF of 'DiskBytes' occupies roughly @~100@ bytes of RAM;
+-- this is due to administrative overhead like weak pointers and finalizers.
+data DiskBytes = DiskBytes
+    { index :: Int#
+    , disk  :: Disk
+    }
+
+-- | Make a weak pointer for our purposes.
+addFinalizerBytes :: DiskBytes -> IO () -> IO ()
+addFinalizerBytes v@(DiskBytes{}) (IO finalizer) = IO $ \s ->
+    case mkWeak# v v finalizer s of (# s1, w #) -> (# s1, () #)
+
+-- | Offload a sequence of bytes onto a 'Disk'.
+-- 
+-- NOTE: The result must be evaluated to WHNF before the data is actually
+-- on disk!
+-- Also, the original 'ByteString' needs to be garbage collected
+-- in for its RAM to become free.
+toDiskBytes :: Disk -> ByteString -> DiskBytes
+toDiskBytes disk = unsafePerformIO . mkDiskBytes disk
+
+mkDiskBytes :: Disk -> ByteString -> IO DiskBytes
+mkDiskBytes disk bytes = do
+    I# index <- fromEnum <$> put disk bytes
+    let diskbytes = DiskBytes{index,disk}
+    diskbytes `seq` (addFinalizerBytes diskbytes $ finalizerBytes diskbytes)
+    pure diskbytes
+
+{-# NOINLINE finalizerBytes #-}
+finalizerBytes :: DiskBytes -> IO ()
+finalizerBytes DiskBytes{index,disk} =
+    delete disk $ toEnum $ I# index
+
+-- | Read the sequence of bytes back into RAM.
+fromDiskBytes :: DiskBytes -> ByteString
+fromDiskBytes = unsafePerformIO . unpackM
+
+unpackM :: DiskBytes -> IO ByteString
+unpackM DiskBytes{index,disk} =
+    get disk $ toEnum $ I# index
diff --git a/src/System/Mem/Disk/BytesPlain.hs b/src/System/Mem/Disk/BytesPlain.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Mem/Disk/BytesPlain.hs
@@ -0,0 +1,64 @@
+-- | Simpler implementation of 'DiskBytes' using 'mkWeakIORef'.
+-- It looks like this implementation is not significantly worse than the
+-- one trying to use GHC-specific primitives.
+module System.Mem.Disk.BytesPlain
+    ( DiskBytes
+    , toDiskBytes
+    , fromDiskBytes
+    ) where
+
+import Data.ByteString
+    ( ByteString )
+import Data.Int
+    ( Int64 )
+import Data.IORef
+    ( IORef, newIORef, readIORef, mkWeakIORef )
+import System.IO.Unsafe
+    ( unsafePerformIO )
+import System.Mem.Disk.DiskApi
+    ( Disk (..) )
+
+{-----------------------------------------------------------------------------
+    DiskBytes
+------------------------------------------------------------------------------}
+-- | A sequence of bytes that is stored on disk
+-- -- if and only if the value is evaluated to WHNF.
+--
+-- The value is subject to normal garbage collection:
+-- When the value is no longer referenced,
+-- the disk memory will be freed (eventually).
+newtype DiskBytes = DiskBytes { unDiskBytes :: IORef DiskBytesData }
+
+data DiskBytesData = DiskBytesData
+    { index :: !Int64
+    , disk  :: Disk
+    }
+
+-- | Offload a sequence of bytes onto a 'Disk'.
+-- 
+-- NOTE: The result must be evaluated to WHNF before the data actually
+-- on disk! Also keep in mind that the original 'ByteString' needs
+-- to be garbage collected.
+toDiskBytes :: Disk -> ByteString -> DiskBytes
+toDiskBytes disk = unsafePerformIO . mkDiskBytes disk
+
+mkDiskBytes :: Disk -> ByteString -> IO DiskBytes
+mkDiskBytes disk bytes = do
+    index <- put disk bytes
+    ptr <- newIORef DiskBytesData{index, disk}
+    _ <- mkWeakIORef ptr (finalizer ptr)
+    pure $ DiskBytes ptr
+
+finalizer :: IORef DiskBytesData -> IO ()
+finalizer ptr = do
+    DiskBytesData{index,disk} <- readIORef ptr
+    delete disk index
+
+-- | Read the sequence of bytes back into RAM.
+fromDiskBytes :: DiskBytes -> ByteString
+fromDiskBytes = unsafePerformIO . unpackM
+
+unpackM :: DiskBytes -> IO ByteString
+unpackM (DiskBytes ptr) = do
+    DiskBytesData{index,disk} <- readIORef ptr
+    get disk index
diff --git a/src/System/Mem/Disk/DiskApi.hs b/src/System/Mem/Disk/DiskApi.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Mem/Disk/DiskApi.hs
@@ -0,0 +1,21 @@
+-- | Representation of 'Disk' as an object-like record —
+-- this allows multiple storage space implementations.
+module System.Mem.Disk.DiskApi where
+
+import Data.ByteString
+    ( ByteString )
+import Data.Int
+    ( Int64 )
+
+{-----------------------------------------------------------------------------
+    Disk
+------------------------------------------------------------------------------}
+-- | Represents the on-disk storage where
+-- t'System.Mem.Disk.DiskBytes' are stored.
+data Disk = Disk
+    { put :: ByteString -> IO Int64
+    , get :: Int64 -> IO ByteString
+    , delete :: Int64 -> IO ()
+    , getDiskSize :: IO Integer
+        -- ^ Rough estimate of the current size of the 'Disk', in bytes.
+    }
diff --git a/src/System/Mem/Disk/Memory.hs b/src/System/Mem/Disk/Memory.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Mem/Disk/Memory.hs
@@ -0,0 +1,67 @@
+-- | Simple, stupid implementation of a RAM-based 'Disk' for testing.
+module System.Mem.Disk.Memory where
+
+import Data.ByteString
+    ( ByteString )
+import Data.Foldable
+    ( foldl' )
+import Data.Int
+    ( Int64 )
+import Data.IORef
+
+import qualified Control.Concurrent.STM as STM
+import qualified Data.ByteString as BS
+import qualified Data.Map.Strict as Map
+import qualified System.Mem.Disk.DiskApi as DiskApi
+
+{-----------------------------------------------------------------------------
+    Disk
+------------------------------------------------------------------------------}
+data Disk = Disk
+    { db :: IORef (Map.Map Int64 ByteString)
+    , counter :: IORef Int64
+    }
+
+-- | Create a 'Disk' in memory for the purpose of testing and profiling
+-- — by swapping v'System.Mem.Disk.withDiskMemory'
+-- for  v'System.Mem.Disk.withDiskSqlite' and looking at the
+-- heap profile of your program, you can quickly find out whether the
+-- use of t'System.Mem.Disk.DiskBytes' really helps.
+--
+-- Ignores the 'FilePath' argument.
+withDiskMemory :: FilePath -> (DiskApi.Disk -> IO a) -> IO a
+withDiskMemory _ action = do
+    db <- newIORef Map.empty
+    counter <- newIORef 0
+    action $ mkDiskApi $ Disk{db,counter}
+
+getDiskSize_ :: Disk -> IO Integer
+getDiskSize_ Disk{db} = sumBytes <$> readIORef db
+  where
+    sumBytes = foldl' (\n bs -> n + fromIntegral (BS.length bs)) 0
+
+mkDiskApi :: Disk -> DiskApi.Disk
+mkDiskApi disk = DiskApi.Disk
+    { DiskApi.put = put_ disk
+    , DiskApi.get = get_ disk
+    , DiskApi.delete = delete_ disk
+    , DiskApi.getDiskSize = getDiskSize_ disk
+    }
+
+{-----------------------------------------------------------------------------
+    Disk operations
+------------------------------------------------------------------------------}
+put_ :: Disk -> ByteString -> IO Int64
+put_ Disk{db,counter} bytes = do
+    index <- atomicModifyIORef' counter $ \x -> (x+1,x)
+    atomicModifyIORef' db $ \db_ -> (Map.insert index bytes db_, ())
+    pure index
+
+get_ :: Disk -> Int64 -> IO ByteString
+get_ Disk{db} index = do
+    Just bytes <- Map.lookup index <$> readIORef db
+    pure bytes
+
+delete_ :: Disk -> Int64 -> IO ()
+delete_ Disk{db} index =
+    atomicModifyIORef' db $ \db_ -> (Map.delete index db_, ())
diff --git a/src/System/Mem/Disk/Sqlite.hs b/src/System/Mem/Disk/Sqlite.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Mem/Disk/Sqlite.hs
@@ -0,0 +1,167 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Implementation of an Sqlite-based 'Disk'.
+module System.Mem.Disk.Sqlite where
+
+import Control.Concurrent
+    ( forkIO, killThread, ThreadId )
+import Control.Exception
+    ( bracket )
+import Control.Monad
+    ( forever, when )
+import Data.ByteString
+    ( ByteString )
+import Data.Int
+    ( Int64 )
+import Data.IORef
+
+import qualified Control.Concurrent.STM as STM
+import qualified Data.Text as T
+import qualified Database.SQLite3 as Sql
+import qualified System.IO.Error as Sys
+import qualified System.Directory as Sys
+
+import qualified System.Mem.Disk.DiskApi as DiskApi
+
+{-----------------------------------------------------------------------------
+    File system helpers
+------------------------------------------------------------------------------}
+withFile :: FilePath -> IO a -> IO a
+withFile path action = bracket
+    (throwIfAlreadyExists path)
+    (\_ -> Sys.removeFile path)
+    (\_ -> action)
+
+-- | Throw an 'IOError' that indicates that the file already exists.
+throwIfAlreadyExists :: FilePath -> IO ()
+throwIfAlreadyExists path = do
+    b <- Sys.doesFileExist path
+    when b $ Sys.ioError $ Sys.mkIOError
+        Sys.alreadyExistsErrorType "Creating 'Disk'" Nothing (Just path)
+
+{-----------------------------------------------------------------------------
+    Disk
+------------------------------------------------------------------------------}
+data Disk = Disk
+    { path :: FilePath
+    , chan :: STM.TChan (Cmd STM.TMVar)
+    , counter :: IORef Int64
+    }
+
+-- | Obtain the size of the 'Disk' in bytes.
+-- Here, this is the file size.
+getDiskSize_ :: Disk -> IO Integer
+getDiskSize_ = Sys.getFileSize . path
+
+-- | Create a new file and use it for storing
+-- t'System.Mem.Disk.DiskBytes'.
+--
+-- Throw an error if the file already exists,
+-- delete the file after use.
+withDiskSqlite :: FilePath -> (DiskApi.Disk -> IO a) -> IO a
+withDiskSqlite path action =
+    withFile path $
+    withDatabase path $ \db ->
+    withSql db $ \sql ->
+    withThread sql $ \chan -> do
+        counter <- newIORef 0
+        action $ mkDiskApi $ Disk{path,chan,counter}
+  where
+    withDatabase path = bracket (Sql.open $ T.pack path) Sql.close
+
+mkDiskApi :: Disk -> DiskApi.Disk
+mkDiskApi disk = DiskApi.Disk
+    { DiskApi.put = put_ disk
+    , DiskApi.get = get_ disk
+    , DiskApi.delete = delete_ disk
+    , DiskApi.getDiskSize = getDiskSize_ disk
+    }
+
+{-----------------------------------------------------------------------------
+    Disk operations
+------------------------------------------------------------------------------}
+-- | Operations to be performed on the database
+data Cmd cont
+    = Put !Int64 ByteString
+    | Get !Int64 (cont ByteString)
+    | Delete !Int64
+
+put_ :: Disk -> ByteString -> IO Int64
+put_ Disk{chan,counter} bytes = do
+    index <- atomicModifyIORef' counter (\x -> (x+1,x))
+    STM.atomically $ STM.writeTChan chan $ Put index bytes
+    pure index
+
+get_ :: Disk -> Int64 -> IO ByteString
+get_ Disk{chan} index = do
+    k <- STM.newEmptyTMVarIO
+    STM.atomically $ STM.writeTChan chan $ Get index k
+    STM.atomically $ STM.takeTMVar k
+
+delete_ :: Disk -> Int64 -> IO ()
+delete_ Disk{chan} index =
+    STM.atomically $ STM.writeTChan chan $ Delete index
+
+{-----------------------------------------------------------------------------
+    Worker Thread
+------------------------------------------------------------------------------}
+-- | Worker thread for sequencing SQL commands.
+withThread :: SqlCmds -> (STM.TChan (Cmd STM.TMVar) -> IO a) -> IO a
+withThread sql action =
+    bracket (mkDatabaseThread sql) (killThread . fst) (\(_,c) -> action c)
+
+mkDatabaseThread :: SqlCmds -> IO (ThreadId, STM.TChan (Cmd STM.TMVar))
+mkDatabaseThread sql = do
+    chan <- STM.newTChanIO
+    threadId <- forkIO $ forever $
+        cmdSql sql =<< STM.atomically (STM.readTChan chan)
+    pure (threadId, chan)
+
+{-----------------------------------------------------------------------------
+    Sql
+------------------------------------------------------------------------------}
+data SqlCmds = SqlCmds
+    { sput_ :: Sql.Statement
+    , sget_ :: Sql.Statement
+    , sdelete_ :: Sql.Statement
+    }
+
+withSql :: Sql.Database -> (SqlCmds -> IO a) -> IO a
+withSql db = bracket (initSql db) finalizeSql
+
+initSql :: Sql.Database -> IO SqlCmds
+initSql db = do
+    Sql.exec db "CREATE TABLE db ( ix INTEGER PRIMARY KEY, bytes BLOB );"
+    sput_ <- Sql.prepare db "INSERT INTO db VALUES (?1,?2);"
+    sget_ <- Sql.prepare db "SELECT bytes FROM db WHERE ix = ?1;"
+    sdelete_ <- Sql.prepare db "DELETE FROM db WHERE ix = ?1;"
+    pure $ SqlCmds{sput_,sget_,sdelete_}
+
+finalizeSql :: SqlCmds -> IO ()
+finalizeSql SqlCmds{sput_,sget_,sdelete_} = do
+    mapM_ Sql.finalize [sput_, sget_, sdelete_]
+
+cmdSql :: SqlCmds -> Cmd STM.TMVar -> IO ()
+cmdSql SqlCmds{sput_,sget_,sdelete_} cmd = case cmd of
+    Put index bytes -> do
+        let s = sput_
+        Sql.bind s [Sql.SQLInteger index, Sql.SQLBlob bytes]
+        _ <- Sql.stepNoCB s
+        reset s
+
+    Get index k -> do
+        let s = sget_
+        Sql.bind s [Sql.SQLInteger index]
+        Sql.Row <- Sql.stepNoCB s
+        bytes <- Sql.columnBlob s 0
+        reset s
+        STM.atomically $ STM.putTMVar k bytes
+
+    Delete index -> do
+        let s = sdelete_
+        Sql.bind s [Sql.SQLInteger index]
+        Sql.Done <- Sql.stepNoCB s
+        reset s
+
+  where
+    reset s = Sql.reset s >> Sql.clearBindings s