diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for spock-beam
+
+## 0.1.0.0  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2019, Jeremy Groven
+
+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 Jeremy Groven 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,104 @@
+# TsWeb - A very opinionated web API
+
+TsWeb is a binding between the Spock web framework and the Beam database
+API. It provides convenience functions for running database queries from
+within Spock actions, a Spock session manager replacement using the Beam API,
+and type-safe routing including type-checked reverse lookups (URLs are
+associated with first-class labels which are used for reverse lookup).
+
+## Sample Program
+
+Most of the functionality of TsWeb (ideally, all of it) is demonstrated in the
+example program, which lives under the Example directory of the source tree.
+Have a look there for a working example of TsWeb.
+
+## Restricted Views
+
+TsWeb views run with minimal rights; by default they do not have access to the
+database nor do they have any user information initialized. A view's type
+signature enumerates its requirements, and those requirements are specified in
+the view's routing. For example, a view that needs read-write database access,
+an admin user, and a route to the index URL might have this type signature:
+
+```
+myview ::
+  ( ListContains n0 Admin xs
+  , ListContains n1 ReadWritePool xs
+  , Has "index" lts (Path '[] 'Open) )
+  => TsActionCtxT lts xs sessdata a
+myview = do
+  db :: ReadOnlyPool <- getExtra
+  Admin me <- getExtra
+  indexPath <- showPath #index
+  ...
+```
+
+And then the view would be routed as:
+
+```
+runroute readonlypool readwritepool $
+  path #index root (getpost indexView) .
+  path #myview "mine" (dbwrite $ getpost $ auth adminP yview)
+```
+
+See the docs for "TsWeb.Routing" and "TsWeb.Routing.Auth" for more details.
+
+## Action Queries
+
+Have a look at "TsWeb.Db" for documentation on running Beam queries from a
+Spock context. This is just sugar, but it's pretty nice. A small example:
+
+```
+myview :: ListContains n ReadWritePool xs => TsActionCtxT lts xs sessdata a
+myview = do
+  queryList (select $ all_ (_dbUser db)) >>= \case
+    QSimply users -> text $ T.pack $ show users
+    QError err -> text $ "Error: " <> Text.pack (show err)
+```
+
+See "TsWeb.Db" for more details.
+
+## Session Manager
+
+This is pretty much invisible, but use TsWeb.Session.patchConfig on your Spock
+config to replace the default session manager with the TsWeb one. Lifted
+directly from the "TsWeb.Session" documentation:
+
+```
+spockCfg <-
+  patchConfig (_dbSession db) ropool rwpool <$>
+  defaultSpockCfg sess PCNoDatabase ()
+runSpock port (spock spockCfg routes)
+where
+  sess = ...
+  routes = ...
+```
+
+## Type-safe URLs with reversing.
+
+TsWeb builds on Spock's reroute library to also add type-checked reverse
+lookups. There's a pretty complete document on that under "TsWeb.Routing",
+which I'm simply pasting in here:
+
+```
+index :: Has "users" lts (Path '[] 'Open) => TsActionCtxT lts xs sess a
+index = showPath #users >>= text
+
+users :: Has "root" lts (Path '[] 'Open) => TsActionCtxT lts xs sess a
+users = do
+  root <- showPath #root
+  text $ "GET users, root is, " <> root
+
+usersPost :: TsActionCtxT lts xs sess a
+usersPost = text "POST to users!"
+```
+
+Then, routing to those views looks like this:
+
+```
+runroute ropool rwpool $
+  path #root root (getpost index) .
+  path #users "users" (do get users
+                          post usersPost)
+```
+
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/Example/Main.hs b/src/Example/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Example/Main.hs
@@ -0,0 +1,51 @@
+module Example.Main where
+
+import Example.Types
+import Example.Views
+
+import TsWeb.Routing (dbwrite, get, getpost, path, post, runroute)
+import TsWeb.Routing.Auth (auth)
+import TsWeb.Session (patchConfig)
+import TsWeb.Types (TsWebStateM)
+import TsWeb.Types.Db (ReadOnlyPool, ReadWritePool, pool)
+
+import qualified Web.Spock as Spock
+
+import Web.Spock ((<//>), root, text, var)
+import Web.Spock.Config (PoolOrConn(..), defaultSpockCfg, spc_csrfProtection)
+import Web.Spock.Core (SpockCtxT)
+
+main :: IO ()
+main = do
+  rwpool <- pool "localhost" "tsweb" "tsweb" 1 12 1
+  ropool <- pool "localhost" "tsweb" "tsweb" 1 12 1
+  spockCfg <-
+    patchConfig (_dbSession db) ropool rwpool <$>
+    defaultSpockCfg sess PCNoDatabase ()
+  Spock.runSpock
+    8080
+    (Spock.spock (spockCfg {spc_csrfProtection = False}) (routes ropool rwpool))
+  where
+    sess :: SessionData
+    sess = SessionData (UserId Nothing) False
+
+routes ::
+     ReadOnlyPool -> ReadWritePool -> SpockCtxT () (TsWebStateM SessionData) ()
+routes ropool rwpool =
+  runroute ropool rwpool $
+  path
+    #root
+    root
+    (do get index
+        get $ auth userP userindex
+        get $ auth adminP adminindex
+        post $ text "post\n") .
+  path #admin "admin" (get $ auth adminP adminindex) .
+  path #users "users" (getpost users) .
+  path
+    #user
+    ("users" <//> var)
+    (do TsWeb.Routing.get $ viewuser
+        dbwrite $ post makeuser) .
+  path #login ("login" <//> var) (post login) .
+  path #logind "login" (get loginstat) . path #logout "logout" (getpost logout)
diff --git a/src/Example/Types.hs b/src/Example/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Example/Types.hs
@@ -0,0 +1,120 @@
+module Example.Types where
+
+import qualified TsWeb.Db
+
+import TsWeb.Db (QueryResult(..), queryMaybe)
+import TsWeb.Routing.Auth (Authorize(..))
+import TsWeb.Session (UserData(..))
+import TsWeb.Tables.Session (SessionT)
+
+import qualified Data.Text as Text
+import qualified Web.Spock as Spock
+
+import Data.Proxy (Proxy(..))
+import Data.Text (Text)
+import Database.Beam
+
+data Db f = Db
+  { _dbUser :: f (TableEntity UserT)
+  , _dbSession :: f (TableEntity (SessionT SessionDataT))
+  } deriving (Generic)
+
+instance Database be Db
+
+db :: DatabaseSettings be Db
+db = defaultDbSettings
+
+data UserT f = User
+  { _userId :: C f Int
+  , _userLogin :: C f Text
+  } deriving (Generic)
+
+type User = UserT Identity
+
+type UserId = PrimaryKey UserT Identity
+
+data SessionDataT f = SessionData
+  { _sdUser :: PrimaryKey UserT (Nullable f)
+  , _sdRemember :: C f Bool
+  } deriving (Generic)
+
+type SessionData = SessionDataT Identity
+
+data Admin =
+  Admin User
+  deriving (Eq, Ord, Show)
+
+adminP :: Proxy Admin
+adminP = Proxy
+
+instance Authorize SessionData Admin where
+  checkAuth _ =
+    _sdUser <$> Spock.readSession >>= \case
+      UserId Nothing -> pure Nothing
+      UserId (Just uid) ->
+        queryMaybe (select $ q uid) >>= \case
+          QSimply (Just user) ->
+            if "-admin" `Text.isSuffixOf` _userLogin user
+              then pure $ Just (Admin user)
+              else pure Nothing
+          _ -> pure Nothing
+    where
+      q uid = do
+        u <- all_ $ _dbUser db
+        guard_ $ _userId u ==. val_ uid
+        pure u
+
+userP :: Proxy User
+userP = Proxy
+
+instance Authorize SessionData User where
+  checkAuth _ =
+    _sdUser <$> Spock.readSession >>= \case
+      UserId Nothing -> pure Nothing
+      UserId (Just uid) ->
+        queryMaybe (select $ q uid) >>= \case
+          QSimply (Just user) -> pure $ Just user
+          _ -> pure Nothing
+    where
+      q uid = do
+        u <- all_ $ _dbUser db
+        guard_ $ _userId u ==. val_ uid
+        pure u
+
+deriving instance Show (PrimaryKey UserT (Nullable Identity))
+
+deriving instance Show (PrimaryKey UserT Identity)
+
+deriving instance Show User
+
+deriving instance Eq (PrimaryKey UserT (Nullable Identity))
+
+deriving instance Eq (PrimaryKey UserT Identity)
+
+deriving instance Eq User
+
+deriving instance Ord (PrimaryKey UserT (Nullable Identity))
+
+deriving instance Ord (PrimaryKey UserT Identity)
+
+deriving instance Ord User
+
+instance Beamable (PrimaryKey UserT)
+
+instance Beamable UserT
+
+instance Table UserT where
+  data PrimaryKey UserT f = UserId (Columnar f Int)
+                            deriving Generic
+  primaryKey = UserId . _userId
+
+deriving instance Show SessionData
+
+deriving instance Eq SessionData
+
+deriving instance Ord SessionData
+
+instance Beamable SessionDataT
+
+instance UserData SessionData where
+  rememberMe = _sdRemember
diff --git a/src/Example/Views.hs b/src/Example/Views.hs
new file mode 100644
--- /dev/null
+++ b/src/Example/Views.hs
@@ -0,0 +1,114 @@
+module Example.Views where
+
+import Example.Types
+
+import TsWeb.Action (getExtra, getPath, showPath)
+import TsWeb.Db (QueryResult(..), TxOpt(..), execute, queryList, queryMaybe)
+import TsWeb.Types (TsActionCtxT)
+import TsWeb.Types.Db (ReadOnlyPool, ReadWritePool)
+
+import qualified Data.Text as Text
+import Database.Beam as Beam
+import qualified Web.Spock as Spock
+
+import Data.HVect (ListContains)
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Database.Beam ((==.), all_, default_, guard_, just_, nothing_, pk, val_)
+import SuperRecord (Has)
+import Web.Routing.Combinators (PathState(Open))
+import Web.Spock (Path, text)
+
+adminindex ::
+     (ListContains n Admin xs, Has "users" lts (Path '[] 'Open))
+  => TsActionCtxT lts xs SessionData a
+adminindex =
+  showPath #users >>= \u -> text $ "Hello admin!\n" <> u <> "\n"
+
+userindex ::
+     ( ListContains n User xs
+     , Has "users" lts (Path '[] 'Open)
+     , Has "user" lts (Path '[ Text] 'Open)
+     )
+  => TsActionCtxT lts xs SessionData a
+userindex = do
+  (u :: User) <- getExtra
+  p0 <- showPath #users
+  p1 <- ($ _userLogin u) <$> showPath #user
+  text $ "Hello " <> _userLogin u <> "!\n" <> p0 <> "\n" <> p1 <> "\n"
+
+index :: Has "users" lts (Path '[] 'Open) => TsActionCtxT lts xs SessionData a
+index = do
+  p <- getPath #users
+  text $ Spock.renderRoute p <> "\n"
+
+users :: ListContains n ReadOnlyPool xs => TsActionCtxT lts xs SessionData a
+users =
+  queryList (Beam.select $ all_ (_dbUser db)) >>= \case
+    QSimply lst ->
+      text $
+      "Users: " <> Text.intercalate ", " [_userLogin u | u <- lst] <> "\n"
+    QError err -> text $ "Error: " <> Text.pack (show err)
+
+viewuser ::
+     ListContains n ReadOnlyPool xs => Text -> TsActionCtxT lts xs SessionData a
+viewuser user =
+  queryMaybe (Beam.select q) >>= \case
+    QError err -> text $ "Error: " <> Text.pack (show err)
+    QSimply Nothing -> text $ "User " <> user <> " not found\n"
+    QSimply (Just u) -> text $ (Text.pack $ show u) <> "\n"
+  where
+    q = do
+      u <- all_ $ _dbUser db
+      guard_ $ _userLogin u ==. val_ user
+      pure u
+
+makeuser ::
+     ListContains n ReadWritePool xs
+  => Text
+  -> TsActionCtxT lts xs SessionData a
+makeuser user = do
+  res <-
+    execute NoTx $
+    Beam.runInsert $
+    Beam.insert (_dbUser db) $
+    Beam.insertExpressions [User default_ (val_ user)]
+  text $ (Text.pack $ show res) <> "\n"
+
+login ::
+     ListContains n ReadOnlyPool xs => Text -> TsActionCtxT lts xs SessionData a
+login user =
+  queryMaybe (Beam.select q) >>= \case
+    QError err -> text $ "Error: " <> Text.pack (show err)
+    QSimply Nothing -> text $ "User " <> user <> " not found\n"
+    QSimply (Just u) -> do
+      sess <- Spock.readSession
+      Spock.writeSession $ sess {_sdUser = just_ $ pk u}
+      text $ (Text.pack $ show u) <> "\n"
+  where
+    q = do
+      u <- all_ $ _dbUser db
+      guard_ $ _userLogin u ==. val_ user
+      pure u
+
+loginstat :: ListContains n ReadOnlyPool xs => TsActionCtxT lts xs SessionData a
+loginstat = do
+  sess <- Spock.readSession
+  case _sdUser sess of
+    (UserId Nothing) -> text "Not logged in\n"
+    (UserId (Just uid)) ->
+      queryMaybe (Beam.select $ q uid) >>= \case
+        QSimply Nothing -> text "Logged in as a non-existent user!?\n"
+        QSimply (Just u) -> text $ "Logged in as " <> _userLogin u <> "\n"
+        QError err -> text $ "Error: " <> Text.pack (show err) <> "\n"
+  where
+    q uid = do
+      u <- all_ $ _dbUser db
+      guard_ $ _userId u ==. val_ uid
+      pure u
+
+logout :: TsActionCtxT lts xs SessionData a
+logout = do
+  sess <- Spock.readSession
+  Spock.writeSession $ sess {_sdUser = nothing_}
+  text "Logged Out\n"
diff --git a/src/TsWeb/Action.hs b/src/TsWeb/Action.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Action.hs
@@ -0,0 +1,83 @@
+{-|
+Description: Spock actions for interacting with the 'TsWeb.Types.Context'
+
+Various functions for reading data from the current Spock Action's context.
+Currently that's just reading URL path info and auth data.
+-}
+module TsWeb.Action
+  ( getPath
+  , showPath
+  , getExtra
+  ) where
+
+import TsWeb.Types (Context(..), TsActionCtxT)
+
+import Data.HVect (AllHave, HVectElim, ListContains, findFirst)
+import Data.Text (Text)
+import Database.Beam hiding (runSelectReturningList, runSelectReturningOne)
+import SuperRecord (FldProxy, Has, get)
+import Web.HttpApiData (ToHttpApiData)
+import Web.Routing.Combinators (PathState(Open))
+import Web.Spock (ActionCtxT, Path, getContext, renderRoute)
+
+-- | Look up a tagged path in a view. If we have a route looking like
+--
+-- @
+--   'TsWeb.Routing.runroute' ro rw $ 'TsWeb.Routing.path' #user ("users" \<//\> var) ('TsWeb.Routing.get' user)
+-- @
+--
+-- then a view could access that user path with
+--
+-- @
+--   users <- getPath #user
+--   let txt = 'Web.Spock.renderRoute' users "bob"
+-- @
+getPath :: (Has l lts v) => FldProxy l -> TsActionCtxT lts xs sess v
+getPath tag = SuperRecord.get tag . ctxPaths <$> getContext
+
+-- | Look up a path and render it. This returns a sort-of variadic function
+-- that can be provided with the right number of arguments in order to render
+-- a path. As with the above example, a route like this:
+--
+-- @
+--   'TsWeb.Routing.runroute' ro rw $ 'TsWeb.Routing.path' #user ("users" \<//\> var) ('TsWeb.Routing.get' user)
+-- @
+--
+-- could be rendered like this:
+--
+-- @
+--   usersfn <- showPath #user
+--   let txt = usersfn "bob"
+-- @
+--
+-- or, more succinctly:
+--
+-- @
+--   txt <- ($ "bob") \<$\> showPath $user
+-- @
+showPath ::
+     (AllHave ToHttpApiData as, Has l lts v, v ~ Path as 'Open)
+  => FldProxy l
+  -> TsActionCtxT lts vec sess (Data.HVect.HVectElim as Text)
+showPath tag = do
+  path <- getPath tag
+  pure $ renderRoute path
+
+-- | Look up data that was put into the 'ctxExtras' part of the action's
+-- context. This is pretty bound up with type signatures and other verbosity,
+-- but if we have a database-writing view like so:
+--
+-- @
+--   'TsWeb.Routing.runroute' ro rw $ 'TsWeb.Routing.path' #root 'Web.Spock.root' ('TsWeb.Routing.dbwrite' $ 'TsWeb.Routing.get' index)
+-- @
+--
+-- then that index view could be written like so:
+--
+-- @
+--   index :: 'Data.HVect.ListContains' n 'TsWeb.Types.Db.ReadWritePool' xs => 'TsActionCtxT' lts xs sess a
+--   index = do
+--     db :: ReadWritePool <- getExtra
+--     ...
+-- @
+getExtra :: (MonadIO m, ListContains n v xs) => ActionCtxT (Context lts xs) m v
+getExtra = findFirst . ctxExtras <$> getContext
diff --git a/src/TsWeb/Db.hs b/src/TsWeb/Db.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Db.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-}
+{-|
+Description: Beam actions for Spock
+
+This builds on "TsWeb.Types.Db"'s read-only/read-write discrimination by
+providing query functions to perform read-only operations, and an 'execute'
+function to run updates, inserts, and deletes (and also selects as
+appropriate). All of these are performed as 'TsWeb.Types.TsActionCtxT' actions
+so as to nicely integrate with Spock. Finally, because I'm not a fan of
+exceptions, all of these functions trap Postgres errors and convert them into
+sum-type results.
+
+I'm not yet providing shortcuts for the beam-postgres specific functions. I'm
+not actually sure that I need to (IIRC they all build Pg actions), but I will
+be adding them if necessary.
+-}
+
+module TsWeb.Db
+  ( module Database.Beam
+  , TxOpt(..)
+  , QueryResult(..)
+  , ExecResult(..)
+  , runSelectReturningList
+  , runSelectReturningOne
+  , query
+  , queryMaybe
+  , queryList
+  , execute
+  ) where
+
+import qualified TsWeb.Types.Db as Db
+
+import TsWeb.Action (getExtra)
+import TsWeb.Types (TsActionCtxT)
+import TsWeb.Types.Db (ReadOnlyPool, ReadWritePool)
+
+import qualified Database.Beam as Beam
+
+import Control.Exception (catch, try)
+import Data.HVect (ListContains)
+import Database.Beam hiding (runSelectReturningList, runSelectReturningOne)
+import Database.Beam.Postgres (Pg, Postgres)
+import Database.PostgreSQL.Simple (SqlError(..))
+import Database.PostgreSQL.Simple.Errors
+  ( ConstraintViolation(..)
+  , constraintViolationE
+  )
+
+#if MIN_VERSION_beam_core(0, 8, 0)
+type Sel a = SqlSelect Postgres a
+#else
+import Database.Beam.Postgres (PgSelectSyntax)
+type Sel a = SqlSelect PgSelectSyntax a
+#endif
+
+class ReadOnlyM m where
+  runSelectReturningOne ::
+       FromBackendRow Postgres a => Sel a -> m (Maybe a)
+  runSelectReturningList ::
+       FromBackendRow Postgres a => Sel a -> m [a]
+
+instance ReadOnlyM Pg where
+  runSelectReturningOne = Beam.runSelectReturningOne
+  runSelectReturningList = Beam.runSelectReturningList
+
+newtype RoPg a = RoPg
+  { _fromRoPg :: Pg a
+  } deriving (Functor, Applicative, Monad)
+
+instance ReadOnlyM RoPg where
+  runSelectReturningOne = RoPg . Beam.runSelectReturningOne
+  runSelectReturningList = RoPg . Beam.runSelectReturningList
+
+-- | Transaction option: provide WithTx to wrap operations in BEGIN/COMMIT, or
+-- NoTx to skip that.
+data TxOpt
+  = NoTx
+  | WithTx
+  deriving (Eq, Ord, Enum, Bounded, Show)
+
+-- | Result of a select operation. This will either succeed with a QSimply, or
+-- fail with a QError (probably then an error in the db connection or table
+-- definitions).
+data QueryResult a
+  = QSimply a
+  | QError SqlError
+  deriving (Eq, Show)
+
+-- | Run one or many Beam 'Database.Beam.runSelectReturningList' or
+-- 'Database.Beam.runSelectReturningOne' operation(s) against a view's
+-- ReadOnlyPool.
+query ::
+     ListContains n ReadOnlyPool xs
+  => TxOpt
+  -> RoPg a
+  -> TsActionCtxT lts xs sessdata (QueryResult a)
+query opt (RoPg act) = do
+  ropool :: ReadOnlyPool <- getExtra
+  liftIO $ catch (QSimply <$> Db.withConnection ropool io) (pure . QError)
+  where
+    io conn =
+      case opt of
+        NoTx -> Db.readOnly conn act
+        WithTx -> Db.withTransaction conn $ Db.readOnly conn act
+
+-- | Run a single Beam 'select', returning a single (Maybe) value
+queryMaybe ::
+     (ListContains n ReadOnlyPool xs, FromBackendRow Postgres a)
+  => Sel a
+  -> TsActionCtxT lts xs sessdata (QueryResult (Maybe a))
+queryMaybe = query NoTx . runSelectReturningOne
+
+-- | Run a single Beam 'select', returning a list of values
+queryList ::
+     (ListContains n ReadOnlyPool xs, FromBackendRow Postgres a)
+  => Sel a
+  -> TsActionCtxT lts xs sessdata (QueryResult [a])
+queryList = query NoTx . runSelectReturningList
+
+-- | The result of a select, insert, update, or delete operation. This adds a
+-- constraint error to the 'QueryResult', making it nicer to filter out
+-- conflicts when handling errors.
+data ExecResult a
+  = ESimply a
+  | EConstraint SqlError
+                ConstraintViolation
+  | EError SqlError
+  deriving (Eq, Show)
+
+-- | Run any arbitrary 'Database.Beam.Pg' monad in the context of a view,
+-- returning an 'ExecResult'
+execute ::
+     ListContains n ReadWritePool xs
+  => TxOpt
+  -> Pg a
+  -> TsActionCtxT lts xs sessdata (ExecResult a)
+execute opt act = do
+  rwpool <- getExtra
+  liftIO $ handleError rwpool
+  where
+    handleError rwpool =
+      try (Db.withConnection rwpool io) >>= \case
+        Right a -> return $ ESimply a
+        Left err ->
+          case constraintViolationE err of
+            Nothing -> return $ EError err
+            Just (s, c) -> return $ EConstraint s c
+    io conn =
+      case opt of
+        NoTx -> Db.readWrite conn act
+        WithTx -> Db.withTransaction conn $ Db.readWrite conn act
diff --git a/src/TsWeb/Routing.hs b/src/TsWeb/Routing.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Routing.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+
+{-|
+Description: Tagged routes for Spock
+
+This module builds on Spock's "reroute" library by associating a
+"GHC.OverloadedLabels" label to each route, which views can then use to
+reverse routes in a type-safe manner. It also uses some rediculous function
+chaining to almost create an indexed monad, but not quite because I can't
+figure out quite how to make that work. A fairly function example follows:
+
+First, we'll define a couple of views:
+
+@
+  index :: Has "users" lts (Path '[] 'Open) => TsActionCtxT lts xs sess a
+  index = 'TsWeb.Actions.showPath' #users >>= 'Spock.text
+
+  users :: Has "root" lts (Path '[] 'Open) => TsActionCtxT lts xs sess a
+  users = do
+    root <- 'TsWeb.Actions.showPath' #root
+    text $ "GET users, root is, " \<\> root
+
+  usersPost :: TsActionCtxT lts xs sess a
+  usersPost = text "POST to users!"
+@
+
+Then, routing to those views looks like this:
+
+@
+  'runroute' ropool rwpool $
+    'path' #root 'Web.Spock.root' ('getpost' index) .
+    'path' #users "users" (do get users
+                              post usersPost)
+@
+
+Notice the (.) after the @getpost index@. We're chaining functions together
+and then passing that chained function to 'runroute' in order to generate an
+actual Spock 'Web.Spock.Routing.RouteM'.
+-}
+module TsWeb.Routing
+  ( RoutingM
+  , runroute
+  , path
+  , dbwrite
+  , getpost
+  , get
+  , post
+  ) where
+
+import TsWeb.Types (Context(..), TsActionCtxT, TsSpockCtxT)
+import TsWeb.Types.Db (ReadOnlyPool, ReadWritePool)
+
+import qualified SuperRecord as SR
+import qualified Web.Spock as Spock
+import qualified Web.Spock.Routing
+
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Reader (ReaderT(..), ask, mapReaderT)
+import Data.HVect (HVect(..), HVectElim, HasRep)
+import GHC.TypeLits (type (-), KnownNat, KnownSymbol)
+import SuperRecord ((:=)(..), FldProxy, Rec, Record, Sort, (&), rnil)
+import Web.Routing.Combinators (PathState(Open))
+import Web.Spock (Path)
+import Web.Spock.Routing (withPrehook)
+
+-- | Reader monad to pass one 'Web.Spock.Path' to potentially multiple
+-- different 'get'/'post'/etc calls.
+type RoutingM as lts xs sess
+   = ReaderT (Path as 'Open, ReadWritePool) (TsSpockCtxT lts xs sess)
+
+-- | Convert a chain of 'path' calls into a 'Web.Spock.Routing.RouteM'
+-- instance. This takes a 'TsWeb.Types.Db.ReadOnlyPool' and a
+-- 'TsWeb.Types.Db.ReadWritePool' in order to operate the
+-- 'TsWeb.Routing.Auth.auth' and 'dbwrite' calls.
+runroute ::
+     (Applicative f, MonadIO m, Web.Spock.Routing.RouteM t)
+  => ReadOnlyPool  -- ^Read-only postgres connection pool
+  -> ReadWritePool -- ^Read-write postgres connection pool
+  -> ((ReadWritePool, Rec '[], f ()) -> ( ReadWritePool
+                                        , Rec lts
+                                        , t (Context lts '[ ReadOnlyPool]) m ()))
+  -- ^Chain of functions built up using 'path' calls
+  -> t ctx m ()
+runroute ropool rwpool fn =
+  let (_p, r, m) = fn (rwpool, rnil, pure ())
+   in Spock.prehook (pure $ Context r (ropool :&: HNil)) m
+
+-- | Describe a path for routing. This both builds up the
+-- 'Web.Spock.Routing.RouteM' monad and associates the given label with the
+-- URL so that views can look up the URL using 'TsWeb.Action.showPath' &c.
+path ::
+     ( KnownNat ((SR.RecSize (Sort (l := (Path as 'Open) : lts)) - SR.RecTyIdxH 0 l (Sort (l := (Path as 'Open) : lts))) - 1)
+     , SR.RecCopy lts lts (Sort (l := (Path as 'Open) : lts))
+     , KnownNat (SR.RecSize lts)
+     , SR.KeyDoesNotExist l lts
+     , KnownSymbol l
+     )
+  => FldProxy l                 -- ^Label for this URL path
+  -> (Path as 'Open)            -- ^'Web.Spock.Path' for views
+  -> RoutingM as lts0 xs sess a
+  -- ^Routing monad built from 'get' \/ 'post' \/ &c
+  -> (ReadWritePool, Rec lts, (TsSpockCtxT lts0 xs sess) a)
+  -- ^Result of previous 'path' call, or initial data from 'runroute'
+  -> ( ReadWritePool
+     , Record (l := (Path as 'Open) : lts)
+     , (TsSpockCtxT lts0 xs sess) a)
+path l t m (pool, r, m0) = (pool, l := t & r, m0 >> runReaderT m (t, pool))
+
+-- | Raise up a 'RoutingM' to have 'TsWeb.Types.Db.ReadWritePool' in its
+-- extras record.
+dbwrite ::
+     RoutingM as lts (ReadWritePool ': xs) sess () -> RoutingM as lts xs sess ()
+dbwrite action = do
+  (_path, pool) <- ask
+  xform pool action
+  where
+    xform ::
+         nn -> RoutingM as lts (nn ': xs) sess () -> RoutingM as lts xs sess ()
+    xform nn = mapReaderT (xform' nn)
+    xform' ::
+         nn -> TsSpockCtxT lts (nn ': xs) sess () -> TsSpockCtxT lts xs sess ()
+    xform' nn = withPrehook (xform'' nn)
+    xform'' :: nn -> TsActionCtxT lts xs sess (Context lts (nn ': xs))
+    xform'' nn = do
+      ctx <- Spock.getContext
+      pure $ ctx {ctxExtras = nn :&: ctxExtras ctx}
+
+-- | Run this view whether the client did a GET or a POST request
+getpost ::
+     Data.HVect.HasRep as
+  => Data.HVect.HVectElim as (TsActionCtxT lts xs sess ())
+  -> RoutingM as lts xs sess ()
+getpost action = do
+  (p, _) <- ask
+  lift $ Spock.getpost p action
+
+-- | Run this view only on GET requests
+get ::
+     Data.HVect.HasRep as
+  => Data.HVect.HVectElim as (TsActionCtxT lts xs sess ())
+  -> RoutingM as lts xs sess ()
+get action = do
+  (p, _) <- ask
+  lift $ Spock.get p action
+
+-- | Run this view only on POST requests
+post ::
+     Data.HVect.HasRep as
+  => Data.HVect.HVectElim as (TsActionCtxT lts xs sess ())
+  -> RoutingM as lts xs sess ()
+post action = do
+  (p, _) <- ask
+  lift $ Spock.post p action
diff --git a/src/TsWeb/Routing/Auth.hs b/src/TsWeb/Routing/Auth.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Routing/Auth.hs
@@ -0,0 +1,100 @@
+{-|
+Description: Auth hook for routing
+
+A generic authentication hook for TsWeb routing. The goal here is to be able
+to specify authentication requirements in a view's type, so that the routing
+statically guarantees that a view can only be entered when session
+preconditions are met. A full example of this is under the Example module of
+this source tree, but a synopsis follows. Given a session/user definition like
+so:
+
+@
+  data UserT f = User
+    { _userId :: C f Int
+    , _userLogin :: C f Text
+    } deriving (Generic)
+  ...
+  data SessionDataT f = SessionData
+    { _sdUser :: PrimaryKey UserT (Nullable f)
+    , _sdRemember :: C f Bool
+    } deriving (Generic)
+  ...
+
+  userP :: 'Data.Proxy.Proxy' User
+  userP = Proxy
+@
+
+then we can define a logged-in 'Authorize' check as
+
+@
+instance Authorize SessionData User where
+  checkAuth _ =
+    _sdUser \<$\> 'Web.Spock.readSession' >>= \case
+      UserId Nothing -> pure Nothing
+      UserId (Just uid) ->
+        'TsWeb.Db.queryMaybe' ('Database.Beam.select' $ q uid) >>= \case
+          QSimply (Just user) -> pure $ Just user
+          _ -> pure Nothing
+    where
+      q uid = do
+        u <- 'Database.Beam.all_' $ _dbUser db
+        'Database.Beam.guard_' $ _userId u ==. 'Database.Beam.val_' uid
+        pure u
+@
+
+A view requiring an authenticated user would have a signature like
+
+@
+  authd :: ListContains n User xs => TsActionCtxT lts xs SessionData a
+  authd = do
+    user :: User <- 'TsWeb.Action.getExtra'
+    ...
+@
+
+Finally, the route for only allowing logged-in users would look like
+
+@
+  'TsWeb.Routing.runroute' ro rw $ 'TsWeb.Routing.path' #authd "authd" $ `TsWeb.Routing.get' $ 'auth' userP authd
+@
+
+That view is statically defined to only be accessible to logged-in users; any
+anonymous session will either go to an alternate (non-auth) view, or get a
+404.
+-}
+module TsWeb.Routing.Auth where
+
+import TsWeb.Types (Context(..), TsActionCtxT)
+import TsWeb.Types.Db (ReadOnlyPool)
+
+import Data.HVect (HVect((:&:)), ListContains)
+import Data.Proxy (Proxy)
+import Web.Spock (getContext)
+import Web.Spock.Action (jumpNext, runInContext)
+
+-- | A class for session data that needs to be statically verified against
+-- routes. This could be checks for optional session info, or to validate the
+-- value of that session information.
+class Authorize sess perm where
+  -- | Load a value out of the session or return Nothing. Used in the context
+  -- of 'auth', the wrapped view will only be called when this returns Just; a
+  -- Nothing value will cause the wrapped view to be skipped.
+  checkAuth ::
+       ListContains n ReadOnlyPool xs
+    => Proxy perm
+    -> TsActionCtxT lts xs sess (Maybe perm)
+
+-- | Guarantee that the Spock session hold some verified piece of data. If the
+-- requisite data can be loaded, then the view is called with the data in its
+-- ctxExtras; otherwise 'Web.Spock.Action.jumpNext' is called and the view is
+-- skipped.
+auth ::
+     (Authorize sess perm, ListContains n ReadOnlyPool xs, Authorize sess perm)
+  => Proxy perm
+  -> TsActionCtxT lts (perm ': xs) sess ()
+  -> TsActionCtxT lts xs sess ()
+auth proxy action =
+  checkAuth proxy >>= \case
+    Nothing -> jumpNext
+    Just a -> do
+      ctx <- getContext
+      runInContext (ctx {ctxExtras = a :&: ctxExtras ctx}) action
diff --git a/src/TsWeb/Session.hs b/src/TsWeb/Session.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Session.hs
@@ -0,0 +1,309 @@
+{-|
+Description: Spock Session implementation for Beam
+
+This provides one essential function, 'patchConfig' to replace Spock's default
+in-RAM session implementation with a Beam/postgres one.
+-}
+module TsWeb.Session
+  ( patchConfig
+  , UserData(..)
+  ) where
+
+import qualified TsWeb.Tables.Session as T
+import qualified TsWeb.Types.Db as Db
+
+import TsWeb.Tables.Session (SessionT(..))
+import TsWeb.Types.Db (ReadOnlyConn, ReadWriteConn, SomeConn)
+
+import qualified Database.Beam as Beam
+
+import Control.Monad (unless)
+import Data.Maybe (fromJust)
+import Data.Pool (Pool)
+import Data.Time.Format (buildTime, defaultTimeLocale)
+import Database.Beam ((==.), all_, guard_, val_)
+import Database.Beam.Backend.SQL.SQL92 (HasSqlValueSyntax)
+import Database.Beam.Postgres (Postgres)
+import Database.Beam.Postgres.Syntax (PgValueSyntax)
+import Database.Beam.Schema.Tables (FieldsFulfillConstraint)
+import Web.Spock.Config
+  ( SessionStore(..)
+  , SessionStoreInstance(..)
+  , SpockCfg(..)
+  , sc_store
+  )
+import Web.Spock.Internal.SessionManager as SM (Session(..), SessionId)
+
+data TxAction s next
+  = LoadSession SM.SessionId
+                (Maybe s -> next)
+  | DeleteSession SM.SessionId
+                  next
+  | StoreSession s
+                 next
+  | ToList ([s] -> next)
+  | FilterSessions (s -> Bool)
+                   next
+
+type TxProgram s = Free (TxAction s)
+
+-- | Update a spock configuration stanza to replace its default session with
+-- one backed by postgres.  This will typically be used like so:
+--
+-- @
+--  spockCfg <-
+--    'patchConfig' (_dbSession db) ropool rwpool <$>
+--    'Web.Spock.Config.defaultSpockCfg' sess PCNoDatabase ()
+--  'Web.Spock.runSpock' port ('Web.Spock.spock' spockCfg routes)
+--  where
+--    sess = ...
+--    routes = ...
+-- @
+--
+patchConfig ::
+     ( Beam.FromBackendRow Postgres (sessdata Beam.Identity)
+     , Beam.Beamable sessdata
+     , Beam.Typeable sessdata
+     , Beam.Database Postgres db
+     , UserData (sessdata Beam.Identity)
+     , FieldsFulfillConstraint (HasSqlValueSyntax PgValueSyntax) sessdata
+     )
+  => Beam.DatabaseEntity Postgres db (Beam.TableEntity (SessionT sessdata))
+  -> Pool ReadOnlyConn
+  -> Pool ReadWriteConn
+  -> SpockCfg conn (sessdata Beam.Identity) st
+  -> SpockCfg conn (sessdata Beam.Identity) st
+patchConfig session ropool rwpool conf = conf {spc_sessionCfg = updSession}
+  where
+    updSession = sessCfg {sc_store = customStore}
+    sessCfg = spc_sessionCfg conf
+    customStore = SessionStoreInstance $ newPgSessionStore session ropool rwpool
+
+-- | Typeclass for user-supplied data. We really just need to know whether the
+-- user has set a remember-me indicator upon login so that the session's
+-- lifespan can be intelligently controlled. If your session never needs to be
+-- remembers, then @rememberMe = const False@ should suffice.
+class UserData c where
+  -- | Should the associated session be stored permanently?
+  rememberMe :: c -> Bool
+
+newPgSessionStore ::
+     ( Beam.FromBackendRow Postgres (sessdata Beam.Identity)
+     , Beam.Beamable sessdata
+     , Beam.Typeable sessdata
+     , Beam.Database Postgres db
+     , UserData (sessdata Beam.Identity)
+     , FieldsFulfillConstraint (HasSqlValueSyntax PgValueSyntax) sessdata
+     )
+  => Beam.DatabaseEntity Postgres db (Beam.TableEntity (SessionT sessdata))
+  -> Pool ReadOnlyConn
+  -> Pool ReadWriteConn
+  -> SessionStore (SM.Session conn (sessdata Beam.Identity) st) (TxProgram (SM.Session conn (sessdata Beam.Identity) st))
+newPgSessionStore session ropool rwpool =
+  SessionStore
+    { ss_runTx = runTxProgram session ropool rwpool
+    , ss_loadSession = liftF . flip LoadSession id
+    , ss_deleteSession = liftF . flip DeleteSession ()
+    , ss_storeSession = liftF . flip StoreSession ()
+    , ss_toList = liftF $ ToList id
+    , ss_filterSessions =
+        \fn -> do
+          ss <- liftF $ ToList id
+          mapM_ (\s -> unless (fn s) (liftF $ DeleteSession (sess_id s) ())) ss
+    , ss_mapSessions =
+        \fn -> do
+          ss <- liftF $ ToList id
+          mapM_
+            (\s -> do
+               s' <- fn s
+               liftF $ StoreSession s' ())
+            ss
+    }
+
+loadSession' ::
+     ( Beam.FromBackendRow Postgres (sessdata Beam.Identity)
+     , Beam.Beamable sessdata
+     , Beam.Typeable sessdata
+     , Beam.Database Postgres db
+     )
+  => Beam.DatabaseEntity Postgres db (Beam.TableEntity (SessionT sessdata))
+  -> SomeConn c
+  -> SM.SessionId
+  -> IO (Maybe (SM.Session conn (sessdata Beam.Identity) st))
+loadSession' session conn sessionid = do
+  match <-
+    Db.readOnly conn $
+    Beam.runSelectReturningOne $
+    Beam.select $ do
+      sess <- all_ session
+      guard_ (_sessionId sess ==. val_ sessionid)
+      pure sess
+  case match of
+    Nothing -> return Nothing
+    Just result ->
+      return $
+      Just
+        (SM.Session
+           (_sessionId result)
+           (_sessionCsrf result)
+           (_sessionExpires result)
+           (_sessionData result))
+
+deleteSession' ::
+     Beam.DatabaseEntity Postgres db (Beam.TableEntity (SessionT sessdata))
+  -> ReadWriteConn
+  -> SM.SessionId
+  -> IO ()
+deleteSession' session conn sessionid =
+  Db.readWrite conn $
+  Beam.runDelete $
+  Beam.delete session (\sess -> _sessionId sess ==. val_ sessionid)
+
+storeSession' ::
+     ( Beam.FromBackendRow Postgres (sessdata Beam.Identity)
+     , Beam.Beamable sessdata
+     , Beam.Typeable sessdata
+     , Beam.Database Postgres db
+     , UserData (sessdata Beam.Identity)
+     , FieldsFulfillConstraint (HasSqlValueSyntax PgValueSyntax) sessdata
+     )
+  => Beam.DatabaseEntity Postgres db (Beam.TableEntity (SessionT sessdata))
+  -> ReadWriteConn
+  -> SM.Session conn (sessdata Beam.Identity) st
+  -> IO ()
+storeSession' session conn sess = Db.readWrite conn go
+  where
+    go =
+      getSess >>= \case
+        Nothing ->
+          Beam.runInsert $
+          Beam.insert session $
+          Beam.insertExpressions
+            [ T.Session
+                (val_ $ sess_id sess)
+                (val_ $ sess_csrfToken sess)
+                (val_ $
+                 if rememberMe (sess_data sess)
+                   then farOut
+                   else sess_validUntil sess)
+                (val_ $ sess_data sess)
+            ]
+        Just exist ->
+          Beam.runUpdate $
+          Beam.save
+            session
+            (exist
+               { _sessionCsrf = sess_csrfToken sess
+               , _sessionExpires =
+                   if rememberMe (sess_data sess)
+                     then farOut
+                     else sess_validUntil sess
+               , _sessionData = sess_data sess
+               })
+    getSess =
+      Beam.runSelectReturningOne $
+      Beam.lookup_ session (T.SessionId $ sess_id sess)
+    farOut = fromJust $ buildTime defaultTimeLocale [('Y', "2999")]
+
+toList' ::
+     ( Beam.FromBackendRow Postgres (sessdata Beam.Identity)
+     , Beam.Beamable sessdata
+     , Beam.Typeable sessdata
+     , Beam.Database Postgres db
+     )
+  => Beam.DatabaseEntity Postgres db (Beam.TableEntity (SessionT sessdata))
+  -> SomeConn a
+  -> IO [SM.Session conn (sessdata Beam.Identity) st]
+toList' session conn = do
+  sessions <- go
+  return $
+    [ SM.Session
+      (_sessionId s)
+      (_sessionCsrf s)
+      (_sessionExpires s)
+      (_sessionData s)
+    | s <- sessions
+    ]
+  where
+    go =
+      Db.readOnly conn $
+      Beam.runSelectReturningList $ Beam.select $ all_ session
+
+instance Functor (TxAction s) where
+  fmap f (LoadSession sessid g) = LoadSession sessid (f . g)
+  fmap f (DeleteSession sessid x) = DeleteSession sessid (f x)
+  fmap f (StoreSession sess x) = StoreSession sess (f x)
+  fmap f (ToList g) = ToList (f . g)
+  fmap f (FilterSessions g x) = FilterSessions g (f x)
+
+data Free f r
+  = Free (f (Free f r))
+  | Pure r
+
+instance Functor f => Functor (Free f) where
+  fmap f = go
+    where
+      go (Pure a) = Pure (f a)
+      go (Free fa) = Free (go <$> fa)
+
+instance (Functor f) => Applicative (Free f) where
+  pure = Pure
+  Pure a <*> Pure b = Pure $ a b
+  Pure a <*> Free mb = Free $ fmap a <$> mb
+  Free ma <*> b = Free $ (<*> b) <$> ma
+
+instance (Functor f) => Monad (Free f) where
+  return = Pure
+  (Free x) >>= f = Free (fmap (>>= f) x)
+  (Pure r) >>= f = f r
+
+instance Show sessdata => Show (TxProgram (SM.Session conn sessdata st) a) where
+  show = show'
+    where
+      show' (Free (LoadSession sid g)) =
+        "Load " ++ (show sid) ++ " / " ++ show' (g Nothing)
+      show' (Free (DeleteSession sid g)) =
+        "Delete " ++ (show sid) ++ " / " ++ show' g
+      show' (Free (StoreSession sid g)) =
+        "Store " ++ (show $ sess_id sid) ++ " / " ++ show' g
+      show' (Free (ToList g)) = "ToList / " ++ show' (g [])
+      show' (Free (FilterSessions _ g)) = "Filter / " ++ show' g
+      show' (Pure _) = "Pure"
+
+runTxProgram ::
+     ( Beam.FromBackendRow Postgres (sessdata Beam.Identity)
+     , Beam.Beamable sessdata
+     , Beam.Typeable sessdata
+     , Beam.Database Postgres db
+     , UserData (sessdata Beam.Identity)
+     , FieldsFulfillConstraint (HasSqlValueSyntax PgValueSyntax) sessdata
+     )
+  => Beam.DatabaseEntity Postgres db (Beam.TableEntity (SessionT sessdata))
+  -> Db.ReadOnlyPool
+  -> Db.ReadWritePool
+  -> TxProgram (SM.Session conn (sessdata Beam.Identity) st) a
+  -> IO a
+runTxProgram session ropool rwpool tx =
+  (Db.withConnection ropool $ \conn -> ro conn tx) >>= \case
+    Just res -> return res {- putStrLn "Ran read-only query" >> -}
+    Nothing {- do
+      putStrLn "Running read-write query" -}
+     -> Db.withConnection rwpool $ flip rw tx
+  where
+    ro conn (Free (LoadSession sessid g)) =
+      loadSession' session conn sessid >>= ro conn . g
+    ro conn (Free (ToList g)) = toList' session conn >>= ro conn . g
+    ro _conn (Pure p) = pure $ Just p
+    ro _conn _free = pure Nothing
+    rw conn (Free (LoadSession sessid g)) =
+      loadSession' session conn sessid >>= rw conn . g
+    rw conn (Free (DeleteSession sessid g)) =
+      deleteSession' session conn sessid >> rw conn g
+    rw conn (Free (StoreSession sess g)) =
+      storeSession' session conn sess >> rw conn g
+    rw conn (Free (ToList g)) = toList' session conn >>= rw conn . g
+    rw conn (Free (FilterSessions _b n)) = rw conn n
+    rw _conn (Pure p) = pure p
+
+liftF :: Functor f => f r -> Free f r
+liftF x = Free (fmap Pure x)
diff --git a/src/TsWeb/Tables/Session.hs b/src/TsWeb/Tables/Session.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Tables/Session.hs
@@ -0,0 +1,45 @@
+{-|
+Description: Beam table definition for a generic Spock session
+
+Spock likes to store its session RAM, which is mostly great unless you need
+persistence or multiple machines. This doesn't do anything interesting with
+Spock's session manager, but just defines enough of a table to be able to
+store Spock's core session information.
+-}
+module TsWeb.Tables.Session where
+
+import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
+import Database.Beam
+
+-- | A generic Beam table to store a Spock session. The '_sessionData' should
+-- be your useful info, like a logged-in user or whatever. See
+-- "TsWeb.Tables.Session.Test" for a type-checking but not very function idea
+-- of what '_sessionData' could look like, or the code under
+-- 'Example.Main.main' for a fully-functional (but dumb) webapp using all this
+-- stuff.
+data SessionT d f = Session
+  { _sessionId :: C f Text          -- ^Spock-generated session ID
+  , _sessionCsrf :: C f Text        -- ^Session's CSRF token
+  , _sessionExpires :: C f UTCTime  -- ^Expiration date for this session
+  , _sessionData :: d f             -- ^User-defined session data
+  } deriving (Generic)
+
+-- |Concrete session
+type Session d = SessionT d Identity
+
+-- |Session primary key
+type SessionId d = PrimaryKey (SessionT d) Identity
+
+deriving instance Show (PrimaryKey (SessionT d) Identity)
+deriving instance Show (d Identity) => Show (Session d)
+deriving instance Eq (PrimaryKey (SessionT d) Identity)
+deriving instance Eq (d Identity) => Eq (Session d)
+deriving instance Ord (PrimaryKey (SessionT d) Identity)
+deriving instance Ord (d Identity) => Ord (Session d)
+instance Beamable (PrimaryKey (SessionT d))
+instance Beamable d => Beamable (SessionT d)
+instance (Beamable d, Typeable d) => Table (SessionT d) where
+  data PrimaryKey (SessionT d) f = SessionId (Columnar f Text)
+                                   deriving Generic
+  primaryKey = SessionId . _sessionId
diff --git a/src/TsWeb/Tables/Session/Test.hs b/src/TsWeb/Tables/Session/Test.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Tables/Session/Test.hs
@@ -0,0 +1,50 @@
+{-|
+Description: Test module to be sure the generic 'Session' is sane
+-}
+module TsWeb.Tables.Session.Test where
+
+import TsWeb.Session
+import TsWeb.Tables.Session
+
+import Data.Pool (Pool)
+import Database.Beam
+import TsWeb.Types.Db (ReadOnlyConn, ReadWriteConn)
+import Web.Spock.Config
+import Web.Spock.Internal.SessionManager as SM (Session(..))
+
+-- | Some sample user info
+data UsersMixin f = Address
+  { loginid :: C f Int
+  , masqid :: C f Int
+  , remember :: C f Bool
+  } deriving (Generic)
+
+-- | Concrete type for users
+type Users = UsersMixin Identity
+
+instance Beamable UsersMixin
+instance UserData Users where
+  rememberMe = remember
+
+-- | Spock session alias to use our User
+type Sess conn st = SM.Session conn Users st
+
+-- | Beam database definition to hold our session
+data Db f = Db
+  { session :: f (TableEntity (SessionT UsersMixin))
+  } deriving (Generic)
+
+instance Database be Db
+
+-- | Beam database instance
+db :: DatabaseSettings be Db
+db = defaultDbSettings
+
+-- | Sample of patch to be sure that all the types work enough to make a spock
+-- config wrapper
+patch ::
+     Pool ReadOnlyConn
+  -> Pool ReadWriteConn
+  -> SpockCfg conn Users st
+  -> SpockCfg conn Users st
+patch = patchConfig (session db)
diff --git a/src/TsWeb/Types.hs b/src/TsWeb/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Types.hs
@@ -0,0 +1,39 @@
+{-|
+Description: Web types for TsWeb
+
+These are the base wrappers around Spock's contexts and state monad. The main
+thing that TsWeb does is force in a 'Context' type that is a wrapper around a
+'SuperRecord.Rec' and a 'Data.HVect.HVect'. The Rec is used to store tagged
+URL paths, while the HVect stores contextual data for views, such as a
+database connection or authentication information.
+-}
+module TsWeb.Types where
+
+import Data.HVect (HVect)
+import SuperRecord (Rec)
+import Web.Spock (ActionCtxT, WebStateM)
+import Web.Spock.Core (SpockCtxT)
+
+-- | A container for a 'SuperRecord.Rec' of tagged Spock paths and a
+-- `Data.HVect.HVect' of view contextual data.
+--
+-- The paths are built with 'TsWeb.Routing.path' and friends, and are queried
+-- using `TsWeb.Action.getPath' / 'TsWeb.Action.showPath'.
+--
+-- Context extras are currently populated using 'TsWeb.Routing.dbwrite' and
+-- 'TsWeb.Routing.Auth.auth'; probably more will be added as needed.
+data Context lts vec = Context
+  { ctxPaths :: Rec lts    -- ^Tagged paths for web context
+  , ctxExtras :: HVect vec -- ^Free-form extras for web context
+  }
+
+-- | Wrapper around 'WebStateM' to suppress spock's database and web_state
+type TsWebStateM sessdata = WebStateM () sessdata ()
+
+-- | Wrapper around 'ActionCtxT' to use 'Context' and 'TsWebStateM'
+type TsActionCtxT lts xs sessdata a
+   = ActionCtxT (Context lts xs) (TsWebStateM sessdata) a
+
+-- | Wrapper around 'SpockCtxT' to use 'Context' and 'TsWebStateM'
+type TsSpockCtxT lts xs sessdata
+   = SpockCtxT (Context lts xs) (TsWebStateM sessdata)
diff --git a/src/TsWeb/Types/Db.hs b/src/TsWeb/Types/Db.hs
new file mode 100644
--- /dev/null
+++ b/src/TsWeb/Types/Db.hs
@@ -0,0 +1,162 @@
+{-# LANGUAGE CPP #-}
+{-|
+Description: Database-specific types and core functions
+
+TsWeb has a strong notion that postgres should be configured in a warm-standby
+mode, with read-only queries being shipped to synchronous standbys whenever
+possible. This module defines types for descriminating between read-only and
+read-write connections, and also functions for making postgres connections,
+pools, etc. The 'connect' function is working well enough for me, but will
+undoubtedly need to be improved to support the full depth of postgresql
+connection options.
+-}
+module TsWeb.Types.Db
+  ( SomeConn
+  , ReadOnlyConn
+  , ReadWriteConn
+  , ReadOnlyPool
+  , ReadWritePool
+  , ReadOnly
+  , ReadWrite
+  , HostName
+  , DbName
+  , SubPools
+  , KeepOpen
+  , count
+  , pool
+  , withConnection
+  , connect
+  , withSavepoint
+  , withTransaction
+  , readOnly
+  , readOnlyDebug
+  , readWrite
+  , readWriteDebug
+  ) where
+
+import qualified Database.Beam.Postgres as PG
+import qualified Database.PostgreSQL.Simple as Simple
+
+import Data.Pool (Pool, createPool, withResource)
+import Data.Tagged (Tagged(..))
+import Data.Time.Clock (NominalDiffTime)
+import Database.Beam hiding (runSelectReturningList, runSelectReturningOne)
+import Database.Beam.Postgres
+  ( Connection
+  , Pg
+  , runBeamPostgres
+  , runBeamPostgresDebug
+  )
+import qualified Database.Beam.Query.Internal as BI
+
+#if MIN_VERSION_beam_core(0, 8, 0)
+import Database.Beam.Postgres (Postgres)
+#else
+import Database.Beam.Postgres.Syntax (PgExpressionSyntax, PgSelectSyntax)
+#endif
+
+-- | An example of how @Database.Beam@ does counts; this really doesn't belong
+-- here, and was just written for preliminary testing.
+#if MIN_VERSION_beam_core(0, 8, 0)
+count ::
+     (BI.ProjectibleWithPredicate BI.AnyType Postgres (BI.WithExprContext
+           (BI.BeamSqlBackendExpressionSyntax' Postgres)) t)
+  => Q Postgres db (BI.QNested s0) t
+  -> Q Postgres db s0 (QGenExpr QValueContext Postgres s0 Int)
+#else
+count ::
+     BI.ProjectibleWithPredicate BI.AnyType PgExpressionSyntax t
+  => Q PgSelectSyntax db (BI.QNested s0) t
+  -> Q PgSelectSyntax db s0 (QGenExpr QValueContext PgExpressionSyntax s0 Int)
+#endif
+count = aggregate_ (const countAll_)
+
+-- | Empty type to mark read-only db connections
+data ReadOnly
+
+-- | Empty type to mark read-write db connections
+data ReadWrite
+
+-- | Wrapper for some sort of Postgres connection; a raw `SomeConn t`
+-- represents either a read-only or a read-write connection, but the concrete
+-- `ReadOnlyConn` and `ReadWriteConn` are probably more useful in general.
+type SomeConn t = Tagged t Connection
+
+-- | Concrete read-only connection. Instantiate with 'connect'
+type ReadOnlyConn = SomeConn ReadOnly
+
+-- | Concrete read-write connection. Instantiate with 'connect'
+type ReadWriteConn = SomeConn ReadWrite
+
+-- | Pool of read-only connections. Instantiate with 'pool'
+type ReadOnlyPool = Pool ReadOnlyConn
+
+-- | Pool of read-write connections. Instantiate with 'pool'
+type ReadWritePool = Pool ReadWriteConn
+
+-- | String alias for the postgres host to connect to
+type HostName = String
+
+-- | String alias for the postgres database to connect to
+type DbName = String
+
+-- | Int alias for the 'Data.Pool.createPool' function @numStripes@ argument
+type SubPools = Int
+
+-- | Int alias for the 'Data.Pool.createPool' function @maxResources@ argument
+type KeepOpen = Int
+
+-- | Create a resource pool of either read-only or read-write postgres
+-- connections. The docs for `Data.Pool.createPool' give the best description
+-- for how this works.
+pool ::
+     HostName        -- ^Postgres hostname/address
+  -> DbName          -- ^Postgres database name
+  -> String          -- ^User to connect as
+  -> SubPools        -- ^Number of sub-pools to maintain (1 is fine)
+  -> NominalDiffTime -- ^How long to let an idle db connection linger
+  -> KeepOpen        -- ^Max number of connections per stripe
+  -> IO (Pool (SomeConn t))
+pool host db username =
+  createPool (connect host db username) (PG.close . unTagged)
+
+-- | Run an action in a 'Pool' connection
+withConnection :: Pool (SomeConn a) -> (SomeConn a -> IO b) -> IO b
+withConnection = withResource
+
+-- | Create a 'ReadOnly' or 'ReadWrite' postgres connection. This doesn't
+-- actually check whether the connection is read-only or read-write, so it's
+-- really just to help with type juggling.
+connect :: HostName -> DbName -> String -> IO (SomeConn t)
+connect host db username =
+  print db >>
+  Tagged <$>
+  (PG.connect $
+   PG.defaultConnectInfo
+     {PG.connectUser = username, PG.connectDatabase = db, PG.connectHost = host})
+
+-- | Run an action within a postgresql savepoint
+withSavepoint :: SomeConn t -> IO a -> IO a
+withSavepoint (Tagged c) = Simple.withSavepoint c
+
+-- | Run an action within a postgresql transaction
+withTransaction :: SomeConn t -> IO a -> IO a
+withTransaction (Tagged c) = Simple.withTransaction c
+
+-- | Run a read-only query; this will actually run any query at all, so
+-- higher-level logic should ensure that only read-only queries hit this
+-- function.
+readOnly :: SomeConn t -> Pg a -> IO a
+readOnly (Tagged conn) = runBeamPostgres conn
+
+-- | Same as 'readOnly', but prints any SQL that it runs.
+readOnlyDebug :: SomeConn t -> Pg a -> IO a
+readOnlyDebug (Tagged conn) = runBeamPostgresDebug putStrLn conn
+
+-- | Run a query against a ReadWriteConn
+readWrite :: ReadWriteConn -> Pg a -> IO a
+readWrite (Tagged conn) = runBeamPostgres conn
+
+-- | Same as 'readWrite', but printing all the SQL that gets executed.
+readWriteDebug :: ReadWriteConn -> Pg a -> IO a
+readWriteDebug (Tagged conn) = runBeamPostgresDebug putStrLn conn
diff --git a/tsweb.cabal b/tsweb.cabal
new file mode 100644
--- /dev/null
+++ b/tsweb.cabal
@@ -0,0 +1,113 @@
+-- Initial tsweb.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                tsweb
+version:             0.1.0.0
+synopsis:            An API binding Web.Spock to Database.Beam
+-- description:         
+license:             BSD3
+license-file:        LICENSE
+author:              Jeremy Groven
+maintainer:          jeremy.groven@gmail.com
+-- copyright:           
+category:            Web
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+                   , README.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     TsWeb.Action
+                     , TsWeb.Db
+                     , TsWeb.Routing.Auth
+                     , TsWeb.Routing
+                     , TsWeb.Session
+                     , TsWeb.Tables.Session
+                     , TsWeb.Tables.Session.Test
+                     , TsWeb.Types.Db
+                     , TsWeb.Types
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.9 && <4.13
+                     , beam-core >=0.7 && <0.9
+                     , beam-postgres >=0.3 && <0.5
+                     , bytestring
+                     , http-api-data
+                     , hvect
+                     , postgresql-simple
+                     , pretty-simple
+                     , reroute
+                     , resource-pool
+                     , Spock >= 0.13 && < 0.14
+                     , Spock-core >= 0.13 && < 0.14
+                     , stm-containers >= 0.2 && < 0.3
+                     , superrecord >= 0.5 && < 0.6
+                     , tagged
+                     , text
+                     , time
+                     , transformers
+  hs-source-dirs:      src
+  default-extensions:  ConstraintKinds
+                     , DeriveGeneric
+                     , DataKinds
+                     , FlexibleContexts
+                     , FlexibleInstances 
+                     , LambdaCase
+                     , MultiParamTypeClasses
+                     , OverloadedLabels
+                     , OverloadedStrings
+                     , ScopedTypeVariables
+                     , StandaloneDeriving
+                     , TypeApplications
+                     , TypeFamilies 
+                     , TypeOperators
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+
+executable example
+  main-is: Example/Main.hs
+  other-modules:       Example.Types
+                     , Example.Views
+                     , TsWeb.Action
+                     , TsWeb.Db
+                     , TsWeb.Routing
+                     , TsWeb.Routing.Auth
+                     , TsWeb.Session
+                     , TsWeb.Tables.Session
+                     , TsWeb.Types
+                     , TsWeb.Types.Db
+  build-depends:       base >=4.9 && <4.13
+                     , beam-core >=0.7 && <0.9
+                     , beam-postgres >=0.3 && <0.5
+                     , bytestring
+                     , http-api-data
+                     , hvect
+                     , postgresql-simple
+                     , pretty-simple
+                     , reroute
+                     , resource-pool
+                     , Spock >= 0.13 && < 0.14
+                     , Spock-core >= 0.13 && < 0.14
+                     , stm-containers >= 0.2 && < 0.3
+                     , superrecord >= 0.5 && < 0.6
+                     , tagged
+                     , text
+                     , time
+                     , transformers
+  hs-source-dirs:      src
+  default-extensions:  ConstraintKinds
+                     , DeriveGeneric
+                     , DataKinds
+                     , FlexibleContexts
+                     , FlexibleInstances 
+                     , LambdaCase
+                     , MultiParamTypeClasses
+                     , OverloadedLabels
+                     , OverloadedStrings
+                     , ScopedTypeVariables
+                     , StandaloneDeriving
+                     , TypeApplications
+                     , TypeFamilies 
+                     , TypeOperators
+  default-language:    Haskell2010
+  ghc-options:         -Wall -main-is Example.Main.main