diff --git a/.obelisk/impl/github.json b/.obelisk/impl/github.json
index a1de3fa7..13ef388b 100644
--- a/.obelisk/impl/github.json
+++ b/.obelisk/impl/github.json
@@ -1,7 +1,7 @@
 {
   "owner": "obsidiansystems",
   "repo": "obelisk",
-  "branch": "develop",
-  "rev": "86a9584c6d7648bd5324ef57d62421fed1bf1978",
-  "sha256": "1lbii87j5530ncm6brfbzkd3wg16mgxazsf3l56zzv4c8cydilmh"
+  "branch": "cg-fullroute",
+  "rev": "0d98be9c5b49bda50fdc172a6b62477d80fc20ac",
+  "sha256": "16zd733m3cbq8228412bqyhivyblwpj24xfdygd7k25ml5f0f41k"
 }
diff --git a/aeson-orphans/src/Rhyolite/Aeson/Orphans.hs b/aeson-orphans/src/Rhyolite/Aeson/Orphans.hs
index a87bcddb..d5d302d1 100644
--- a/aeson-orphans/src/Rhyolite/Aeson/Orphans.hs
+++ b/aeson-orphans/src/Rhyolite/Aeson/Orphans.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -15,9 +16,13 @@ import qualified Data.ByteString.Lazy as LBS
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Monoid hiding (First (..))
+import Data.Ord
 import Data.Semigroup
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 
+deriving newtype instance ToJSON a => ToJSON (Down a)
+deriving newtype instance FromJSON a => FromJSON (Down a)
+
 instance ToJSON ByteString where
     toJSON = toJSON . decodeUtf8 . B64.encode
 
diff --git a/backend-db/Network/PushNotification/Worker.hs b/backend-db/Network/PushNotification/Worker.hs
index 12c33afc..12f7b2dd 100644
--- a/backend-db/Network/PushNotification/Worker.hs
+++ b/backend-db/Network/PushNotification/Worker.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Network.PushNotification.Worker where
 
@@ -23,7 +24,6 @@ import Rhyolite.Backend.DB
 import Rhyolite.Backend.Schema
 import Rhyolite.Backend.Schema.TH
 import Rhyolite.Concurrent
-import Rhyolite.Request.TH
 import Rhyolite.Schema
 import GHC.Generics
 
@@ -49,11 +49,12 @@ makeDefaultKeyIdInt64 ''ApplePushMessage 'ApplePushMessageKey
 
 data AndroidPushMessage = AndroidPushMessage
   { _androidPushMessage_payload :: Json FcmPayload }
+  deriving (Generic)
 
+instance ToJSON AndroidPushMessage
+instance FromJSON AndroidPushMessage
 instance HasId AndroidPushMessage
 
-makeJson ''AndroidPushMessage
-
 mkRhyolitePersist (Just "migrateAndroidPushMessage") [groundhog|
   - entity: AndroidPushMessage
 |]
diff --git a/backend-db/Rhyolite/Backend/Schema.hs b/backend-db/Rhyolite/Backend/Schema.hs
index e7adc490..0c46f647 100644
--- a/backend-db/Rhyolite/Backend/Schema.hs
+++ b/backend-db/Rhyolite/Backend/Schema.hs
@@ -28,7 +28,6 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField, Action)
 import Database.PostgreSQL.Simple.Types (Binary (..), Identifier (..))
 
 import Rhyolite.Schema (Json (..), SchemaName(..), LargeObjectId(..), HasId (..), Id (..))
-import Rhyolite.Backend.Schema.TH (makePersistFieldNewtype)
 import Rhyolite.Backend.Schema.Class (DerivedEntity, DerivedEntityHead, DefaultKeyId, toIdData, fromIdData)
 
 instance ToField SchemaName where
@@ -125,4 +124,11 @@ toShowUniverse = toField . T.pack . show
 
 instance Exception VisibleUniverseFailure
 
-makePersistFieldNewtype ''SchemaName
+instance PersistField SchemaName where
+  persistName _ = "SchemaName"
+  toPersistValues (SchemaName x) = toPersistValues x
+  fromPersistValues pv = do
+    (x, pv') <- fromPersistValues pv
+    return (SchemaName x, pv')
+  dbType p (SchemaName x) = dbType p x
+
diff --git a/backend-db/Rhyolite/Backend/Schema/TH.hs b/backend-db/Rhyolite/Backend/Schema/TH.hs
index a898bde2..6651f576 100644
--- a/backend-db/Rhyolite/Backend/Schema/TH.hs
+++ b/backend-db/Rhyolite/Backend/Schema/TH.hs
@@ -13,7 +13,14 @@
 
 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-redundant-constraints #-}
 
-module Rhyolite.Backend.Schema.TH where
+module Rhyolite.Backend.Schema.TH
+  ( deriveNewtypePersistBackend
+  , makeDefaultKeyIdInt64
+  , makeDefaultKeyIdSimple
+  , mkRhyolitePersist
+  , makePersistFieldNewtype
+  , module Rhyolite.Backend.Schema
+  ) where
 
 import Control.Lens ((%~), _head)
 import Control.Monad
@@ -29,6 +36,7 @@ import Database.Groundhog.TH.Settings (PersistDefinitions(..))
 import Language.Haskell.TH
 
 import Rhyolite.TH (conName)
+import Rhyolite.Backend.Schema -- Not needed for this module, but without it, the generated code fails to compile in a way which is confusing, so we re-export it.
 import Rhyolite.Backend.Schema.Class
 
 deriveNewtypePersistBackend :: (TypeQ -> TypeQ) -> (TypeQ -> TypeQ) -> Name -> Name -> DecsQ
diff --git a/backend-db/Rhyolite/Backend/TaskWorker.hs b/backend-db/Rhyolite/Backend/TaskWorker.hs
index 4ed0ec18..fc4a6396 100644
--- a/backend-db/Rhyolite/Backend/TaskWorker.hs
+++ b/backend-db/Rhyolite/Backend/TaskWorker.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
 module Rhyolite.Backend.TaskWorker where
@@ -8,7 +10,7 @@ import Rhyolite.Backend.Schema.Task
 import Control.Concurrent
 import Control.Concurrent.Async
 import Control.Concurrent.Thread.Delay
-import Control.Exception.Lifted (bracket)
+import Control.Exception.Lifted (bracket, catch, throw, Exception, SomeException(..))
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Logger
@@ -16,11 +18,28 @@ import Control.Monad.Trans.Control
 import Data.Functor.Identity
 import Data.Pool
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time
 import Database.Groundhog.Core
 import Database.Groundhog.Expression
 import Database.Groundhog.Postgresql
+import qualified Database.PostgreSQL.Simple.Types as PG
 import Rhyolite.Backend.DB
+import Rhyolite.Backend.DB.PsqlSimple (PostgresRaw, executeQ)
+
+withSavepoint
+  :: (PostgresRaw m, MonadBaseControl IO m, Exception e)
+  => String -> m a -> m (Either e a)
+withSavepoint name action = do
+  let savePt = PG.Identifier $ T.pack name
+  [executeQ|SAVEPOINT ?savePt|]
+  result <- catch (Right <$> action) $ \e -> return (Left e)
+  case result of
+    Left _ -> do
+      [executeQ|ROLLBACK TO SAVEPOINT ?savePt|]
+    Right _ -> do
+      [executeQ|RELEASE SAVEPOINT ?savePt|]
+  return result
 
 --TODO: Ensure Tasks are always properly indexed
 --TODO: Use Notifications to start the worker promptly
@@ -64,20 +83,52 @@ taskWorker input pk ready f go db workerName = do
   checkedOutValue <- runDb (Identity db) $ do
     qe <- project1 (pk, input) $ isFieldNothing (f ~> Task_resultSelector) &&. isFieldNothing (f ~> Task_checkedOutBySelector) &&. ready
     forM qe $ \(taskId, a) -> do
-      update [f ~> Task_checkedOutBySelector =. Just workerName] $ pk ==. taskId
-      (,) taskId <$> go a
+      now <- getTime
+      update
+        [ f ~> Task_checkedOutBySelector =. Just workerName
+        , f ~> Task_checkedOutAtSelector =. Just now]
+        $ pk ==. taskId
+      result <- withSavepoint "Rhyolite.Backend.TaskWorker[1]" $ (,) taskId <$> go a
+      case result of
+        Right _ -> pure ()
+        Left (e :: SomeException) -> update
+          [ f ~> Task_failedSelector =. (Just . T.pack $ "Step 1:" <> show e)
+          ]
+          $ pk ==. taskId
+      return result
+
   case checkedOutValue of
     Nothing -> pure False
-    Just (taskId, action) -> do
-      followup <- action
-      Rhyolite.Backend.DB.runDb (Identity db) $ do
-        b <- followup
-        update
-          [ f ~> Task_resultSelector =. Just b
-          , f ~> Task_checkedOutBySelector =. (Nothing :: Maybe Text)
-          ]
-          (pk ==. taskId)
-      pure True
+    Just (Left bad) -> throw bad
+    Just (Right (taskId, action)) -> do
+      followupOrError <- catch (Right <$> action) $ return . Left
+      finallError <- case followupOrError of
+        Left (e :: SomeException) -> Rhyolite.Backend.DB.runDb (Identity db) $ do
+          update
+            [ f ~> Task_failedSelector =. (Just . T.pack $ "Step 2:" <> show e)
+            ]
+            (pk ==. taskId)
+          return $ Just e
+        Right followup -> Rhyolite.Backend.DB.runDb (Identity db) $ do
+          bOrError <- withSavepoint "Rhyolite.Backend.TaskWorker[1]" followup
+          case bOrError of
+            Left (e :: SomeException) -> do
+              update
+                [ f ~> Task_failedSelector =. (Just . T.pack $ "Step 3:" <> show e)
+                ]
+                (pk ==. taskId)
+              return $ Just e
+            Right b -> do
+              update
+                [ f ~> Task_resultSelector =. Just b
+                , f ~> Task_checkedOutBySelector =. (Nothing :: Maybe Text)
+                , f ~> Task_checkedOutAtSelector =. (Nothing :: Maybe UTCTime)
+                ]
+                (pk ==. taskId)
+              return Nothing
+      case finallError of
+        Just e -> throw e
+        Nothing -> pure True
 
 -- | Run a worker thread
 -- The worker will wake up whenever the timer expires or the wakeup action is called
@@ -104,3 +155,4 @@ withWorker d work child = do
           Right False -> sleep nextStartVar
         go nextStartVar
   bracket (liftIO $ async $ go initialStartVar) (liftIO . cancel) $ \_ -> child wakeup
+
diff --git a/backend/Rhyolite/Backend/App.hs b/backend/Rhyolite/Backend/App.hs
index b8e6b5e8..ac96af5f 100644
--- a/backend/Rhyolite/Backend/App.hs
+++ b/backend/Rhyolite/Backend/App.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Rhyolite.Backend.App
@@ -19,13 +20,13 @@ module Rhyolite.Backend.App
 import Control.Category (Category)
 import qualified Control.Category as Cat
 import Control.Concurrent (forkIO, killThread)
-import Control.Exception (bracket)
+import Control.Exception (SomeException(..), bracket, try)
 import Control.Lens (imapM_)
-import Control.Monad (forever, void, when)
+import Control.Monad (forever, when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.State.Strict (evalStateT, get, put)
-import Control.Monad.Trans (lift)
-import Data.Aeson (FromJSON, toJSON)
+import Data.Aeson (FromJSON, ToJSON, toJSON)
+import Data.Align
+import Data.Constraint.Extras
 import Data.Map.Monoidal (MonoidalMap)
 import qualified Data.Map.Monoidal as Map
 import Data.Foldable (fold)
@@ -33,26 +34,28 @@ import Data.IORef (atomicModifyIORef', newIORef, readIORef)
 import Data.MonoidMap (MonoidMap (..), monoidMap)
 import Data.Pool (Pool)
 import Data.Semigroup (Semigroup, (<>))
+import Data.Some (Some(Some))
 import Data.Text (Text)
+import qualified Data.Text.IO as T
 import Data.Typeable (Typeable)
 import Data.Witherable (Filterable(..))
 import Debug.Trace (trace)
 import Database.Groundhog.Postgresql (Postgresql (..))
 import qualified Database.PostgreSQL.Simple as Pg
-import Reflex.Patch (Group, negateG, (~~))
 import Reflex.Query.Base (mapQuery, mapQueryResult)
 import Reflex.Query.Class (Query, QueryResult, QueryMorphism (..), SelectedCount (..), crop)
 import Snap.Core (MonadSnap, Snap)
 import qualified Web.ClientSession as CS
 import qualified Network.WebSockets as WS
 import Data.Coerce (coerce)
+import Data.Vessel
 
-import Rhyolite.Api (AppRequest)
-import Rhyolite.App (HasRequest, HasView, ViewSelector, singletonQuery)
+-- import Rhyolite.Api
+import Rhyolite.App
 import Rhyolite.Backend.Listen (startNotificationListener)
 import Rhyolite.Sign (Signed)
 import Rhyolite.Backend.WebSocket (withWebsocketsConnection, getDataMessage, sendEncodedDataMessage)
-import Rhyolite.Request.Class (SomeRequest (..))
+import Rhyolite.Request.Class
 import Rhyolite.Backend.Sign (readSignedWithKey)
 import Rhyolite.WebSocket (TaggedRequest (..), TaggedResponse (..), WebSocketResponse (..), WebSocketRequest (..))
 
@@ -61,26 +64,26 @@ import Rhyolite.WebSocket (TaggedRequest (..), TaggedResponse (..), WebSocketRes
 -- The request format expected here is 'TaggedRequest'
 -- The response format expected here is 'TaggedResponse'
 handleAppRequests
-  :: (MonadSnap m, HasRequest app)
-  => (forall a. AppRequest app a -> IO a)
+  :: (MonadSnap m, Request r)
+  => (forall a. r a -> IO a)
   -> m ()
 handleAppRequests f = withWebsocketsConnection $ forever . handleAppRequest f
 
 handleAppRequest
-  :: (HasRequest app)
-  => (forall a. AppRequest app a -> IO a)
+  :: (Request r)
+  => (forall a. r a -> IO a)
   -> WS.Connection
   -> IO ()
 handleAppRequest f conn = do
-  (TaggedRequest reqId (SomeRequest req)) <- getDataMessage conn
+  (TaggedRequest reqId (Some req)) <- getDataMessage conn
   a <- f req
-  sendEncodedDataMessage conn $ TaggedResponse reqId (toJSON a)
+  sendEncodedDataMessage conn $ TaggedResponse reqId (has @ToJSON req (toJSON a))
 
 -------------------------------------------------------------------------------
 
 -- | Handles API requests
-newtype RequestHandler app m = RequestHandler
-  { runRequestHandler :: forall a. AppRequest app a -> m a }
+newtype RequestHandler r m = RequestHandler
+  { runRequestHandler :: forall a. r a -> m a }
 
 -------------------------------------------------------------------------------
 
@@ -103,6 +106,20 @@ newtype Registrar q = Registrar { unRegistrar :: Recipient q IO -> IO (QueryHand
 -- q' is the datasource side
 newtype Pipeline m q q' = Pipeline { unPipeline :: QueryHandler q' m -> Recipient q m -> IO (QueryHandler q m, Recipient q' m) }
 
+tracePipeline :: (Show q, Show (QueryResult q)) => String -> Pipeline IO q q
+tracePipeline tag = Pipeline $ \qh r -> do
+  putStrLn $ tag ++ "(start)"
+  return 
+    ( QueryHandler $ \q -> do
+        putStrLn $ tag ++ "(query): " ++ show q
+        qr <- runQueryHandler qh q
+        putStrLn $ tag ++ "(result): " ++ show qr
+        return qr
+    , Recipient $ \qr -> do
+        putStrLn $ tag ++ "(rcpt): " ++ show qr
+        tellRecipient r qr
+    )
+
 instance Category (Pipeline m) where
   id = Pipeline $ \qh r -> return (qh, r)
   Pipeline f . Pipeline g = Pipeline $ \qh r -> do
@@ -147,7 +164,7 @@ fanQuery lookupRecipient qh = (multiRecipient lookupRecipient, fanQueryHandler q
 --             a. A 'QueryHandler' for the newly registered client
 --             b. A removal callback to de-register a particular client
 multiplexQuery
-  :: (MonadIO m, Group q)
+  :: (MonadIO m, Monoid q, DiffQuery q)
   => (ClientKey -> QueryHandler q m)
   -> IO ( ClientKey -> IO (Recipient q m)
         , Recipient q m -> IO (QueryHandler q m, m ())
@@ -173,23 +190,21 @@ multiplexQuery lookupQueryHandler = do
         ((ClientKey (unClientKey cid + 1), Map.insert cid (s, mempty) recipients), cid)
       let
         queryHandler = QueryHandler $ \q -> do
-          liftIO $ atomicModifyIORef' clients $ \(nextCid, recipients) ->
-            ((nextCid, Map.update (\(r, oldQ) -> Just (r, oldQ <> q)) cid recipients), ())
-          runQueryHandler (lookupQueryHandler cid) q
-
+          qOld <- liftIO $ atomicModifyIORef' clients $ \(nextCid, recipients) ->
+            ((nextCid, Map.update (\(r, _) -> Just (r, q)) cid recipients), maybe mempty snd $ Map.lookup cid recipients)
+          case diffQuery q qOld of
+            Nothing -> do
+              return mempty
+            Just qDiff -> do
+              runQueryHandler (lookupQueryHandler cid) qDiff
         unregisterRecipient = do
-          antiQ <- liftIO $ atomicModifyIORef' clients $ \(nextCid, recipients) ->
+          liftIO $ atomicModifyIORef' clients $ \(nextCid, recipients) ->
             case Map.updateLookupWithKey (\_ _ -> Nothing) cid recipients of
               (Nothing, _) -> trace
                 ("Rhyolite.Backend.App.multiplexQuery: Tried to unregister a client key that is not registered " <> show cid)
-                ((nextCid, recipients), mempty)
-              (Just (_, removedQuery), newRecipients) -> ((nextCid, newRecipients), negateG removedQuery)
-
-          -- TODO: Should we have a way of ensuring that this doesn't actually cause a query to be run?
-          -- It shouldn't cause the query to be run again but it depends on if the callee will notice
-          -- that the new query is strictly smaller than the old one.
-          runQueryHandler (lookupQueryHandler cid) antiQ
-          return ()
+                ((nextCid, recipients), ())
+              (Just (_, _removedQuery), newRecipients) -> ((nextCid, newRecipients), ())
+                -- TODO: Do we need to do anything with the query that was removed now?
 
       return (queryHandler, unregisterRecipient)
 
@@ -197,46 +212,58 @@ multiplexQuery lookupQueryHandler = do
 
 -- | Like 'handleWebsocketConnection' but customized for 'Snap'.
 handleWebsocket
-  :: forall app.
-     ( HasView app
-     , HasRequest app
-     , Eq (ViewSelector app SelectedCount) )
+  :: forall r q.
+     ( Request r
+     , Eq (QueryResult q)
+     , Monoid (QueryResult q)
+     , ToJSON (QueryResult q)
+     , FromJSON q
+     , Monoid q
+     , DiffQuery q
+     )
   => Text -- ^ Version
-  -> RequestHandler app IO -- ^ Handler for API requests
-  -> Registrar (ViewSelector app SelectedCount)
+  -> RequestHandler r IO -- ^ Handler for API requests
+  -> Registrar q
   -> Snap ()
 handleWebsocket v rh register = withWebsocketsConnection (handleWebsocketConnection v rh register)
 
 -- | Handles a websocket connection given a raw connection.
 handleWebsocketConnection
-  :: forall app.
-    ( HasView app
-    , HasRequest app
-    , Eq (ViewSelector app SelectedCount) )
+  :: forall r q.
+    ( Request r
+    , Eq (QueryResult q)
+    , ToJSON (QueryResult q)
+    , FromJSON q
+    , Monoid q
+    , DiffQuery q
+    )
   => Text -- ^ Version
-  -> RequestHandler app IO -- ^ Handler for API requests
-  -> Registrar (ViewSelector app SelectedCount)
+  -> RequestHandler r IO -- ^ Handler for API requests
+  -> Registrar q
   -> WS.Connection
   -> IO ()
 handleWebsocketConnection v rh register conn = do
-  let sender = Recipient $ sendEncodedDataMessage conn . (\a -> WebSocketResponse_View (void a) :: WebSocketResponse app)
-  sendEncodedDataMessage conn (WebSocketResponse_Version v :: WebSocketResponse app)
-  bracket (unRegistrar register sender) snd $ \(vsHandler, _) -> flip evalStateT mempty $ forever $ do
-    (wsr :: WebSocketRequest app (AppRequest app)) <- liftIO $ getDataMessage conn
+  let sender = Recipient $ sendEncodedDataMessage conn . (\a -> WebSocketResponse_View a :: WebSocketResponse q)
+  sendEncodedDataMessage conn (WebSocketResponse_Version v :: WebSocketResponse q)
+  bracket (unRegistrar register sender) snd $ \(vsHandler, _) -> forever $ do
+    (wsr :: WebSocketRequest q r) <- liftIO $ getDataMessage conn
     case wsr of
-      WebSocketRequest_Api (TaggedRequest reqId (SomeRequest req)) -> lift $ do
+      WebSocketRequest_Api (TaggedRequest reqId (Some req)) -> do
         a <- runRequestHandler rh req
         sendEncodedDataMessage conn
-          (WebSocketResponse_Api $ TaggedResponse reqId (toJSON a) :: WebSocketResponse app)
+          (WebSocketResponse_Api $ TaggedResponse reqId (has @ToJSON req (toJSON a)) :: WebSocketResponse q)
       WebSocketRequest_ViewSelector new -> do
-        old <- get
-        let new' = SelectedCount 1 <$ new
-            vsDiff = new' ~~ old
-        when (vsDiff /= mempty) $ do
-          qr <- lift $ runQueryHandler vsHandler vsDiff
-          put new'
-          when (qr /= mempty) $ lift $
-            sendEncodedDataMessage conn (WebSocketResponse_View (void qr) :: WebSocketResponse app)
+        qr <- runQueryHandler vsHandler new
+        when (qr /= mempty) $ do
+          sendEncodedDataMessage conn (WebSocketResponse_View qr :: WebSocketResponse q)
+
+functorQueryToGroup :: (Functor f) => f () -> f SelectedCount
+functorQueryToGroup = (SelectedCount 1 <$) 
+
+vesselQueryToGroup :: (View v)
+  => v (Const ()) -> v (Const SelectedCount)
+vesselQueryToGroup = mapV (\_ -> Const (SelectedCount 1))
+
 
 -------------------------------------------------------------------------------
 
@@ -245,7 +272,7 @@ handleWebsocketConnection v rh register conn = do
 -- Data taken from 'getNextNotification' is pushed into the pipeline and
 -- when the pipeline pulls data, it is retrieved using 'qh'
 feedPipeline
-  :: (Monoid q, Semigroup q)
+  :: (Monoid q, Semigroup q, DiffQuery q)
   => IO (q -> IO (QueryResult q))
   -- ^ Get the next notification to be sent to the pipeline. If no notification
   -- is available, this should block until one is available
@@ -257,9 +284,11 @@ feedPipeline
   -- ^ A way for the pipeline to request data
 feedPipeline getNextNotification qh r = do
   currentQuery <- newIORef mempty
-  let qhSaveQuery = QueryHandler $ \q -> do
-        atomicModifyIORef' currentQuery $ \old -> (q <> old, ())
-        runQueryHandler qh q
+  let qhSaveQuery = QueryHandler $ \new -> do
+        qDiff <- atomicModifyIORef' currentQuery $ \old ->
+          let diff = diffQuery new old
+          in (new, maybe mempty id diff)
+        runQueryHandler qh qDiff
   tid <- forkIO . forever $ do
     nm <- getNextNotification
     q <- readIORef currentQuery
@@ -269,25 +298,39 @@ feedPipeline getNextNotification qh r = do
 
 -- | Connects the pipeline to websockets consumers
 connectPipelineToWebsockets
-  :: (HasView app, HasRequest app, Eq (ViewSelector app SelectedCount))
+  :: ( Request r
+     , Monoid q
+     , Monoid (QueryResult q)
+     , Eq (QueryResult q)
+     , FromJSON q
+     , ToJSON (QueryResult q)
+     , DiffQuery q
+     )
   => Text
-  -> RequestHandler app IO
+  -> RequestHandler r IO
   -- ^ API handler
-  -> QueryHandler (MonoidalMap ClientKey (ViewSelector app SelectedCount)) IO
+  -> QueryHandler (MonoidalMap ClientKey q) IO
   -- ^ A way to retrieve more data for each consumer
-  -> IO (Recipient (MonoidalMap ClientKey (ViewSelector app SelectedCount)) IO, Snap ())
+  -> IO (Recipient (MonoidalMap ClientKey q) IO, Snap ())
   -- ^ A way to send data to many consumers and a handler for websockets connections
 connectPipelineToWebsockets = connectPipelineToWebsocketsRaw withWebsocketsConnection
 
 connectPipelineToWebsocketsRaw
-  :: (HasView app, HasRequest app, Eq (ViewSelector app SelectedCount))
+  :: ( Request r
+     , Monoid q
+     , Monoid (QueryResult q)
+     , Eq (QueryResult q)
+     , FromJSON q
+     , ToJSON (QueryResult q)
+     , DiffQuery q
+     )
   => ((WS.Connection -> IO ()) -> m a) -- ^ Websocket handler
   -> Text -- ^ Version
-  -> RequestHandler app IO
+  -> RequestHandler r IO
   -- ^ API handler
-  -> QueryHandler (MonoidalMap ClientKey (ViewSelector app SelectedCount)) IO
+  -> QueryHandler (MonoidalMap ClientKey q) IO
   -- ^ A way to retrieve more data for each consumer
-  -> IO (Recipient (MonoidalMap ClientKey (ViewSelector app SelectedCount)) IO, m a)
+  -> IO (Recipient (MonoidalMap ClientKey q) IO, m a)
   -- ^ A way to send data to many consumers and a handler for websockets connections
 connectPipelineToWebsocketsRaw withWsConn ver rh qh = do
   (allRecipients, registerRecipient) <- connectPipelineToWebsockets' qh
@@ -296,7 +339,10 @@ connectPipelineToWebsocketsRaw withWsConn ver rh qh = do
 -- | Like 'connectPipelineToWebsockets' but returns a Registrar that can
 -- be used to construct a handler for a particular client
 connectPipelineToWebsockets'
-  :: (Monoid (QueryResult q), Group q)
+  :: ( Monoid q
+     , Monoid (QueryResult q)
+     , DiffQuery q
+     )
   => QueryHandler (MonoidalMap ClientKey q) IO
   -> IO (Recipient (MonoidalMap ClientKey q) IO, Registrar q)
   -- ^ A way to send data to many consumers, and a way to register new consumers
@@ -315,44 +361,94 @@ extendRegistrar (Pipeline p) (Registrar r) = Registrar $ \recipient -> do
 -------------------------------------------------------------------------------
 
 serveDbOverWebsockets
-  :: ( HasRequest app
-     , HasView app
-     , q ~ MonoidalMap ClientKey (ViewSelector app SelectedCount)
-     , Monoid q', Semigroup q'
+  :: ( Request r
+     , Monoid q'
+     , Semigroup q'
+     , Eq q
+     , Monoid q
+     , FromJSON q
+     , DiffQuery q
+     , ToJSON (QueryResult q)
+     , Monoid (QueryResult q)
+     , Eq (QueryResult q)
      , FromJSON notifyMessage
+     , DiffQuery q'
      )
   => Pool Postgresql
-  -> RequestHandler app IO
+  -> RequestHandler r IO
   -> (notifyMessage -> q' -> IO (QueryResult q'))
   -> QueryHandler q' IO
-  -> Pipeline IO q q'
+  -> Pipeline IO (MonoidalMap ClientKey q) q'
   -> IO (Snap (), IO ())
-serveDbOverWebsockets = serveDbOverWebsocketsRaw withWebsocketsConnection
+serveDbOverWebsockets pool rh nh qh pipeline = do
+  mver <- try (T.readFile "version")
+  let version = either (\(SomeException _) -> "") id mver
+  serveDbOverWebsocketsRaw withWebsocketsConnection version pool rh nh qh pipeline
 
 serveDbOverWebsocketsRaw
-  :: ( HasRequest app
-     , HasView app
-     , q ~ MonoidalMap ClientKey (ViewSelector app SelectedCount)
-     , Monoid q', Semigroup q'
+  :: forall notifyMessage q q' r m a.
+     ( Request r
+     , Monoid q'
+     , Semigroup q'
+     , Eq q
+     , FromJSON q
+     , Monoid q
+     , DiffQuery q
+     , ToJSON (QueryResult q)
+     , Monoid (QueryResult q)
+     , Eq (QueryResult q)
      , FromJSON notifyMessage
+     , DiffQuery q'
      )
   => ((WS.Connection -> IO ()) -> m a)
+  -> Text -- ^ version
   -> Pool Postgresql
-  -> RequestHandler app IO
+  -> RequestHandler r IO
   -> (notifyMessage -> q' -> IO (QueryResult q'))
   -> QueryHandler q' IO
-  -> Pipeline IO q q'
+  -> Pipeline IO (MonoidalMap ClientKey q) q'
   -> IO (m a, IO ())
-serveDbOverWebsocketsRaw withWsConn db handleApi handleNotify handleQuery pipe = do
+serveDbOverWebsocketsRaw withWsConn version db handleApi handleNotify handleQuery pipe = do
   (getNextNotification, finalizeListener) <- startNotificationListener db
   rec (qh, finalizeFeed) <- feedPipeline (handleNotify <$> getNextNotification) handleQuery r
       (qh', r) <- unPipeline pipe qh r'
-      (r', handleListen) <- connectPipelineToWebsocketsRaw withWsConn "" handleApi qh'
+      (r', handleListen) <- connectPipelineToWebsocketsRaw withWsConn version handleApi qh'
   return (handleListen, finalizeFeed >> finalizeListener)
 
 convertPostgresPool :: Pool Pg.Connection -> Pool Postgresql
 convertPostgresPool = coerce
 
+-- | This is typically useful to provide as a last argument to serveDbOverWebsockets, as it handles
+-- the combinatorics of aggregating the queries of connected clients as provided to the handler for
+-- database notifications, and disaggregating the corresponding results of the queries accordingly.
+standardPipeline
+  :: forall m k q qr.
+    ( QueryResult (q (MonoidalMap k ())) ~ qr (MonoidalMap k ())
+    , QueryResult (q ()) ~ qr ()
+    , Functor m
+    , Ord k
+    , Align q
+    , Foldable qr
+    , Filterable qr
+    )
+  => Pipeline m (MonoidalMap k (q ())) (q (MonoidalMap k ()))
+standardPipeline = queryMorphismPipeline $ QueryMorphism condense disperse
+
+-- | This is also useful as a final argument to serveDbOverWebsockets, in the case that you're using Vessel-style queries/views.
+vesselPipeline
+  :: forall m t v.
+    ( QueryResult (t (v (Const ()))) ~ t (v Identity)
+    , QueryResult (v (Compose t (Const ()))) ~ v (Compose t Identity)
+    , Monoid (v (Compose t (Const ())))
+    , Monoid (v (Const ()))
+    , Functor m
+    , View v
+    , Foldable t
+    , Filterable t
+    , Align t
+    )
+  => Pipeline m (t (v (Const ()))) (v (Compose t (Const ())))
+vesselPipeline = queryMorphismPipeline transposeView
 
 -------------------------------------------------------------------------------
 
diff --git a/backend/Rhyolite/Backend/HaveIBeenPwned.hs b/backend/Rhyolite/Backend/HaveIBeenPwned.hs
new file mode 100644
index 00000000..9d7bab6a
--- /dev/null
+++ b/backend/Rhyolite/Backend/HaveIBeenPwned.hs
@@ -0,0 +1,148 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- Module extracted from focus. Got rid of all the stuff that is not
+-- needed and changed parts to use Rhyolite instead of Focus stuff (e.g.
+-- logging):
+module Rhyolite.Backend.HaveIBeenPwned where
+
+import "cryptohash" Crypto.Hash -- or maybe i wanted cryptonite?
+import Control.Monad.Reader
+import Control.Monad.Logger
+import Control.Exception
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LBS
+import Data.Text(Text)
+import Data.Text.Encoding(encodeUtf8)
+import qualified Data.Text.Lazy.Encoding
+import Network.HTTP.Client
+import Network.HTTP.Client.TLS
+import Network.HTTP.Types.Status(Status(..))
+import System.IO
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import Data.Default (def)
+
+import Rhyolite.Backend.Logging (withLogging, LoggingConfig (..), RhyoliteLogAppender (..))
+
+
+data HaveIBeenPwnedError
+  = HaveIBeenPwnedError_BadResponse Status
+  | HaveIBeenPwnedError_NetworkError HttpException
+  deriving (Show) -- no eq instance for HttpException
+
+data HaveIBeenPwnedConfig = HaveIBeenPwnedConfig
+  { _haveIBeenPwnedConfig_manager :: Manager
+  , _haveIBeenPwnedConfig_apihost :: Text
+  }
+
+data HaveIBeenPwnedResult
+  = HaveIBeenPwnedResult_Undisclosed
+  | HaveIBeenPwnedResult_Disclosed Int
+  | HaveIBeenPwnedResult_ApiError
+  deriving (Eq, Ord, Show)
+
+class Monad m => MonadPwned m where
+  -- | returns the number of disclosures the supplied password has been seen in.
+  --
+  -- if this is not zero, do not use the supplied password, it is known to hackers.
+  -- if it is *is* zero, it might still not be safe, only that if it is
+  -- compramised, that is not yet known
+  --
+  -- https://haveibeenpwned.com/API/v2#SearchingPwnedPasswordsByRange
+  haveIBeenPwned :: Text -> m HaveIBeenPwnedResult
+
+newtype PwnedT m a = PwnedT { unPwnedT :: ReaderT HaveIBeenPwnedConfig m a }
+  deriving (Functor, Applicative, Monad , MonadIO, MonadLogger
+    , MonadTrans
+    )
+
+runPwnedT :: PwnedT m a -> HaveIBeenPwnedConfig -> m a
+runPwnedT (PwnedT (ReaderT f)) = f
+
+mapPwnedT :: (m a -> n b) -> PwnedT m a -> PwnedT n b
+mapPwnedT f = PwnedT . mapReaderT f . unPwnedT
+
+instance MonadReader r m => MonadReader r (PwnedT m) where
+  ask = lift ask
+  local = mapPwnedT . local
+  reader = lift . reader
+
+instance (MonadLogger m, MonadIO m) => MonadPwned (PwnedT m) where
+ haveIBeenPwned password = do
+  let (pfx, rest) = passwdDigest password
+  cfg <- PwnedT ask
+  let request = parseRequest_ $ T.unpack $ T.concat [_haveIBeenPwnedConfig_apihost cfg, "/", pfx]
+  result' <- liftIO $ try $ httpLbs request (_haveIBeenPwnedConfig_manager cfg)
+  case result' of
+    Left err -> do
+      $(logError) $ T.pack $ show @ HttpException $ err
+      return HaveIBeenPwnedResult_ApiError
+    Right result -> case responseStatus result of
+      Status 200 _ -> return $ case parseHIBPResponse (responseBody result) rest of
+        0 -> HaveIBeenPwnedResult_Undisclosed
+        n -> HaveIBeenPwnedResult_Disclosed n
+      Status code phrase -> do
+        $(logError) $ T.pack $ show $ Status code phrase
+        return HaveIBeenPwnedResult_ApiError
+
+
+-- | get the sha1 digest for the supplied password, split into two two parts, to agree with the
+--   hibp api
+passwdDigest :: Text -> (Text, Text)
+passwdDigest passwd = (T.take 5 digest, T.drop 5 digest)
+  where digest = T.toUpper $ T.pack $ show $ sha1 $ encodeUtf8 passwd
+        sha1 :: ByteString -> Digest SHA1
+        sha1 = hash
+
+-- | the hibp response is a line separated list of colon separated hash
+-- *suffixes* and a number indicationg the number of times that password(hash)
+-- has been seen in known publicly disclosed leaks
+
+parseHIBPResponse :: LBS.ByteString -> Text -> Int
+parseHIBPResponse response suffix =
+  let
+    digests :: [(LT.Text, Int)]
+    digests = fmap (fmap (read . LT.unpack . LT.drop 1) . LT.breakOn ":") $ LT.lines $ Data.Text.Lazy.Encoding.decodeUtf8 response
+  in case filter ((LT.fromStrict suffix ==) . fst) digests of
+    ((_,n):_) -> n
+    [] -> 0
+
+-- a really simple demo of the hibp functionality
+consoleHaveIBeenPwned :: IO ()
+consoleHaveIBeenPwned = do
+  withLogging [LoggingConfig (RhyoliteLogAppender_Stderr def) mempty] $ do
+    mgr <- liftIO $ newManager tlsManagerSettings
+    p <- liftIO $ getPassword
+    let hibpEnv = HaveIBeenPwnedConfig mgr "https://api.pwnedpasswords.com/range"
+    p' <- flip runPwnedT hibpEnv $ haveIBeenPwned $ T.pack p
+    liftIO $ case p' of
+      HaveIBeenPwnedResult_Disclosed p'' ->
+        putStrLn $ "You have been pwned!  your password has appeared in breaches " ++ show p'' ++ " times."
+      HaveIBeenPwnedResult_Undisclosed ->
+        putStrLn "Your password does not appear in any known breaches.  Practice good password hygene."
+      HaveIBeenPwnedResult_ApiError ->
+        putStrLn "Network Error, try again later"
+
+getPassword :: IO String
+getPassword = do
+  putStr "Password: "
+  hFlush stdout
+  password <- withEcho False getLine
+  putChar '\n'
+  return password
+
+withEcho :: Bool -> IO a -> IO a
+withEcho echo action = do
+  old <- hGetEcho stdin
+  bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action
diff --git a/backend/rhyolite-backend.cabal b/backend/rhyolite-backend.cabal
index 5c498042..b1cfa6d8 100644
--- a/backend/rhyolite-backend.cabal
+++ b/backend/rhyolite-backend.cabal
@@ -25,6 +25,7 @@ library
     , constraints
     , constraints-extras
     , containers
+    , cryptohash
     , data-default
     , dependent-sum
     , dependent-sum-aeson-orphans
@@ -35,6 +36,9 @@ library
     , groundhog-th
     , HaskellNet
     , HaskellNet-SSL
+    , http-client
+    , http-client-tls
+    , http-types
     , io-streams
     , lens
     , lifted-base
@@ -65,6 +69,7 @@ library
     , transformers-base
     , unordered-containers
     , vector
+    , vessel
     , websockets
     , websockets-snap
     , witherable >= 0.2 && < 0.4
@@ -77,6 +82,7 @@ library
     Rhyolite.Backend.App
     Rhyolite.Backend.Email
     Rhyolite.Backend.EmailWorker
+    Rhyolite.Backend.HaveIBeenPwned
     Rhyolite.Backend.Listen
     Rhyolite.Backend.Logging
     Rhyolite.Backend.Sign
diff --git a/common/Rhyolite/Account.hs b/common/Rhyolite/Account.hs
index b6680088..16a8f619 100644
--- a/common/Rhyolite/Account.hs
+++ b/common/Rhyolite/Account.hs
@@ -20,10 +20,8 @@ import Data.ByteString (ByteString)
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Data.Typeable (Typeable)
-import GHC.Generics (Generic)
 import Obelisk.Route(Encoder, isoEncoder)
-
-import Rhyolite.Request.TH (makeJson)
+import GHC.Generics
 import Rhyolite.Schema (HasId, Email, Id)
 import Rhyolite.Sign (Signed(..))
 
@@ -54,7 +52,10 @@ deriving instance (Ord (f (Id Account))) => Ord (PasswordResetToken f)
 deriving instance (ToJSON (f (Id Account))) => ToJSON (PasswordResetToken f)
 deriving instance (FromJSON (f (Id Account))) => FromJSON (PasswordResetToken f)
 
-newtype AccountRoute f = AccountRoute_PasswordReset { unAccountRoute :: Signed (PasswordResetToken f) } deriving (Show, Read, Eq, Ord)
+newtype AccountRoute f = AccountRoute_PasswordReset { unAccountRoute :: Signed (PasswordResetToken f) } deriving (Show, Read, Eq, Ord, Generic)
+
+instance ToJSON (AccountRoute f)
+instance FromJSON (AccountRoute f)
 
 _AccountRoute :: Iso (AccountRoute f) (AccountRoute g) (Signed (PasswordResetToken f)) (Signed (PasswordResetToken g))
 _AccountRoute = iso unAccountRoute AccountRoute_PasswordReset
@@ -63,5 +64,3 @@ _Signed = iso unSigned Signed
 
 accountRouteEncoder :: (Applicative check, Applicative parse) => Encoder check parse (AccountRoute f) Text
 accountRouteEncoder = isoEncoder (_AccountRoute . _Signed)
-
-makeJson ''AccountRoute
diff --git a/common/Rhyolite/Api.hs b/common/Rhyolite/Api.hs
index 5fea08a2..6954cde6 100644
--- a/common/Rhyolite/Api.hs
+++ b/common/Rhyolite/Api.hs
@@ -2,48 +2,47 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Rhyolite.Api where
 
-import Data.Aeson (ToJSON, FromJSON, parseJSON, toJSON)
-import Data.Constraint (Dict (..))
-
-import Rhyolite.App (AppCredential, PublicRequest, PrivateRequest)
-import Rhyolite.Request.Class (Request, SomeRequest (..), requestToJSON, requestParseJSON, requestResponseToJSON, requestResponseFromJSON)
-import Rhyolite.HList (HList (HNil, HCons))
+import Data.Aeson
+import Data.Some
+import Data.Constraint.Extras
 
 data ApiRequest :: * -> (k -> *) -> (k -> *) -> k -> * where
   ApiRequest_Public :: public a -> ApiRequest cred public private a
   ApiRequest_Private :: cred -> private a -> ApiRequest cred public private a
   deriving (Show)
 
-type AppRequest app = ApiRequest (AppCredential app) (PublicRequest app) (PrivateRequest app)
+instance (ArgDict c public, ArgDict c private) => ArgDict c (ApiRequest cred public private) where
+  type ConstraintsFor (ApiRequest cred public private) c = (ConstraintsFor public c, ConstraintsFor private c)
+  argDict = \case
+    ApiRequest_Public x -> argDict x
+    ApiRequest_Private _ x -> argDict x
 
-instance (Request private, Request public, ToJSON cred, FromJSON cred) => Request (ApiRequest cred public private) where
-  requestToJSON r = case r of
-    ApiRequest_Public p -> case (requestResponseToJSON p, requestResponseFromJSON p) of
-      (Dict, Dict) -> toJSON ("Public"::String, SomeRequest p `HCons` HNil)
-    ApiRequest_Private token p -> case (requestResponseToJSON p, requestResponseFromJSON p) of
-      (Dict, Dict) -> toJSON ("Private"::String, token `HCons` SomeRequest p `HCons` HNil)
-  requestParseJSON v = do
-    (tag, body) <- parseJSON v
-    case tag of
-      ("Public"::String) -> do
-        SomeRequest p `HCons` HNil <- parseJSON body
-        return $ SomeRequest $ ApiRequest_Public p
-      ("Private"::String) -> do
-        token `HCons` SomeRequest p `HCons` HNil <- parseJSON body
-        return $ SomeRequest $ ApiRequest_Private token p
-      e -> error $ "Could not parse tag: " ++ e
-  requestResponseToJSON = \case
-    ApiRequest_Public p -> requestResponseToJSON p
-    ApiRequest_Private _ p -> requestResponseToJSON p
-  requestResponseFromJSON = \case
-    ApiRequest_Public p -> requestResponseFromJSON p
-    ApiRequest_Private _ p -> requestResponseFromJSON p
-
-public :: PublicRequest app t -> AppRequest app t
+public :: public t -> ApiRequest cred public private t
 public = ApiRequest_Public
 
-private :: AppCredential app -> PrivateRequest app t -> AppRequest app t
+private :: cred -> private t -> ApiRequest cred public private t
 private = ApiRequest_Private
+
+instance (ToJSON cred, ToJSON (public a), ToJSON (private a)) => ToJSON (ApiRequest cred public private a) where
+  toJSON = \case
+    ApiRequest_Public x -> toJSON ("public", toJSON x)
+    ApiRequest_Private c x -> toJSON ("private", (toJSON x, toJSON c))
+
+instance (FromJSON cred, FromJSON (Some public), FromJSON (Some private)) => FromJSON (Some (ApiRequest cred public private)) where
+  parseJSON v = do
+    (tag,rest) <- parseJSON v
+    case tag of
+      "public" -> do
+        Some x <- parseJSON rest
+        return (Some (ApiRequest_Public x))
+      "private" -> do
+        (Some x, c) <- parseJSON rest
+        return (Some (ApiRequest_Private c x))
+      _ -> fail "Request appears neither public nor private"
\ No newline at end of file
diff --git a/common/Rhyolite/App.hs b/common/Rhyolite/App.hs
index 796b5015..f2f63716 100644
--- a/common/Rhyolite/App.hs
+++ b/common/Rhyolite/App.hs
@@ -2,9 +2,11 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
@@ -13,56 +15,34 @@
 module Rhyolite.App where
 
 import Data.Aeson (FromJSON, ToJSON)
-import Data.Align (Align)
 import qualified Data.AppendMap as MonoidalMap
-import Data.Functor.Identity (Identity)
 import Data.Map.Monoidal (MonoidalMap)
 import Data.Semigroup (Semigroup)
+import Data.Witherable
+import Data.AppendMap() -- contains the orphan for Filterable MonoidalMap
 import qualified Data.Semigroup as Semigroup
 import Data.Typeable (Typeable)
 import Data.Witherable (Filterable(..))
 import GHC.Generics (Generic)
-import Reflex.Query.Class (Query, QueryMorphism(..), QueryResult, SelectedCount, crop)
-import Reflex.Patch (Group, Additive)
+import Reflex.Query.Class
 
-import Rhyolite.Account (AuthToken)
-import Rhyolite.Request.Class (Request)
-import Rhyolite.Sign (Signed)
+-- | Set-subtraction operation for queries.
+class (Query q, Eq q) => DiffQuery q where
+  diffQuery :: q -> q -> Maybe q -- ^ diffQuery x y indicates interest in the part of x which is not indicated by y. Results in Nothing if this difference is empty.
 
 singletonQuery :: (Monoid (QueryResult q), Ord k) => k -> QueryMorphism q (MonoidalMap k q)
 singletonQuery k = QueryMorphism { _queryMorphism_mapQuery = MonoidalMap.singleton k
                                  , _queryMorphism_mapQueryResult = MonoidalMap.findWithDefault mempty k
                                  }
 
-class ( ToJSON (ViewSelector app ()), FromJSON (ViewSelector app ())
-      , ToJSON (View app ()), FromJSON (View app ())
-      , Monoid (ViewSelector app SelectedCount), Semigroup (ViewSelector app SelectedCount)
-      , Group (ViewSelector app SelectedCount), Additive (ViewSelector app SelectedCount)
-      , Query (ViewSelector app SelectedCount), QueryResult (ViewSelector app SelectedCount) ~ View app SelectedCount
-      , Align (ViewSelector app), Filterable (ViewSelector app), Foldable (ViewSelector app)
-      , Traversable (ViewSelector app)
-      , Eq (ViewSelector app SelectedCount)
-      , Eq (View app ()), Show (View app ()), Functor (View app), Eq (View app SelectedCount)
-      ) => HasView app where
-  type View app :: * -> *
-  type ViewSelector app :: * -> *
-
 cropView :: (Query q) => q -> QueryResult q -> QueryResult q
 cropView = crop
 
-class (Request (PublicRequest app), Request (PrivateRequest app), ToJSON (AppCredential app), FromJSON (AppCredential app), Eq (AppCredential app)) => HasRequest app where
-  data PublicRequest app :: * -> *
-  data PrivateRequest app :: * -> *
-  type AppCredential app :: *
-  type AppCredential app = Signed (AuthToken Identity)
-
 fmapMaybeFst :: Filterable f => (a -> Maybe b) -> f (a, c) -> f (b, c)
 fmapMaybeFst f = mapMaybe $ \(a, c) -> case f a of
   Nothing -> Nothing
   Just b -> Just (b, c)
 
-
-
 -- | A view for a single piece of data, supporting update and delete.
 newtype Single t a = Single { unSingle :: Maybe (Semigroup.First (Maybe t), a) }
   deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic, Typeable)
diff --git a/common/Rhyolite/Request/Class.hs b/common/Rhyolite/Request/Class.hs
index 353e13d8..2affcbf4 100644
--- a/common/Rhyolite/Request/Class.hs
+++ b/common/Rhyolite/Request/Class.hs
@@ -1,22 +1,15 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Rhyolite.Request.Class where
 
-import Data.Aeson (FromJSON, ToJSON, Value, parseJSON, toJSON)
-import Data.Aeson.Types (Parser)
-import Data.Constraint (Dict)
+import Data.Aeson (FromJSON, ToJSON, toJSON)
+import Data.Constraint.Forall
+import Data.Constraint.Extras
+import Data.Some
 
-data SomeRequest t where
-    SomeRequest :: (FromJSON x, ToJSON x) => t x -> SomeRequest t
-
-class Request r where
-  requestToJSON :: r a -> Value
-  requestParseJSON :: Value -> Parser (SomeRequest r)
-  requestResponseToJSON :: r a -> Dict (ToJSON a)
-  requestResponseFromJSON :: r a -> Dict (FromJSON a)
-
-instance Request r => FromJSON (SomeRequest r) where
-  parseJSON = requestParseJSON
-
-instance Request r => ToJSON (SomeRequest r) where
-  toJSON (SomeRequest r) = requestToJSON r
+type Request r = (ForallF ToJSON r, Has ToJSON r, FromJSON (Some r), Has FromJSON r)
diff --git a/common/Rhyolite/Request/TH.hs b/common/Rhyolite/Request/TH.hs
deleted file mode 100644
index 89bbefe9..00000000
--- a/common/Rhyolite/Request/TH.hs
+++ /dev/null
@@ -1,133 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Rhyolite.Request.TH where
-
-import Control.Monad (guard, replicateM)
-import Data.Aeson.Types
-import Data.Constraint (Dict (..))
-import Data.List (isPrefixOf)
-import Data.Semigroup ((<>))
-import Language.Haskell.TH
-
-import Rhyolite.HList (HList (HCons, HNil))
-import Rhyolite.Request.Class
-import Rhyolite.TH (conName)
-
-makeJson :: Name -> DecsQ
-makeJson n = do
-  x <- reify n
-  let base = nameBase n
-      toBeStripped = base <> "_"
-      modifyConName cn = if length cons == 1 then cn else if toBeStripped `isPrefixOf` cn then drop (length toBeStripped) cn else error $ "makeRequest: expecting name beginning with " <> show toBeStripped <> ", got " <> show cn
-      cons = case x of
-        TyConI d -> decCons d
-        _ -> error $ "cant do constructor:" ++ show x
-      typeNames = map tvbName $ case x of
-        TyConI d -> decTvbs d
-        _ -> error $ "cant do typename:" ++ show x
-  let wild = match wildP (normalB [|fail "invalid message"|]) []
-  [d|
-    instance ToJSON $(foldl appT (conT n) $ map varT typeNames)   where
-      toJSON r = $(caseE [|r|] $ map (conToJson modifyConName) cons)
-    instance ToJSONKey $(foldl appT (conT n) $ map varT typeNames)   where
-      toJSONKey = ToJSONKeyValue toJSON toEncoding
-    instance FromJSON $(foldl appT (conT n) $ map varT typeNames) where
-      parseJSON v = do
-        (tag', v') <- parseJSON v
-        $(caseE [|tag' :: String|] $ map (conParseJson modifyConName id [|v'|]) cons ++ [wild])
-    instance FromJSONKey $(foldl appT (conT n) $ map varT typeNames) where
-      fromJSONKey = FromJSONKeyValue parseJSON
-    |]
-
-makeRequestForDataInstance :: Name -> Name -> DecsQ
-makeRequestForDataInstance n n' = do
-  x <- reify n
-  let base = nameBase n
-      toBeStripped = base <> "_"
-      modifyConName cn = if length cons == 1 then cn else if toBeStripped `isPrefixOf` cn then drop (length toBeStripped) cn else error $ "makeRequest: expecting name beginning with " <> show toBeStripped <> ", got " <> show cn
-      cons = case x of
-                  (FamilyI _ dataInstances) -> do
-                    (DataInstD _ _ (ConT m:_) _ xs _) <- dataInstances
-                    guard $ m == n'
-                    xs
-                  _ -> error $ "cant do family:" ++ show x
-  let wild = match wildP (normalB [|fail "invalid message"|]) []
-  [d|
-    instance Request $(appT (conT n) (conT n')) where
-      requestToJSON r = $(caseE [|r|] $ map (conToJson modifyConName) cons)
-      requestParseJSON v = do
-        (tag', v') <- parseJSON v
-        $(caseE [|tag' :: String|] $ map (conParseJson modifyConName (\body -> [|SomeRequest <$> $body|]) [|v'|]) cons ++ [wild])
-      requestResponseToJSON r = $(caseE [|r|] $ map (\c -> match (conP (conName c) $ replicate (conArity c) wildP) (normalB [|Dict|]) []) cons)
-      requestResponseFromJSON r = $(caseE [|r|] $ map (\c -> match (conP (conName c) $ replicate (conArity c) wildP) (normalB [|Dict|]) []) cons)
-    |]
-
-makeRequestForData :: Name -> DecsQ
-makeRequestForData n = do
-  x <- reify n
-  let base = nameBase n
-      toBeStripped = base <> "_"
-      modifyConName cn = if length cons == 1 then cn else if toBeStripped `isPrefixOf` cn then drop (length toBeStripped) cn else error $ "makeRequest: expecting name beginning with " <> show toBeStripped <> ", got " <> show cn
-      cons ::[Con]
-      cons = case x of
-                  TyConI (DataD _ _ _ _ xs _) -> xs
-                  _ -> error $ "cant do data:" ++ show x
-  let wild = match wildP (normalB [|fail "invalid message"|]) []
-  [d|
-    instance Request $(conT n) where
-      requestToJSON r = $(caseE [|r|] $ map (conToJson modifyConName) cons)
-      requestParseJSON v = do
-        (tag', v') <- parseJSON v
-        $(caseE [|tag' :: String|] $ map (conParseJson modifyConName (\body -> [|SomeRequest <$> $body|]) [|v'|]) cons ++ [wild])
-      requestResponseToJSON r = $(caseE [|r|] $ map (\c -> match (conP (conName c) $ replicate (conArity c) wildP) (normalB [|Dict|]) []) cons)
-      requestResponseFromJSON r = $(caseE [|r|] $ map (\c -> match (conP (conName c) $ replicate (conArity c) wildP) (normalB [|Dict|]) []) cons)
-    |]
-
-conParseJson :: (String -> String) -> (ExpQ -> ExpQ) -> ExpQ -> Con -> MatchQ
-conParseJson modifyName wrapBody e c = do
-  let name = conName c
-  varNames <- replicateM (conArity c) $ newName "f"
-  let fields = map varE varNames
-      tuple = foldr (\a b -> conP 'HCons [varP a, b]) (conP 'HNil []) varNames
-      body = doE [ bindS tuple [|parseJSON $e|]
-                 , noBindS [|return $(appsE (conE name : fields))|]
-                 ]
-  match (litP (StringL (modifyName $ nameBase name))) (normalB (wrapBody body)) []
-
-conToJson :: (String -> String) -> Con -> MatchQ
-conToJson modifyName c = do
-  let name = conName c
-      base = nameBase name
-      tag' = modifyName base
-  varNames <- replicateM (conArity c) $ newName "f"
-  let tuple = foldr (\a b -> appsE [conE 'HCons, varE a, b]) (conE 'HNil) varNames
-      body = [|toJSON (tag' :: String, toJSON $tuple)|]
-  match (conP name $ map varP varNames) (normalB body) []
-
-conArity :: Con -> Int
-conArity c = case c of
-  NormalC _ ts -> length ts
-  RecC _ ts -> length ts
-  InfixC _ _ _ -> 2
-  ForallC _ _ c' -> conArity c'
-  GadtC _ ts _ -> length ts
-  RecGadtC _ ts _ -> length ts
-
-
-decCons :: Dec -> [Con]
-decCons d = case d of
-  DataD _ _ _ _ cs _ -> cs
-  NewtypeD _ _ _ _ c _ -> [c]
-  _ -> error $ "not a data/newtype:" ++ show d
-
--- | Extracts the name from a type variable binder.
-tvbName :: TyVarBndr -> Name
-tvbName (PlainTV  name  ) = name
-tvbName (KindedTV name _) = name
-
-
-decTvbs :: Dec -> [TyVarBndr]
-decTvbs d = case d of
-  DataD _ _ tvbs _ _ _ -> tvbs
-  NewtypeD _ _ tvbs _ _ _ -> tvbs
-  _ -> error $ "not a data/newtype:" ++ show d
diff --git a/common/Rhyolite/Schema/Task.hs b/common/Rhyolite/Schema/Task.hs
index 7051eccd..406e5bc9 100644
--- a/common/Rhyolite/Schema/Task.hs
+++ b/common/Rhyolite/Schema/Task.hs
@@ -3,6 +3,7 @@ module Rhyolite.Schema.Task where
 
 import Data.Aeson
 import Data.Text (Text)
+import Data.Time (UTCTime)
 import GHC.Generics
 
 -- | A value in the database whose presence indicates that some external work
@@ -10,6 +11,8 @@ import GHC.Generics
 data Task a = Task
   { _task_result :: !(Maybe a)
   , _task_checkedOutBy :: !(Maybe Text) -- The backend node that has checked out this task --TODO: Use session IDs instead of Text
+  , _task_checkedOutAt :: !(Maybe UTCTime)
+  , _task_failed :: !(Maybe Text)
   }
   deriving (Show, Read, Eq, Ord, Generic)
 
@@ -20,4 +23,6 @@ empty :: Task a
 empty = Task
   { _task_result = Nothing
   , _task_checkedOutBy = Nothing
+  , _task_checkedOutAt = Nothing
+  , _task_failed = Nothing
   }
diff --git a/common/Rhyolite/WebSocket.hs b/common/Rhyolite/WebSocket.hs
index 2debc0b7..71309db0 100644
--- a/common/Rhyolite/WebSocket.hs
+++ b/common/Rhyolite/WebSocket.hs
@@ -8,12 +8,12 @@ module Rhyolite.WebSocket where
 
 import Data.Aeson
 import Data.Semigroup ((<>))
+import Data.Some
 import Data.Text (Text)
 import Data.Typeable
 import GHC.Generics
 import Network.URI (URI(..))
-import Rhyolite.App
-import Rhyolite.Request.Class
+import Reflex.Query.Class
 
 websocketUri :: URI -> URI
 websocketUri uri = uri
@@ -25,28 +25,28 @@ websocketUri uri = uri
   }
 
 -- | Represents a WebSocket message from one of two channels: ViewSelector declarations or API requests
-data WebSocketRequest app r = WebSocketRequest_ViewSelector (ViewSelector app ())
-                            | WebSocketRequest_Api (TaggedRequest r)
+data WebSocketRequest q r = WebSocketRequest_ViewSelector q
+                          | WebSocketRequest_Api (TaggedRequest r)
   deriving (Typeable, Generic)
 
-instance (Request r, FromJSON (ViewSelector app ())) => FromJSON (WebSocketRequest app r)
-instance (Request r, ToJSON (ViewSelector app ())) => ToJSON (WebSocketRequest app r)
+instance (FromJSON q, FromJSON (Some r)) => FromJSON (WebSocketRequest q r)
+instance (ToJSON q, ToJSON (Some r)) => ToJSON (WebSocketRequest q r)
 
 -- | Represents a WebSocket response from one of three channels: incoming 'View's, API responses, or version info
-data WebSocketResponse app = WebSocketResponse_View (View app ())
-                           | WebSocketResponse_Api TaggedResponse
-                           | WebSocketResponse_Version Text
+data WebSocketResponse q = WebSocketResponse_View (QueryResult q)
+                         | WebSocketResponse_Api TaggedResponse
+                         | WebSocketResponse_Version Text
   deriving (Typeable, Generic)
 
-instance FromJSON (View app ()) => FromJSON (WebSocketResponse app)
-instance ToJSON (View app ()) => ToJSON (WebSocketResponse app)
+instance FromJSON (QueryResult q) => FromJSON (WebSocketResponse q)
+instance ToJSON (QueryResult q) => ToJSON (WebSocketResponse q)
 
 -- | A request tagged with an identifier
-data TaggedRequest r = TaggedRequest Value (SomeRequest r)
+data TaggedRequest r = TaggedRequest Value (Some r)
   deriving (Typeable, Generic)
 
-instance Request r => FromJSON (TaggedRequest r)
-instance Request r => ToJSON (TaggedRequest r)
+instance FromJSON (Some r) => FromJSON (TaggedRequest r)
+instance ToJSON (Some r) => ToJSON (TaggedRequest r)
 
 -- | A response tagged with an identifier matching the one in the 'TaggedRequest'. The identifier is the first argument.
 data TaggedResponse = TaggedResponse Value Value
diff --git a/common/default.nix b/common/default.nix
index b67697cd..e976ae11 100644
--- a/common/default.nix
+++ b/common/default.nix
@@ -4,7 +4,7 @@
 , mime-mail, monad-control, monad-logger, monoidal-containers, mtl
 , network-uri, reflex, resource-pool, stdenv, template-haskell
 , text, these, time, transformers, transformers-base, vector
-, aeson-gadt-th
+, aeson-gadt-th, constraints-extras
 , hostPlatform
 }:
 mkDerivation {
@@ -17,7 +17,7 @@ mkDerivation {
     dependent-sum file-embed filepath http-types mime-mail
     monad-control monoidal-containers mtl network-uri
     reflex resource-pool template-haskell text these time transformers
-    transformers-base vector aeson-gadt-th
+    transformers-base vector aeson-gadt-th constraints-extras
   ] ++ (if hostPlatform.libc == "bionic" || hostPlatform.isAarch64 then [] else [
     monad-logger
   ]);
diff --git a/common/rhyolite-common.cabal b/common/rhyolite-common.cabal
index 186a5d37..fc3738df 100644
--- a/common/rhyolite-common.cabal
+++ b/common/rhyolite-common.cabal
@@ -19,6 +19,7 @@ library
     , base
     , bytestring
     , constraints
+    , constraints-extras
     , containers
     , data-default
     , dependent-map
@@ -42,7 +43,8 @@ library
     , transformers
     , transformers-base
     , vector
-    , witherable >= 0.2 && < 0.4
+    , witherable
+    , vessel
 
   exposed-modules:
     Data.MonoidMap
@@ -54,7 +56,6 @@ library
     Rhyolite.HList
     Rhyolite.Request.Class
     Rhyolite.Request.Common
-    Rhyolite.Request.TH
     Rhyolite.Route
     Rhyolite.Schema
     Rhyolite.Schema.Task
diff --git a/default.nix b/default.nix
index a03b46fb..4d1c98de 100644
--- a/default.nix
+++ b/default.nix
@@ -8,57 +8,8 @@ let
   haskellLib = pkgs.haskell.lib;
 
   # Some dependency thunks needed
-  repos = {
-
-    # Point to OS fork of groundhog
-    groundhog = pkgs.fetchFromGitHub {
-      owner = "obsidiansystems";
-      repo = "groundhog";
-      rev = "f68d1c91a92a9514e771fc432ec2ea9cf93c78af";
-      sha256 = "196mq9ncgr8gcnk1p86390v54ixswhwak5wq4630rynyfxw8xmgw";
-    };
-
-    # bytestring-trie in hackage doesn’t support base 4.11+
-    bytestring-trie = pkgs.fetchFromGitHub {
-      owner = "obsidiansystems";
-      repo = "bytestring-trie";
-      rev = "27117ef4f9f01f70904f6e8007d33785c4fe300b";
-      sha256 = "103fqr710pddys3bqz4d17skgqmwiwrjksn2lbnc3w7s01kal98a";
-    };
-
-    # Unreleased version, includes fromList = fromListWith (<>)
-    monoidal-containers = pkgs.fetchFromGitHub {
-      owner = "bgamari";
-      repo = "monoidal-containers";
-      rev = "a34c9fbe191725ef9a9c7783e103c24796bd91e3";
-      sha256 = "1ar2w4rx0mh4nvwzpc125l3hj9xslargl43vnssmh9l6ynhi8ksv";
-    };
-
-    # Newly added to hackage
-    postgresql-lo-stream = pkgs.fetchFromGitHub {
-      owner = "obsidiansystems";
-      repo = "postgresql-lo-stream";
-      rev = "33e1a64c1f65d7d1e26d6d08d2ddb85eb795f94c";
-      sha256 = "0n2cmmplljq3z3n0piyiq4vvx8d48byi5isr520aq6dv35j5ixim";
-    };
-
-    # Newly added to hackage
-    push-notifications = pkgs.fetchFromGitHub {
-      owner = "obsidiansystems";
-      repo = "push-notifications";
-      rev = "18ae57d88a17a63389fe2a9aa0d9e421294a8781";
-      sha256 = "1jhhnyfgfjv1x0gb59gyj9nvffp5czgqx8zjr4b4m15p7sx8j714";
-    };
-
-    dependent-sum-aeson-orphans = pkgs.fetchFromGitHub {
-      owner = "obsidiansystems";
-      repo = "dependent-sum-aeson-orphans";
-      rev = "9c995128f416cc27dbd28d7dca1b6de4ac6c9c6d";
-      sha256 = "1cinfpchl4g3lpkwbcg03n5h25fj340g0n7bbr7hcx5nx0cwbzbc";
-    };
-
-    aeson-gadt-th = reflex-platform.hackGet ./dep/aeson-gadt-th;
-  };
+  dep = import ./dep reflex-platform.hackGet;
+  #TODO: Consider whether to prefer using thunkSet here.
 
   # Local packages. We override them below so that other packages can use them.
   rhyolitePackages = {
@@ -72,19 +23,12 @@ let
     rhyolite-frontend = ./frontend;
   };
 
-  # srcs used for overrides
-  overrideSrcs = rhyolitePackages // {
-    groundhog = repos.groundhog + /groundhog;
-    groundhog-postgresql = repos.groundhog + /groundhog-postgresql;
-    groundhog-th = repos.groundhog + /groundhog-th;
-    bytestring-trie = repos.bytestring-trie;
-    aeson-gadt-th = repos.aeson-gadt-th;
-    postgresql-lo-stream = repos.postgresql-lo-stream;
-    dependent-sum-aeson-orphans = repos.dependent-sum-aeson-orphans;
-    monoidal-containers = repos.monoidal-containers;
-    # Newly added to hackage
-    push-notifications = repos.push-notifications;
-  };
+  # srcs used for overrides.
+  overrideSrcs = rhyolitePackages // (dep // {
+    groundhog = dep.groundhog + /groundhog;
+    groundhog-postgresql = dep.groundhog + /groundhog-postgresql;
+    groundhog-th = dep.groundhog + /groundhog-th;
+  });
 
   # You can use these manually if you don’t want to use rhyolite.project.
   # It will be needed if you need to combine with multiple overrides.
diff --git a/dep/bytestring-trie/default.nix b/dep/bytestring-trie/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/bytestring-trie/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/bytestring-trie/github.json b/dep/bytestring-trie/github.json
new file mode 100644
index 00000000..661b6d67
--- /dev/null
+++ b/dep/bytestring-trie/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "bytestring-trie",
+  "branch": "ghc-8.4",
+  "rev": "27117ef4f9f01f70904f6e8007d33785c4fe300b",
+  "sha256": "103fqr710pddys3bqz4d17skgqmwiwrjksn2lbnc3w7s01kal98a"
+}
diff --git a/dep/default.nix b/dep/default.nix
new file mode 100644
index 00000000..1967210e
--- /dev/null
+++ b/dep/default.nix
@@ -0,0 +1,5 @@
+# Applies a given function to the subdirectories of this one.
+f: let inherit (builtins) readDir filter map listToAttrs getAttr attrNames;
+       fs = readDir ./.;
+       dirs = filter (x: getAttr x fs == "directory") (attrNames fs);
+   in listToAttrs (map (d: { name = d; value = f (./. + ("/" + d)); }) dirs)
diff --git a/dep/dependent-monoidal-map/default.nix b/dep/dependent-monoidal-map/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/dependent-monoidal-map/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/dependent-monoidal-map/github.json b/dep/dependent-monoidal-map/github.json
new file mode 100644
index 00000000..06cddf1a
--- /dev/null
+++ b/dep/dependent-monoidal-map/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "dependent-monoidal-map",
+  "branch": "develop",
+  "rev": "2739ff1a89a75403f1fea2bbb50d6c674cffb0e6",
+  "sha256": "1ic103xm153mdgp5bianzdwa0mh5l8ps06gmp02g3g51kfyfl1z8"
+}
diff --git a/dep/dependent-sum-aeson-orphans/default.nix b/dep/dependent-sum-aeson-orphans/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/dependent-sum-aeson-orphans/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/dependent-sum-aeson-orphans/github.json b/dep/dependent-sum-aeson-orphans/github.json
new file mode 100644
index 00000000..2cb29745
--- /dev/null
+++ b/dep/dependent-sum-aeson-orphans/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "dependent-sum-aeson-orphans",
+  "branch": "develop",
+  "rev": "027f0d0a37d2e3f90de225d5d278ed4bd4206310",
+  "sha256": "0j14rqsxd1i8081xxkg4jv2v86bbmq2iryvn6ijqwpj6hdz3x8yh"
+}
diff --git a/dep/groundhog/default.nix b/dep/groundhog/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/groundhog/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/groundhog/github.json b/dep/groundhog/github.json
new file mode 100644
index 00000000..06a3a2fb
--- /dev/null
+++ b/dep/groundhog/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "groundhog",
+  "branch": "develop",
+  "rev": "722efb06284a35ba32f55ed30a6450c36269c3bb",
+  "sha256": "1h95ma38l05lplw1gxsnii4gwyyw32131il3vypbr1mnl0cajnym"
+}
diff --git a/dep/monoidal-containers/default.nix b/dep/monoidal-containers/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/monoidal-containers/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/monoidal-containers/github.json b/dep/monoidal-containers/github.json
new file mode 100644
index 00000000..c80bafe4
--- /dev/null
+++ b/dep/monoidal-containers/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "bgamari",
+  "repo": "monoidal-containers",
+  "branch": "master",
+  "rev": "a34c9fbe191725ef9a9c7783e103c24796bd91e3",
+  "sha256": "1ar2w4rx0mh4nvwzpc125l3hj9xslargl43vnssmh9l6ynhi8ksv"
+}
diff --git a/dep/postgresql-lo-stream/default.nix b/dep/postgresql-lo-stream/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/postgresql-lo-stream/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/postgresql-lo-stream/github.json b/dep/postgresql-lo-stream/github.json
new file mode 100644
index 00000000..b43e4cbd
--- /dev/null
+++ b/dep/postgresql-lo-stream/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "postgresql-lo-stream",
+  "branch": "master",
+  "rev": "ca868c69d912d61eda1ea6feea6dce6b7df8217c",
+  "sha256": "0s6azpf5fjhy47jcv10m96jvvyx2xh3hsy688aa89ficv4mgi7yr"
+}
diff --git a/dep/push-notifications/default.nix b/dep/push-notifications/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/push-notifications/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/push-notifications/github.json b/dep/push-notifications/github.json
new file mode 100644
index 00000000..72667570
--- /dev/null
+++ b/dep/push-notifications/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "push-notifications",
+  "branch": "develop",
+  "rev": "18ae57d88a17a63389fe2a9aa0d9e421294a8781",
+  "sha256": "1jhhnyfgfjv1x0gb59gyj9nvffp5czgqx8zjr4b4m15p7sx8j714"
+}
diff --git a/dep/vessel/default.nix b/dep/vessel/default.nix
new file mode 100644
index 00000000..7a047786
--- /dev/null
+++ b/dep/vessel/default.nix
@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))
diff --git a/dep/vessel/github.json b/dep/vessel/github.json
new file mode 100644
index 00000000..71d0a83f
--- /dev/null
+++ b/dep/vessel/github.json
@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "vessel",
+  "branch": "develop",
+  "rev": "737c25ecfdb73664cf1f995fa3f419185118002c",
+  "sha256": "1svj0vkp59dyf5vskdwyrn75sb5rnhsgfmnanjwhb6j5j04y3nnm"
+}
diff --git a/frontend/Rhyolite/Frontend/App.hs b/frontend/Rhyolite/Frontend/App.hs
index edca28ca..7f785af3 100644
--- a/frontend/Rhyolite/Frontend/App.hs
+++ b/frontend/Rhyolite/Frontend/App.hs
@@ -15,6 +15,7 @@
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -26,32 +27,41 @@ import Control.Monad.Primitive
 import Control.Monad.Reader
 import Control.Monad.Ref
 import Control.Monad.State.Strict
-import Data.Aeson
+import Data.Aeson as Aeson
 import Data.Aeson.Types
 import Data.Bifunctor
 import qualified Data.ByteString.Lazy as LBS
 import Data.Coerce (coerce)
-import Data.Constraint (Dict (..))
+import Data.Constraint.Extras
 import Data.Default (Default)
 import qualified Data.IntMap as IntMap
 import Data.Dependent.Map (DSum (..))
 import qualified Data.Map as Map
 import Data.Semigroup ((<>))
+import Data.Some
 import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import Data.Text.Encoding (decodeUtf8)
 import GHC.Generics (Generic)
 import Obelisk.Route.Frontend (Routed(..), SetRoute(..), RouteToUrl(..))
-import Network.URI (URI)
+import Network.URI (URI, parseURI)
 import qualified Reflex as R
-import Reflex.Dom.Core hiding (MonadWidget, Request)
+import Reflex.Dom.Core hiding (MonadWidget, Request, fmapMaybe)
+import Data.Witherable (Filterable)
 import Reflex.Host.Class
 import Reflex.Time (throttleBatchWithLag)
+import Reflex.FunctorMaybe
 
 import Rhyolite.Api
 import Rhyolite.App
 import Rhyolite.Request.Class
 import Rhyolite.WebSocket
 
+import Obelisk.Configs
+import Obelisk.Route hiding (Decoder)
+import Obelisk.Route.Frontend hiding (Decoder)
+
 #if defined(ghcjs_HOST_OS)
 import GHCJS.DOM.Types (MonadJSM, pFromJSVal)
 #else
@@ -59,54 +69,84 @@ import GHCJS.DOM.Types (MonadJSM(..))
 import Rhyolite.Request.Common (decodeValue')
 #endif
 
-type RhyoliteWidgetInternal app t m = QueryT t (ViewSelector app SelectedCount) (RequesterT t (AppRequest app) Identity m)
+import Data.Vessel
+
+-- | This query morphism translates between un-annotated queries for use over the wire, and ones with SelectedCount annotations used in the frontend to do reference counting, and in the backend to be able to more easily diff. This version is for use with the older Functor style of queries and results.
+functorWireQueryMorphism
+  :: ( Filterable q
+     , Functor v
+     , QueryResult (q ()) ~ v ()
+     , QueryResult (q SelectedCount) ~ v SelectedCount)
+  => QueryMorphism (q SelectedCount) (q ())
+functorWireQueryMorphism = QueryMorphism
+  { _queryMorphism_mapQuery = mapMaybe (\n -> if n == mempty then Nothing else Just ())
+  , _queryMorphism_mapQueryResult = fmap (const (SelectedCount 1))
+  }
+
+-- | This query morphism translates between un-annotated queries for use over the wire, and ones with SelectedCount annotations used in the frontend to do reference counting, and in the backend to be able to more easily diff. This version is for use with the newer-style functor-parametric view types (such as Vessel).
+viewWireQueryMorphism
+  :: ( View v
+     , Monoid (v (Const ()))
+     , QueryResult (v (Const ())) ~ v Identity
+     , QueryResult (v (Const SelectedCount)) ~ v Identity
+     )
+  => QueryMorphism (v (Const SelectedCount)) (v (Const ()))
+viewWireQueryMorphism = QueryMorphism
+  { _queryMorphism_mapQuery = \q -> 
+      let deplete (Const n) = if n == mempty then Nothing else Just (Const ())
+      in case mapMaybeV deplete q of
+            Nothing -> mempty
+            Just q' -> q'
+  , _queryMorphism_mapQueryResult = id
+  }
+
+type RhyoliteWidgetInternal q r t m = QueryT t q (RequesterT t r Identity m)
 
-newtype RhyoliteWidget app t m a = RhyoliteWidget { unRhyoliteWidget :: RhyoliteWidgetInternal app t m a }
+newtype RhyoliteWidget q r t m a = RhyoliteWidget { unRhyoliteWidget :: RhyoliteWidgetInternal q r t m a }
   deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException)
 
-deriving instance (q ~ (ViewSelector app SelectedCount)
-                  , Group (ViewSelector app SelectedCount)
-                  , Additive (ViewSelector app SelectedCount)
-                  , Query (ViewSelector app SelectedCount)
+deriving instance ( Group q
+                  , Additive q
+                  , Query q
                   , Reflex t
                   , Monad m)
-                  => MonadQuery t q (RhyoliteWidget app t m)
+                  => MonadQuery t q (RhyoliteWidget q r t m)
 
 #if !defined(ghcjs_HOST_OS)
-instance MonadJSM m => MonadJSM (RhyoliteWidget app t m) where
+instance MonadJSM m => MonadJSM (RhyoliteWidget q r t m) where
   liftJSM' = lift . liftJSM'
 #endif
 
-instance MonadTrans (RhyoliteWidget app t) where
+instance MonadTrans (RhyoliteWidget q r t) where
   lift = RhyoliteWidget . lift . lift
 
-instance HasJS x m => HasJS x (RhyoliteWidget app t m) where
-  type JSX (RhyoliteWidget app t m) = JSX m
+instance HasJS x m => HasJS x (RhyoliteWidget q r t m) where
+  type JSX (RhyoliteWidget q r t m) = JSX m
   liftJS = lift . liftJS
 
-instance HasDocument m => HasDocument (RhyoliteWidget app t m) where
+instance HasDocument m => HasDocument (RhyoliteWidget q r t m) where
   askDocument = RhyoliteWidget . lift . lift $ askDocument
 
-instance (MonadWidget' t m, PrimMonad m) => Requester t (RhyoliteWidget app t m) where
-  type Request (RhyoliteWidget app t m) = AppRequest app
-  type Response (RhyoliteWidget app t m) = Identity
+instance (MonadWidget' t m, PrimMonad m) => Requester t (RhyoliteWidget q r t m) where
+  type Request (RhyoliteWidget q r t m) = r
+  type Response (RhyoliteWidget q r t m) = Identity
   requesting = RhyoliteWidget . requesting
   requesting_ = RhyoliteWidget . requesting_
 
-instance PerformEvent t m => PerformEvent t (RhyoliteWidget app t m) where
-  type Performable (RhyoliteWidget app t m) = Performable m
+instance PerformEvent t m => PerformEvent t (RhyoliteWidget q r t m) where
+  type Performable (RhyoliteWidget q r t m) = Performable m
   performEvent_ = lift . performEvent_
   performEvent = lift . performEvent
 
-instance TriggerEvent t m => TriggerEvent t (RhyoliteWidget app t m) where
+instance TriggerEvent t m => TriggerEvent t (RhyoliteWidget q r t m) where
   newTriggerEvent = lift newTriggerEvent
   newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete
   newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete
 
-instance NotReady t m => NotReady t (RhyoliteWidget app t m)
+instance NotReady t m => NotReady t (RhyoliteWidget q r t m)
 
-instance (HasView app, DomBuilder t m, MonadHold t m, Ref (Performable m) ~ Ref m, MonadFix m, Group (ViewSelector app SelectedCount), Additive (ViewSelector app SelectedCount)) => DomBuilder t (RhyoliteWidget app t m) where
-  type DomBuilderSpace (RhyoliteWidget app t m) = DomBuilderSpace m
+instance (DomBuilder t m, MonadHold t m, Ref (Performable m) ~ Ref m, MonadFix m, Group q, Additive q, Eq q, Query q) => DomBuilder t (RhyoliteWidget q r t m) where
+  type DomBuilderSpace (RhyoliteWidget q r t m) = DomBuilderSpace m
   textNode = liftTextNode
   element elementTag cfg (RhyoliteWidget child) = RhyoliteWidget $ element elementTag cfg child
   inputElement = RhyoliteWidget . inputElement
@@ -115,66 +155,66 @@ instance (HasView app, DomBuilder t m, MonadHold t m, Ref (Performable m) ~ Ref
   placeRawElement = RhyoliteWidget . placeRawElement
   wrapRawElement e = RhyoliteWidget . wrapRawElement e
 
-instance (Reflex t, MonadFix m, MonadHold t m, Adjustable t m, Eq (ViewSelector app SelectedCount), Group (ViewSelector app SelectedCount), Additive (ViewSelector app SelectedCount), Query (ViewSelector app SelectedCount)) => Adjustable t (RhyoliteWidget app t m) where
+instance (Reflex t, MonadFix m, MonadHold t m, Adjustable t m, Eq q, Group q, Additive q, Query q) => Adjustable t (RhyoliteWidget q r t m) where
   runWithReplace a0 a' = RhyoliteWidget $ runWithReplace (coerce a0) (coerceEvent a')
   traverseDMapWithKeyWithAdjust f dm0 dm' = RhyoliteWidget $ traverseDMapWithKeyWithAdjust (\k v -> unRhyoliteWidget $ f k v) (coerce dm0) (coerceEvent dm')
   traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RhyoliteWidget $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRhyoliteWidget $ f k v) (coerce dm0) (coerceEvent dm')
   traverseIntMapWithKeyWithAdjust f dm0 dm' = RhyoliteWidget $ traverseIntMapWithKeyWithAdjust (\k v -> unRhyoliteWidget $ f k v) (coerce dm0) (coerceEvent dm')
 
-instance PostBuild t m => PostBuild t (RhyoliteWidget app t m) where
+instance PostBuild t m => PostBuild t (RhyoliteWidget q r t m) where
   getPostBuild = lift getPostBuild
 
-instance MonadRef m => MonadRef (RhyoliteWidget app t m) where
-  type Ref (RhyoliteWidget app t m) = Ref m
+instance MonadRef m => MonadRef (RhyoliteWidget q r t m) where
+  type Ref (RhyoliteWidget q r t m) = Ref m
   newRef = RhyoliteWidget . newRef
   readRef = RhyoliteWidget . readRef
   writeRef r = RhyoliteWidget . writeRef r
 
-instance MonadHold t m => MonadHold t (RhyoliteWidget app t m) where
+instance MonadHold t m => MonadHold t (RhyoliteWidget q r t m) where
   hold a = RhyoliteWidget . hold a
   holdDyn a = RhyoliteWidget . holdDyn a
   holdIncremental a = RhyoliteWidget . holdIncremental a
   buildDynamic a = RhyoliteWidget . buildDynamic a
   headE = RhyoliteWidget . headE
 
-instance MonadSample t m => MonadSample t (RhyoliteWidget app t m) where
+instance MonadSample t m => MonadSample t (RhyoliteWidget q r t m) where
   sample = RhyoliteWidget . sample
 
-instance HasJSContext m => HasJSContext (RhyoliteWidget app t m) where
-  type JSContextPhantom (RhyoliteWidget app t m) = JSContextPhantom m
+instance HasJSContext m => HasJSContext (RhyoliteWidget q r t m) where
+  type JSContextPhantom (RhyoliteWidget q r t m) = JSContextPhantom m
   askJSContext = RhyoliteWidget askJSContext
 
-instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RhyoliteWidget app t m) where
+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RhyoliteWidget q r t m) where
   newEventWithTrigger = RhyoliteWidget . newEventWithTrigger
   newFanEventWithTrigger a = RhyoliteWidget . lift $ newFanEventWithTrigger a
 
-instance (Monad m, Routed t r m) => Routed t r (RhyoliteWidget app t m) where
+instance (Monad m, Routed t route m) => Routed t route (RhyoliteWidget q r t m) where
   askRoute = lift askRoute
 
-instance (Monad m, SetRoute t r m) => SetRoute t r (RhyoliteWidget app t m) where
+instance (Monad m, SetRoute t route m) => SetRoute t route (RhyoliteWidget q r t m) where
   modifyRoute = lift . modifyRoute
 
-instance (Monad m, RouteToUrl r m) => RouteToUrl r (RhyoliteWidget app t m) where
+instance (Monad m, RouteToUrl route m) => RouteToUrl route (RhyoliteWidget q r t m) where
   askRouteToUrl = lift askRouteToUrl
 
 deriving instance ( Reflex t
                   , Prerender js t m
                   , MonadFix m
-                  , Eq (ViewSelector app SelectedCount)
-                  , Group (ViewSelector app SelectedCount)
-                  , Additive (ViewSelector app SelectedCount)
-                  , Query (ViewSelector app SelectedCount)
-                  ) => Prerender js t (RhyoliteWidget app t m)
-
-instance PrimMonad m => PrimMonad (RhyoliteWidget app t m) where
-  type PrimState (RhyoliteWidget app t m) = PrimState m
+                  , Eq q
+                  , Group q
+                  , Additive q
+                  , Query q
+                  ) => Prerender js t (RhyoliteWidget q r t m)
+
+instance PrimMonad m => PrimMonad (RhyoliteWidget q r t m) where
+  type PrimState (RhyoliteWidget q r t m) = PrimState m
   primitive = lift . primitive
 
-deriving instance DomRenderHook t m => DomRenderHook t (RhyoliteWidget app t m)
+deriving instance DomRenderHook t m => DomRenderHook t (RhyoliteWidget q r t m)
 
 -- | This synonym adds constraints to MonadRhyoliteWidget that are only available on the frontend, and not via backend rendering.
-type MonadRhyoliteFrontendWidget app t m =
-    ( MonadRhyoliteWidget app t m
+type MonadRhyoliteFrontendWidget q r t m =
+    ( MonadRhyoliteWidget q r t m
     , DomBuilderSpace m ~ GhcjsDomSpace
     , MonadIO m
     , MonadIO (Performable m)
@@ -182,25 +222,21 @@ type MonadRhyoliteFrontendWidget app t m =
 
 class ( MonadWidget' t m
       , Requester t m
-      , R.Request m ~ AppRequest app
+      , R.Request m ~ r
       , Response m ~ Identity
-      , HasRequest app
-      , HasView app
-      , Group (ViewSelector app SelectedCount)
-      , Additive (ViewSelector app SelectedCount)
-      , MonadQuery t (ViewSelector app SelectedCount) m
-      ) => MonadRhyoliteWidget app t m | m -> app t where
+      , Group q
+      , Additive q
+      , MonadQuery t q m
+      ) => MonadRhyoliteWidget q r t m | m -> q r where
 
 instance ( MonadWidget' t m
          , Requester t m
-         , R.Request m ~ AppRequest app
+         , R.Request m ~ r
          , Response m ~ Identity
-         , HasRequest app
-         , HasView app
-         , Group (ViewSelector app SelectedCount)
-         , Additive (ViewSelector app SelectedCount)
-         , MonadQuery t (ViewSelector app SelectedCount) m
-         ) => MonadRhyoliteWidget app t m
+         , Group q
+         , Additive q
+         , MonadQuery t q m
+         ) => MonadRhyoliteWidget q r t m
 
 queryDynUniq :: ( Monad m
                 , Reflex t
@@ -246,69 +282,108 @@ type MonadWidget' t m =
   , Ref (Performable m) ~ Ref IO
   )
 
+runObeliskRhyoliteWidget ::
+  ( PerformEvent t m
+  , TriggerEvent t m
+  , PostBuild t m
+  , MonadHold t m
+  , MonadFix m
+  , Prerender x t m
+  , HasConfigs m
+  , Request req
+  , Query qFrontend
+  , Group qFrontend
+  , Additive qFrontend
+  , Eq qFrontend
+  , Monoid (QueryResult qFrontend)
+  , FromJSON (QueryResult qWire)
+  , ToJSON qWire
+  , DiffQuery qWire
+  )
+  => QueryMorphism qFrontend qWire
+  -> Text -- ^ Typically "config/route", config file containing an http/https URL at which the backend will be served.
+  -> Encoder Identity Identity (R (FullRoute backendRoute frontendRoute)) PageName -- ^ Checked route encoder
+  -> R backendRoute -- ^ The "listen" backend route which is handled by the action produced by 'serveDbOverWebsockets'
+  -> RoutedT t (R frontendRoute) (RhyoliteWidget qFrontend req t m) a -- ^ Child widget
+  -> RoutedT t (R frontendRoute) m a
+runObeliskRhyoliteWidget toWire configRoute enc listenRoute child = do
+  obR <- askRoute
+  Just (Just route) <- fmap (parseURI . T.unpack . T.strip . T.decodeUtf8) <$> getConfig configRoute
+  let wsUrl = (T.pack $ show $ websocketUri route) <> (renderBackendRoute enc $ listenRoute)
+  lift $ runPrerenderedRhyoliteWidget toWire wsUrl $ flip runRoutedT obR $ child
+
 runPrerenderedRhyoliteWidget
-   :: forall app m t b x.
-      ( QueryResult (ViewSelector app SelectedCount) ~ View app SelectedCount
-      , HasView app
-      , HasRequest app
-      , Eq (ViewSelector app SelectedCount)
-      , PerformEvent t m
+   :: forall qFrontend qWire req m t b x.
+      ( PerformEvent t m
       , TriggerEvent t m
-      , PostBuild t m, MonadHold t m
+      , PostBuild t m
+      , MonadHold t m
       , MonadFix m
       , Prerender x t m
+      , Request req
+      , Query qFrontend
+      , Group qFrontend
+      , Additive qFrontend
+      , Eq qFrontend
+      , Monoid (QueryResult qFrontend)
+      , FromJSON (QueryResult qWire)
+      , ToJSON qWire
+      , DiffQuery qWire
       )
-   => Text
-   -> RhyoliteWidget app t m b
+   => QueryMorphism qFrontend qWire
+   -> Text
+   -> RhyoliteWidget qFrontend req t m b
    -> m b
-runPrerenderedRhyoliteWidget url child = do
-  rec (notification :: Event t (View app ()), response) <- fmap (bimap (switch . current) (switch . current) . splitDynPure) $
+runPrerenderedRhyoliteWidget toWire url child = do
+  rec (notification :: Event t (QueryResult qWire), response) <- fmap (bimap (switch . current) (switch . current) . splitDynPure) $
         prerender (return (never, never)) $ do
-          appWebSocket :: AppWebSocket t app <- openWebSocket' url request'' $ fmapMaybe (\c -> if c == mempty then Nothing else Just ()) <$> nubbedVs
+          (appWebSocket :: AppWebSocket t q) <- openWebSocket' url request'' $ _queryMorphism_mapQuery toWire <$> nubbedVs
           return ( _appWebSocket_notification appWebSocket
                  , _appWebSocket_response appWebSocket
                  )
       (request', response') <- identifyTags request $ ffor response $ \(TaggedResponse t v) -> (t, v)
       let request'' = fmap (fmapMaybe (\(t, v) -> case fromJSON v of
-            Success (v' :: (SomeRequest (AppRequest app))) -> Just $ TaggedRequest t v'
+            Success (v' :: (Some req)) -> Just $ TaggedRequest t v'
             _ -> Nothing)) request'
       ((a, vs), request) <- flip runRequesterT response' $ runQueryT (unRhyoliteWidget child) view
-      nubbedVs :: Dynamic t (ViewSelector app SelectedCount) <- holdUniqDyn $ incrementalToDynamic (vs :: Incremental t (AdditivePatch (ViewSelector app SelectedCount)))
-      view <- fmap join $ prerender (pure mempty) $ fromNotifications nubbedVs $ fmap (\_ -> SelectedCount 1) <$> notification
+      (nubbedVs :: Dynamic t qFrontend) <- holdUniqDyn $ incrementalToDynamic (vs :: Incremental t (AdditivePatch qFrontend))
+      view <- fmap join $ prerender (pure mempty) $ fromNotifications nubbedVs $ _queryMorphism_mapQueryResult toWire <$> notification
   return a
 
+{-
 runRhyoliteWidget
-   :: forall app m t b x.
-      ( QueryResult (ViewSelector app SelectedCount) ~ View app SelectedCount
-      , HasView app
-      , HasRequest app
-      , Eq (ViewSelector app SelectedCount)
-      , HasJS x m, HasJSContext m, PerformEvent t m
+   :: forall qFrontend qWire req m t b x.
+      ( HasJS x m, HasJSContext m, PerformEvent t m
       , TriggerEvent t m
       , PostBuild t m, MonadHold t m, MonadJSM (Performable m), MonadJSM m
       , MonadFix m
       , MonadIO (Performable m)
+      , Group qFrontend
+      , Additive qFrontend
       )
-   => Text
-   -> RhyoliteWidget app t m b
-   -> m (AppWebSocket t app, b)
-runRhyoliteWidget url child = do
-  rec appWebSocket <- openWebSocket' url request'' $ fmapMaybe (\c -> if c == mempty then Nothing else Just ()) <$> nubbedVs
+   => QueryMorphism qFrontend qWire
+   -> Text
+   -> RhyoliteWidget qFrontend req t m b
+   -> m (AppWebSocket t qWire, b)
+runRhyoliteWidget toWire url child = do
+  rec appWebSocket <- openWebSocket' url request'' $ _queryMorphism_query toWire <$> nubbedVs
       let notification = _appWebSocket_notification appWebSocket
           response = _appWebSocket_response appWebSocket
       (request', response') <- identifyTags request $ ffor response $ \(TaggedResponse t v) -> (t, v)
       let request'' = fmap (fmapMaybe (\(t, v) -> case fromJSON v of
-            Success (v' :: (SomeRequest (AppRequest app))) -> Just $ TaggedRequest t v'
+            Success (v' :: (Some req)) -> Just $ TaggedRequest t v'
             _ -> Nothing)) request'
       ((a, vs), request) <- flip runRequesterT response' $ runQueryT (unRhyoliteWidget child) view
-      nubbedVs :: Dynamic t (ViewSelector app SelectedCount) <- holdUniqDyn $ incrementalToDynamic (vs :: Incremental t (AdditivePatch (ViewSelector app SelectedCount)))
-      view <- fromNotifications nubbedVs $ fmap (\_ -> SelectedCount 1) <$> notification
+      (nubbedVs :: Dynamic t q) <- holdUniqDyn $ incrementalToDynamic (vs :: Incremental t (AdditivePatch qFrontend))
+      view <- fromNotifications nubbedVs $ _queryMorphism_queryResult <$> notification
   return (appWebSocket, a)
+-}
 
-fromNotifications :: forall m (t :: *) vs. (Query vs, MonadHold t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), Reflex t, MonadFix m, Monoid (QueryResult vs))
-                  => Dynamic t vs
-                  -> Event t (QueryResult vs)
-                  -> m (Dynamic t (QueryResult vs))
+fromNotifications
+  :: forall m (t :: *) q. (Query q, MonadHold t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), Reflex t, MonadFix m, Monoid (QueryResult q))
+  => Dynamic t q
+  -> Event t (QueryResult q)
+  -> m (Dynamic t (QueryResult q))
 fromNotifications vs ePatch = do
   ePatchThrottled <- throttleBatchWithLag lag ePatch
   foldDyn (\(vs', p) v -> cropView vs' $ p <> v) mempty $ attach (current vs) ePatchThrottled
@@ -325,8 +400,8 @@ identifyTags
      , Request v
      )
   => Event t (RequesterData v)
-  -> Event t (Data.Aeson.Value, Data.Aeson.Value)
-  -> m ( Event t [(Data.Aeson.Value, Data.Aeson.Value)]
+  -> Event t (Aeson.Value, Aeson.Value)
+  -> m ( Event t [(Aeson.Value, Aeson.Value)]
        , Event t (RequesterData Identity)
        )
 identifyTags send recv = do
@@ -341,9 +416,8 @@ identifyTags send recv = do
                   n <- get
                   put $ succ n
                   return (n, k :=> v)
-                patchWaitingFor = PatchMap $ Map.fromList $ ffor result $ \(n, k :=> v) -> case requestResponseFromJSON v of
-                  Dict -> (n, Just (Decoder k))
-                toSend = ffor result $ \(n, _ :=> v) -> (toJSON n, requestToJSON v)
+                patchWaitingFor = PatchMap $ Map.fromList $ ffor result $ \(n, k :=> v) -> has @FromJSON v (n, Just (Decoder k))
+                toSend = ffor result $ \(n, _ :=> (v :: v a)) -> (toJSON n, whichever @ToJSON @v @a (toJSON v))
             return (newNextId, patchWaitingFor, toSend)
       let recv' = flip push recv $ \(jsonN, jsonV) -> do
             wf <- sample $ currentIncremental waitingFor
@@ -357,31 +431,34 @@ identifyTags send recv = do
                   Nothing -> Nothing
   return (fmap (\(_, _, c) -> c) send', fst <$> recv')
 
-data AppWebSocket t app = AppWebSocket
-  { _appWebSocket_notification :: Event t (View app ())
+data AppWebSocket t q = AppWebSocket
+  { _appWebSocket_notification :: Event t (QueryResult q)
   , _appWebSocket_response :: Event t TaggedResponse
   , _appWebSocket_version :: Event t Text
   , _appWebSocket_connected :: Dynamic t Bool
   }
 
 -- | Open a websocket connection and split resulting incoming traffic into listen notification and api response channels
-openWebSocket' :: forall app t x m.
-                 ( MonadJSM m
-                 , MonadJSM (Performable m)
-                 , PostBuild t m
-                 , TriggerEvent t m
-                 , PerformEvent t m
-                 , HasJSContext m
-                 , HasJS x m
-                 , MonadFix m
-                 , MonadHold t m
-                 , HasView app
-                 , HasRequest app
-                 )
-              => Text -- ^ A complete URL
-              -> Event t [TaggedRequest (AppRequest app)] -- ^ Outbound requests
-              -> Dynamic t (ViewSelector app ()) -- ^ Authenticated listen requests (e.g., ViewSelector updates)
-              -> m (AppWebSocket t app)
+openWebSocket' 
+  :: forall r q t x m.
+     ( MonadJSM m
+     , MonadJSM (Performable m)
+     , PostBuild t m
+     , TriggerEvent t m
+     , PerformEvent t m
+     , HasJSContext m
+     , HasJS x m
+     , MonadFix m
+     , MonadHold t m
+     , FromJSON (QueryResult q)
+     , ToJSON q
+     , DiffQuery q
+     , Request r
+     )
+  => Text -- ^ A complete URL
+  -> Event t [TaggedRequest r] -- ^ Outbound requests
+  -> Dynamic t q -- ^ Authenticated listen requests (e.g., ViewSelector updates)
+  -> m (AppWebSocket t q)
 openWebSocket' url request vs = do
 #if defined(ghcjs_HOST_OS)
   rec let platformDecode = jsonDecode . pFromJSVal
@@ -391,12 +468,15 @@ openWebSocket' url request vs = do
   rec let platformDecode = decodeValue' . LBS.fromStrict
       ws <- webSocket url $ def
 #endif
-        & webSocketConfig_send .~ fmap (map (decodeUtf8 . LBS.toStrict . encode)) (mconcat
+        & webSocketConfig_send .~ fmap (map (decodeUtf8 . LBS.toStrict . Aeson.encode)) (mconcat
           [ fmap (map WebSocketRequest_Api) request
-          , fmap ((:[]) . WebSocketRequest_ViewSelector) $ updated vs :: Event t [WebSocketRequest app (AppRequest app)]
+          , fmap ((:[]) . WebSocketRequest_ViewSelector) $ updated vs :: Event t [WebSocketRequest q r]
+          -- NB: It's tempting to try to only send query diffs here, but this must be treated
+          -- with care, since the backend needs to know when we cease being interested in things
+          -- so that it knows not to send further notifications.
           , tag (fmap ((:[]) . WebSocketRequest_ViewSelector) $ current vs) $ _webSocket_open ws
           ])
-  let (eMessages :: Event t (WebSocketResponse app)) = fmapMaybe platformDecode $ _webSocket_recv ws
+  let (eMessages :: Event t (WebSocketResponse q)) = fmapMaybe platformDecode $ _webSocket_recv ws
       notification = fforMaybe eMessages $ \case
         WebSocketResponse_View v -> Just v
         _ -> Nothing
@@ -414,25 +494,28 @@ openWebSocket' url request vs = do
     , _appWebSocket_connected = connected
     }
 
-openWebSocket :: forall t x m app.
-                 ( MonadJSM m
-                 , MonadJSM (Performable m)
-                 , PostBuild t m
-                 , TriggerEvent t m
-                 , PerformEvent t m
-                 , HasJSContext m
-                 , HasJS x m
-                 , MonadFix m
-                 , MonadHold t m
-                 , HasRequest app
-                 , HasView app
-                 )
-              => Text -- ^ A complete URL
-              -> Event t [TaggedRequest (AppRequest app)] -- ^ Outbound requests
-              -> Dynamic t (ViewSelector app ()) -- ^ current ViewSelector
-              -> m ( Event t (View app ())
-                   , Event t TaggedResponse
-                   )
+openWebSocket 
+  :: forall t x m r q.
+     ( MonadJSM m
+     , MonadJSM (Performable m)
+     , PostBuild t m
+     , TriggerEvent t m
+     , PerformEvent t m
+     , HasJSContext m
+     , HasJS x m
+     , MonadFix m
+     , MonadHold t m
+     , Request r
+     , FromJSON (QueryResult q)
+     , ToJSON q
+     , DiffQuery q
+     )
+  => Text -- ^ A complete URL
+  -> Event t [TaggedRequest r] -- ^ Outbound requests
+  -> Dynamic t q -- ^ current ViewSelector
+  -> m ( Event t (QueryResult q)
+       , Event t TaggedResponse
+       )
 openWebSocket murl request vs = do
   aws <- openWebSocket' murl request vs
   return (_appWebSocket_notification aws, _appWebSocket_response aws)
@@ -464,23 +547,23 @@ instance Default FrontendConfig where
 -- the @k@ would be '()'. At top level, this the '()'s would be replaced by a 'QueryMorphism' with the actual credential to
 -- be sent to the backend.
 mapAuth
-  :: forall app a f t m.
+  :: forall publicRequest privateRequest q q' a cred t m.
      ( MonadFix m
      , PostBuild t m
-     , Query (ViewSelector app SelectedCount)
-     , Group (ViewSelector app SelectedCount)
-     , Additive (ViewSelector app SelectedCount)
-     , Group (f SelectedCount)
-     , Additive (f SelectedCount)
+     , Query q
+     , Group q
+     , Additive q
+     , Group q'
+     , Additive q'
      )
-  => AppCredential app
+  => cred
   -- ^ The application's authentication token, used to transform api calls made by the authenticated child widget
-  -> QueryMorphism (f SelectedCount) (ViewSelector app SelectedCount)
+  -> QueryMorphism q' q
     -- ^ A morphism from a query type supplied by the user, "f", that represents queries made by authenticated widgets, to a the query
     -- type of the application as a whole (which may have authenticated and public components)
-  -> QueryT t (f SelectedCount) (RequesterT t (ApiRequest () (PublicRequest app) (PrivateRequest app)) Identity m) a
+  -> QueryT t q' ((RequesterT t (ApiRequest () publicRequest privateRequest)) Identity m) a
   -- ^ The authenticated child widget. It uses '()' as its credential for private requests
-  -> RhyoliteWidget app t m a
+  -> RhyoliteWidget q (ApiRequest cred publicRequest privateRequest) t m a
 mapAuth token authorizeQuery authenticatedChild = RhyoliteWidget $ do
   v <- askQueryResult
   (a, vs) <- lift $ mapRequesterT authorizeReq id $ runQueryT (withQueryT authorizeQuery authenticatedChild) v
@@ -489,8 +572,8 @@ mapAuth token authorizeQuery authenticatedChild = RhyoliteWidget $ do
   return a
   where
     authorizeReq
-      :: forall x. ApiRequest () (PublicRequest app) (PrivateRequest app) x
-      -> ApiRequest (AppCredential app) (PublicRequest app) (PrivateRequest app) x
+      :: forall x. ApiRequest () publicRequest privateRequest x
+      -> ApiRequest cred publicRequest privateRequest x
     authorizeReq = \case
       ApiRequest_Public a -> ApiRequest_Public a
       ApiRequest_Private () a -> ApiRequest_Private token a
diff --git a/frontend/Rhyolite/Frontend/Cookie.hs b/frontend/Rhyolite/Frontend/Cookie.hs
index 72907061..3ed968af 100644
--- a/frontend/Rhyolite/Frontend/Cookie.hs
+++ b/frontend/Rhyolite/Frontend/Cookie.hs
@@ -26,6 +26,14 @@ setPermanentCookie :: (MonadJSM m, HasJSContext m) => DOM.Document -> SetCookie
 setPermanentCookie doc cookie = do
   DOM.setCookie doc $ decodeUtf8 $ LBS.toStrict $ toLazyByteString $ renderSetCookie cookie
 
+-- | Set or clear the given cookie with given expiration date
+--
+-- Example:
+-- > setExpiringCookie time doc =<< defaultCookie "key" (Just "value")
+setExpiringCookie :: (MonadJSM m, HasJSContext m) => UTCTime -> DOM.Document -> SetCookie -> m ()
+setExpiringCookie timestamp doc cookie = do
+  DOM.setCookie doc $ decodeUtf8 $ LBS.toStrict $ toLazyByteString $ renderSetCookie cookie {setCookieExpires = Just timestamp}
+
 -- | Make a cookie with sensible defaults
 defaultCookie
   :: (MonadJSM m, HasJSContext m)  -- TODO: verify
diff --git a/frontend/Rhyolite/Frontend/Form.hs b/frontend/Rhyolite/Frontend/Form.hs
index f7e81190..32b9097b 100644
--- a/frontend/Rhyolite/Frontend/Form.hs
+++ b/frontend/Rhyolite/Frontend/Form.hs
@@ -9,6 +9,8 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Rhyolite.Frontend.Form where
 
 import Control.Lens ((%~), makeLenses, preview)
@@ -101,7 +103,7 @@ manageValidity
      , Prerender js t m, RawInputElement (DomBuilderSpace m) ~ HTMLInputElement
      )
   => Event t () -- When to validate
-  -> (Dynamic t Text -> DynValidation t e a) -- Validation
+  -> (Dynamic t Text -> m (DynValidation t e a)) -- Validation
   -> (e -> Text) -- convert error to form for basic html validation
   -> m (InputElement EventResult (DomBuilderSpace m) t) -- Render input
   -> m (InputElement EventResult (DomBuilderSpace m) t, DynValidation t e a)
@@ -119,12 +121,13 @@ manageValidity validate' validator errorText renderInput = do
 
 manageValidation
   :: (DomBuilder t m, MonadHold t m)
-  => (Dynamic t Text -> DynValidation t e a) -- Validation
+  => (Dynamic t Text -> m (DynValidation t e a)) -- Validation
   -> m (InputElement EventResult (DomBuilderSpace m) t) -- Render input
   -> m (InputElement EventResult (DomBuilderSpace m) t, DynValidation t e a)
 manageValidation validator renderInput = do
   input <- renderInput
-  return (input, validator $ value input)
+  validated <- validator $ value input
+  return (input, validated)
 
 guardEither :: e -> Bool -> Either e ()
 guardEither e cond = if cond then Right () else Left e
@@ -159,6 +162,10 @@ data ValidationConfig t m e a = ValidationConfig
   -- ^ Input is always being reevaluated, including when external dynamics
   -- "mixed in" with this change. But rather than pushing changes downstream,
   -- downstream needed to ask for them (poll) with the 'validate' field.
+  , _validationConfig_validationM :: Maybe (Dynamic t Text -> m (DynValidation t e a))
+  -- ^ This validation allows for the use of monadic effects (e.g. ask a
+  -- server). The results of `_validationConfig_validatation` and
+  -- `_validationConfig_validationM` will be combined by `*>`.
   , _validationConfig_initialAttributes :: Map AttributeName Text
   , _validationConfig_validAttributes :: Map AttributeName Text
   , _validationConfig_invalidAttributes :: Map AttributeName Text
@@ -174,6 +181,7 @@ defValidationConfig = ValidationConfig
   { _validationConfig_feedback = const blank
   , _validationConfig_errorText = id
   , _validationConfig_validation = const $ toDynValidation $ pure $ Left "Validation not configured"
+  , _validationConfig_validationM = Nothing
   , _validationConfig_initialAttributes = mempty
   , _validationConfig_validAttributes = mempty
   , _validationConfig_invalidAttributes = mempty
@@ -196,7 +204,7 @@ instance Reflex t => HasDomEvent t (ValidationInput t m e a) en where
   domEvent en = domEvent en . _validationInput_input
 
 validationInput
-  :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m)
+  :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m, Semigroup e)
   => ValidationConfig t m e a
   -> m (ValidationInput t m e a)
 validationInput config = do
@@ -205,23 +213,39 @@ validationInput config = do
   return vi
 
 validationInputWithFeedback
-  :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m)
+  :: forall t m e a
+  .  ( DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m
+     , Semigroup e , Reflex t
+     )
   => ValidationConfig t m e a
   -> m (ValidationInput t m e a, m ())
 validationInputWithFeedback config = do
-  let validation' = _validationConfig_validate config
-  rec (input, dValidated) <- manageValidation (_validationConfig_validation config) $ do
-        inputElement $ def
-          & initialAttributes .~ _validationConfig_initialAttributes config
-          & modifyAttributes .~ inputAttrs
-          & inputElementConfig_initialValue .~ _validationConfig_initialValue config
-          & inputElementConfig_setValue %~ maybe id const (_validationConfig_setValue config)
-      let eValidated = tagPromptlyDyn (fromDynValidation dValidated) validation'
-          inputAttrs = ffor eValidated $ \case
-            Left _ -> fmap Just $ _validationConfig_invalidAttributes config
-            Right _ -> fmap Just $ _validationConfig_validAttributes config
-  val <- eitherDyn $ fromDynValidation dValidated
-  let feedback = dyn_ $ _validationConfig_feedback config <$> val
-  return $ (ValidationInput input dValidated, feedback)
+    let validateL = _validationConfig_validate config
+        validationL = combineValidators
+          (_validationConfig_validation config) (_validationConfig_validationM config)
+    rec (input, dValidated) <- manageValidation validationL $ do
+          inputElement $ def
+            & initialAttributes .~ _validationConfig_initialAttributes config
+            & modifyAttributes .~ inputAttrs
+            & inputElementConfig_initialValue .~ _validationConfig_initialValue config
+            & inputElementConfig_setValue %~ maybe id const (_validationConfig_setValue config)
+        let eValidated = tagPromptlyDyn (fromDynValidation dValidated) validateL
+            inputAttrs = ffor eValidated $ \case
+              Left _ -> fmap Just $ _validationConfig_invalidAttributes config
+              Right _ -> fmap Just $ _validationConfig_validAttributes config
+    val <- eitherDyn $ fromDynValidation dValidated
+    let feedback = dyn_ $ _validationConfig_feedback config <$> val
+    return $ (ValidationInput input dValidated, feedback)
+  where
+    combineValidators
+      :: (Dynamic t Text -> DynValidation t e a)
+      -> Maybe (Dynamic t Text -> m (DynValidation t e a))
+      -> Dynamic t Text -> m (DynValidation t e a)
+    combineValidators pValidator mValidator t =
+      case mValidator of
+        Nothing -> pure $ pValidator t
+        Just mv -> do
+          r <- mv t
+          pure (pValidator t *> r)
 
 makeLenses ''ValidationConfig
diff --git a/frontend/Rhyolite/Frontend/Widget.hs b/frontend/Rhyolite/Frontend/Widget.hs
index 092ffdfb..739d64e3 100644
--- a/frontend/Rhyolite/Frontend/Widget.hs
+++ b/frontend/Rhyolite/Frontend/Widget.hs
@@ -1,9 +1,13 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Rhyolite.Frontend.Widget where
 
 import Control.Monad.Fix
+import Data.Either.Combinators (rightToMaybe)
 import Data.Map (Map)
+import Data.Text (Text)
 import qualified Data.Map as Map
 import Reflex.Dom.Core hiding (Delete)
 
@@ -78,3 +82,25 @@ extensibleListWidgetWithSize n x0 xs0 addAtEnd itemWidget = do
           valuesMapD = joinDynThroughMap $ fmap (fmap snd) $ resultMapD
           valuesD = fmap Map.elems valuesMapD
   return valuesD
+
+-- | Widget used as a modal div for widgets that want to take some action when clicked anywhere but itself, such as dropdown widgets or the like.
+  -- The first argument is a CSS class name, the suggested CSS class styling for use of this widget is as follows:
+  -- position: fixed;
+  -- top: 0;
+  -- bottom: 0;
+  -- right: 0;
+  -- left: 0;
+  -- z-index: 100;
+withBackdrop :: forall m t a. (DomBuilder t m, MonadFix m, MonadHold t m) => Text -> Event t (m (Event t a)) -> m (Event t a)
+withBackdrop cls openBackdropWithChild = mdo
+  sth <- widgetHold (return never) $ ffor (leftmost [close, open]) $ \case
+    Nothing -> return never
+    Just child -> do
+      (backgroundEl, _) <- elClass' "div" cls blank
+      childResult <- child
+      let backgroundEvent = domEvent Click backgroundEl
+      return $ leftmost [Left <$> backgroundEvent, Right <$> childResult]
+  let close :: Event t (Maybe (m (Event t a))) = Nothing <$ (switch . current $ sth)
+      open :: Event t (Maybe (m (Event t a))) = Just <$> openBackdropWithChild
+  return $ fmapMaybe rightToMaybe $ switch . current $ sth
+
diff --git a/frontend/rhyolite-frontend.cabal b/frontend/rhyolite-frontend.cabal
index 63f13f37..414ae67c 100644
--- a/frontend/rhyolite-frontend.cabal
+++ b/frontend/rhyolite-frontend.cabal
@@ -22,11 +22,13 @@ library
     , binary
     , bytestring
     , constraints
+    , constraints-extras
     , containers
     , cookie
     , data-default
     , dependent-map
     , dependent-sum
+    , either
     , exception-transformers
     , filepath
     , font-awesome-type
@@ -39,6 +41,7 @@ library
     , mtl
     , network-uri
     , obelisk-route
+    , obelisk-executable-config-lookup
     , prim-uniq
     , primitive
     , raw-strings-qq
@@ -57,6 +60,7 @@ library
     , transformers
     , transformers-base
     , vector
+    , vessel
     , validation
     , witherable >= 0.2 && < 0.4