diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for roboservant
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2020
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,84 @@
+# roboservant
+
+Automatically fuzz your servant apis in a contextually-aware way.
+
+![CI](https://github.com/mwotton/roboservant/workflows/CI/badge.svg)
+
+
+# why?
+
+Servant gives us a lot of information about what a server can do. We
+use this information to generate arbitrarily long request/response
+sessions and verify properties that should hold over them.
+
+# example
+
+Our api under test:
+
+```
+newtype Foo = Foo Int
+  deriving (Generic, Eq, Show, Typeable)
+  deriving newtype (FromHttpApiData, ToHttpApiData)
+
+type FooApi =
+  "item" :> Get '[JSON] Foo
+    :<|> "itemAdd" :> Capture "one" Foo :> Capture "two" Foo :> Get '[JSON] Foo
+    :<|> "item" :> Capture "itemId" Foo :> Get '[JSON] ()
+```
+
+From the tests:
+
+```
+  let reifiedApi = RS.toReifiedApi (RS.flattenServer @Foo.FooApi Foo.fooServer) (Proxy @(Endpoints Foo.FooApi))
+  assert "should find an error in Foo" . not
+    =<< checkSequential (Group "Foo" [("Foo", RS.prop_sequential reifiedApi)])
+```
+
+We have a server that blows up if the value of the int in a `Foo` ever gets above 10. Note:
+there is no generator for `Foo` types: larger `Foo`s can only be made only by combining existing
+`Foo`s with `itemAdd`. This is an important distinction, because many APIs will return UUIDs or
+similar as keys, which make it impossible to cover a useful section of the state space without
+using the values returned by the API
+
+
+# why not servant-quickcheck?
+
+[servant-quickcheck](https://hackage.haskell.org/package/servant-quickcheck)
+is a great package and I've learned a lot from it. Unfortunately, as mentioned previously,
+there's a lot of the state space you just can't explore without context: modern webapps are
+full of pointer-like structures, whether they're URLs or database
+keys/uuids, and servant-quickcheck requires that you be able to generate
+these without context via Arbitrary.
+
+## extensions/todo
+
+- add some "starter" values to the store
+  - there may be a JWT that's established outside the servant app, for instance.
+- `class Extras a where extras :: Gen [a]`
+  - default implementation `pure []`
+  - selectively allow some types to create values we haven't seen from the api.
+	`newtype FirstName = FirstName Text`, say.
+- break down each response type into its components
+  - if i have
+	- `data Foo = FBar Bar | FBaz Baz`
+	- an endpoint `foo` that returns a `Foo`
+	- and an endpoint `bar` that takes a `Bar`
+  - I should be able to call `foo` to get a `Foo`, and if it happens to be an `FBar Bar`, I
+	should be able to use that `Bar` to call `bar`.
+- better handling of properties to be verified
+  - some properties should always hold (no 500s): this already works.
+  - to-do: there may be some other properties that hold contextually
+	- healthcheck should be 200
+	- test complex permissions/ownership/delegation logic - should never be able to
+	  get access to something you don't own or haven't been delegated access to.
+
+## other possible applications
+
+- coverage
+  - if you run the checker for a while and `hpc` suggests you still have bad coverage,
+	your api is designed in a way that requires external manipulation and may be improvable.
+
+- benchmarking
+  - we can generate "big-enough" call sequences, then save the database & a sample call for each
+	endpoint that takes long enough to be a reasonable test.
+  - from this we can generate tests that a given call on that setup never gets slower.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/roboservant.cabal b/roboservant.cabal
new file mode 100644
--- /dev/null
+++ b/roboservant.cabal
@@ -0,0 +1,86 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 51154f1c866aea92673a52985de6810cebda3b2662fddd7b7f88a56725e30041
+
+name:           roboservant
+version:        0.1.0.0
+synopsis:       Automatic session-aware servant testing
+description:    Please see the README on GitHub at <https://github.com/githubuser/roboservant#readme>
+category:       Web
+homepage:       https://github.com/mwotton/roboservant#readme
+bug-reports:    https://github.com/mwotton/roboservant/issues
+author:         Mark Wotton, Samuel Schlesinger
+maintainer:     mwotton@gmail.com
+copyright:      2020 Mark Wotton, Samuel Schlesinger
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/mwotton/roboservant
+
+library
+  exposed-modules:
+      Roboservant
+      Roboservant.StateMachine
+  other-modules:
+      Paths_roboservant
+  hs-source-dirs:
+      src
+  ghc-options: -Wall
+  build-depends:
+      QuickCheck
+    , aeson
+    , base >=4.7 && <5
+    , bytestring
+    , containers
+    , hedgehog
+    , hspec
+    , http-client
+    , http-media
+    , mtl
+    , quickcheck-state-machine >=0.7
+    , servant >=0.17
+    , servant-client >=0.17
+    , servant-flatten
+    , servant-server >=0.17
+    , string-conversions
+  default-language: Haskell2010
+
+test-suite roboservant-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Foo
+      UnsafeIO
+      Paths_roboservant
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      QuickCheck
+    , aeson
+    , base >=4.7 && <5
+    , bytestring
+    , containers
+    , hedgehog
+    , hspec
+    , http-client
+    , http-media
+    , mtl
+    , quickcheck-state-machine >=0.7
+    , roboservant
+    , servant >=0.17
+    , servant-client >=0.17
+    , servant-flatten
+    , servant-server >=0.17
+    , string-conversions
+  default-language: Haskell2010
diff --git a/src/Roboservant.hs b/src/Roboservant.hs
new file mode 100644
--- /dev/null
+++ b/src/Roboservant.hs
@@ -0,0 +1,3 @@
+module Roboservant (module Roboservant.StateMachine) where
+
+import Roboservant.StateMachine
diff --git a/src/Roboservant/StateMachine.hs b/src/Roboservant/StateMachine.hs
new file mode 100644
--- /dev/null
+++ b/src/Roboservant/StateMachine.hs
@@ -0,0 +1,250 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Roboservant.StateMachine where
+
+import Control.Monad.Except (runExceptT)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.Dynamic (Dynamic, dynApply, dynTypeRep, fromDynamic, toDyn)
+import Data.Function ((&))
+import Data.IORef (IORef, newIORef)
+import qualified Data.List.NonEmpty as NEL
+import Data.List.NonEmpty (NonEmpty)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (mapMaybe)
+import Data.Typeable (TypeRep, Typeable, typeRep)
+import GHC.IORef (readIORef)
+import GHC.TypeLits (Symbol)
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import Servant
+import Type.Reflection (SomeTypeRep)
+
+data State v
+  = State
+      { stateRefs :: Map TypeRep (NonEmpty (Var (Opaque (IORef Dynamic)) v))
+      }
+
+class FlattenServer api where
+  flattenServer :: Server api -> Bundled (Endpoints api)
+
+instance
+  ( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api),
+    Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api),
+    FlattenServer api
+  ) =>
+  FlattenServer (endpoint :<|> api)
+  where
+  flattenServer (endpoint :<|> server) = endpoint `AnEndpoint` flattenServer @api server
+
+instance
+  ( HasServer (x :> api) '[],
+    Endpoints (x :> api) ~ '[x :> api]
+  ) =>
+  FlattenServer (x :> api)
+  where
+  flattenServer server = server `AnEndpoint` NoEndpoints
+
+instance
+  ( HasServer (Verb method statusCode contentTypes responseType) '[],
+    Endpoints (Verb method statusCode contentTypes responseType) ~ '[Verb method statusCode contentTypes responseType]
+  ) =>
+  FlattenServer (Verb method statusCode contentTypes responseType)
+  where
+  flattenServer server = server `AnEndpoint` NoEndpoints
+
+type ReifiedEndpoint = ([TypeRep], TypeRep, Dynamic)
+
+type ReifiedApi = [(ApiOffset, [TypeRep], TypeRep, Dynamic)]
+
+data Bundled endpoints where
+  AnEndpoint :: Server endpoint -> Bundled endpoints -> Bundled (endpoint ': endpoints)
+  NoEndpoints :: Bundled '[]
+
+class ToReifiedApi (endpoints :: [*]) where
+  toReifiedApi :: Bundled endpoints -> Proxy endpoints -> ReifiedApi
+
+class ToReifiedEndpoint (endpoint :: *) where
+  toReifiedEndpoint :: Dynamic -> Proxy endpoint -> ReifiedEndpoint
+
+instance ToReifiedApi '[] where
+  toReifiedApi NoEndpoints _ = []
+
+instance
+  (Typeable (Normal (ServerT endpoint Handler)), NormalizeFunction (ServerT endpoint Handler), ToReifiedEndpoint endpoint, ToReifiedApi endpoints, Typeable (ServerT endpoint Handler)) =>
+  ToReifiedApi (endpoint : endpoints)
+  where
+  toReifiedApi (endpoint `AnEndpoint` endpoints) _ =
+    withOffset (toReifiedEndpoint (toDyn (normalize endpoint)) (Proxy @endpoint))
+      : map
+        (\(n, x, y, z) -> (n + 1, x, y, z))
+        (toReifiedApi endpoints (Proxy @endpoints))
+    where
+      withOffset (x, y, z) = (0, x, y, z)
+
+class NormalizeFunction m where
+  type Normal m
+  normalize :: m -> Normal m
+
+instance NormalizeFunction x => NormalizeFunction (r -> x) where
+  type Normal (r -> x) = r -> Normal x
+  normalize = fmap normalize
+
+instance Typeable x => NormalizeFunction (Handler x) where
+  type Normal (Handler x) = IO (Either ServerError (TypeRep, Dynamic))
+  normalize handler = (runExceptT . runHandler') handler >>= \case
+    Left serverError -> pure (Left serverError)
+    Right x -> pure (Right (typeRep (Proxy @x), toDyn x))
+
+instance
+  Typeable responseType =>
+  ToReifiedEndpoint (Verb method statusCode contentTypes responseType)
+  where
+  toReifiedEndpoint endpoint _ =
+    ([], typeRep (Proxy @responseType), endpoint)
+
+instance
+  (ToReifiedEndpoint endpoint) =>
+  ToReifiedEndpoint ((x :: Symbol) :> endpoint)
+  where
+  toReifiedEndpoint endpoint _ =
+    toReifiedEndpoint endpoint (Proxy @endpoint)
+
+instance
+  (Typeable requestType, ToReifiedEndpoint endpoint) =>
+  ToReifiedEndpoint (Capture name requestType :> endpoint)
+  where
+  toReifiedEndpoint endpoint _ =
+    toReifiedEndpoint endpoint (Proxy @endpoint)
+      & \(args, result, typeRepMap) -> (typeRep (Proxy @requestType) : args, result, typeRepMap)
+
+instance
+  (Typeable requestType, ToReifiedEndpoint endpoint) =>
+  ToReifiedEndpoint (ReqBody contentTypes requestType :> endpoint)
+  where
+  toReifiedEndpoint endpoint _ =
+    toReifiedEndpoint endpoint (Proxy @endpoint)
+      & \(args, result, typeRepMap) -> (typeRep (Proxy @requestType) : args, result, typeRepMap)
+
+newtype ApiOffset = ApiOffset Int
+  deriving (Eq, Show)
+  deriving newtype (Enum, Num)
+
+-- | we need to specify an offset because it's entirely possible to have two
+--   functions with the same arguments that do different things.
+data Op (v :: * -> *) = Op ApiOffset [(TypeRep, Var (Opaque (IORef Dynamic)) v)]
+
+deriving instance Show (Op Symbolic)
+
+instance HTraversable Op where
+  htraverse r (Op offset args) = Op offset <$> traverse (\(t, v) -> (t,) <$> htraverse r v) args
+
+callEndpoint :: (MonadGen n, MonadIO m) => ReifiedApi -> Command n m State
+callEndpoint staticRoutes =
+  let gen :: MonadGen n => State Symbolic -> Maybe (n (Op Symbolic))
+      gen State {..}
+        | any null options = Nothing
+        | otherwise = Just $ do
+          uncurry Op <$> chooseOne options
+        where
+          chooseOne ::
+            MonadGen n =>
+            [ ( ApiOffset,
+                [(TypeRep, [Var (Opaque (IORef Dynamic)) Symbolic])]
+              )
+            ] ->
+            n
+              ( ApiOffset,
+                [(TypeRep, Var (Opaque (IORef Dynamic)) Symbolic)]
+              )
+          chooseOne opts = do
+            (offset, args) <- Gen.element opts
+            (offset,) <$> mapM (\(tr, argOpts) -> (tr,) <$> Gen.element argOpts) args
+          options :: [(ApiOffset, [(TypeRep, [Var (Opaque (IORef Dynamic)) Symbolic])])]
+          options =
+            mapMaybe
+              ( \(offset, argreps, _retType, _dynCall) -> (offset,) <$> do
+                  mapM (\x -> (x,) <$> fillableWith x) argreps
+              )
+              staticRoutes
+          fillableWith :: TypeRep -> Maybe [Var (Opaque (IORef Dynamic)) Symbolic]
+          fillableWith tr = NEL.toList <$> Map.lookup tr stateRefs
+      execute ::
+        (MonadIO m) =>
+        Op Concrete ->
+        m (Opaque (IORef Dynamic))
+      execute (Op (ApiOffset offset) args) = do
+        --        traceM (show (offset, args))
+        fmap Opaque . liftIO $ do
+          realArgs <- mapM (\(_tr, v) -> readIORef (opaque v)) args
+          let (_offset, _staticArgs, _ret, endpoint) = staticRoutes !! offset
+              -- now, magic happens: we apply some dynamic arguments to a dynamic
+              -- function and hopefully somtehing useful pops out the end.
+              func = foldr (\arg curr -> flip dynApply arg =<< curr) (Just endpoint) realArgs
+          let showable = map dynTypeRep (endpoint : realArgs)
+          case func of
+            Nothing -> error ("all screwed up: " <> maybe ("nothing: " <> show showable) (show . dynTypeRep) func)
+            Just (f') -> do
+              case fromDynamic f' of
+                Nothing -> error ("all screwed up: " <> maybe ("nothing: " <> show showable) (show . dynTypeRep) func)
+                Just f -> liftIO f >>= \case
+                  Left (serverError :: ServerError) -> error (show serverError)
+                  Right (_typeRep :: SomeTypeRep, (dyn :: Dynamic)) -> newIORef dyn
+   in Command
+        gen
+        execute
+        [ Update $ \s@State {..} (Op (ApiOffset offset) _args) o' ->
+            s
+              { stateRefs =
+                  let (_, _, tr, _) = staticRoutes !! offset
+                   in Map.insertWith
+                        (<>)
+                        tr
+                        (pure o')
+                        stateRefs
+              }
+          -- , Ensure (no-500 here)
+        ]
+
+prop_sequential :: ReifiedApi -> Property
+prop_sequential reifiedApi = do
+  property $ do
+    let initialState = State mempty
+    actions <-
+      forAll $
+        Gen.sequential
+          (Range.linear 1 100)
+          initialState
+          [callEndpoint reifiedApi]
+    executeSequential initialState actions
+
+prop_concurrent :: ReifiedApi -> Property
+prop_concurrent reifiedApi =
+  let initialState = State mempty
+   in withTests 1000 . withRetries 10 . property $ do
+        actions <-
+          forAll $
+            Gen.parallel
+              (Range.linear 1 50)
+              (Range.linear 1 10)
+              initialState
+              [callEndpoint reifiedApi]
+        test $
+          executeParallel initialState actions
diff --git a/test/Foo.hs b/test/Foo.hs
new file mode 100644
--- /dev/null
+++ b/test/Foo.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Foo where
+
+import Data.Aeson
+import Data.Typeable (Typeable)
+import GHC.Generics (Generic)
+import Servant
+
+newtype Foo = Foo Int
+  deriving (Generic, Eq, Show, Typeable)
+  deriving newtype (FromHttpApiData, ToHttpApiData)
+
+instance ToJSON Foo
+
+instance FromJSON Foo
+
+type FooApi =
+  "item" :> Get '[JSON] Foo
+    :<|> "itemAdd" :> Capture "one" Foo :> Capture "two" Foo :> Get '[JSON] Foo
+    :<|> "item" :> Capture "itemId" Foo :> Get '[JSON] ()
+
+intro :: Handler Foo
+intro = pure (Foo 1)
+
+combine :: Foo -> Foo -> Handler Foo
+combine (Foo a) (Foo b) = pure (Foo (a + b))
+
+eliminate :: Foo -> Handler ()
+eliminate (Foo a)
+  | a > 10 = throwError $ err500 {errBody = "eliminate blew up, oh no!"}
+  | otherwise = pure ()
+
+fooServer :: Server FooApi
+fooServer =
+  intro
+    :<|> combine
+    :<|> eliminate
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+import Data.Proxy (Proxy (..))
+import qualified Foo
+import Hedgehog (Group (..), checkSequential)
+import qualified Roboservant as RS
+import Servant (Endpoints)
+import qualified UnsafeIO
+
+-- | this is pretty bad. hopefully Jacob knows a better way of doing this.
+--   https://twitter.com/mwotton/status/1305189249646460933
+assert :: String -> Bool -> IO ()
+assert _ True = pure ()
+assert err False = ioError $ userError err
+
+-- | This is horribly laid out, sorry. Will fix at some point.
+main :: IO ()
+main = do
+  let reifiedApi = RS.toReifiedApi (RS.flattenServer @Foo.FooApi Foo.fooServer) (Proxy @(Endpoints Foo.FooApi))
+  assert "should find an error in Foo" . not
+    =<< checkSequential (Group "Foo" [("Foo", RS.prop_sequential reifiedApi)])
+  -- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
+  -- could: it's mostly here to show how to test for concurrency problems.
+  unsafeServer <- UnsafeIO.makeServer
+  let unsafeApi = RS.toReifiedApi (RS.flattenServer @UnsafeIO.UnsafeApi unsafeServer) (Proxy @(Endpoints UnsafeIO.UnsafeApi))
+  -- this will not detect the error, as it requires concurrency.
+  assert "should find nothing" =<< checkSequential (Group "Unsafe" [("Sequential", RS.prop_sequential unsafeApi)])
+  -- this will!
+  assert "should find with parallel check" . not
+    =<< checkSequential (Group "Unsafe" [("Parallel", RS.prop_concurrent unsafeApi)])
diff --git a/test/UnsafeIO.hs b/test/UnsafeIO.hs
new file mode 100644
--- /dev/null
+++ b/test/UnsafeIO.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+
+module UnsafeIO where
+
+import Data.Aeson()
+import Servant
+import Data.IORef (writeIORef, IORef, readIORef, newIORef)
+import Control.Monad.Trans (MonadIO(liftIO))
+import qualified Data.ByteString.Lazy.Char8 as BL8
+
+
+type UnsafeApi =
+  "add" :> Get '[JSON] ()
+  :<|> "healthcheck" :> Get '[JSON] ()
+
+healthcheck :: IORef Int -> Handler ()
+healthcheck ref = do
+  t <- liftIO $ readIORef ref
+  case t of
+    0 -> pure ()
+    n -> throwError $ err500 {errBody = "observed inconsistency: " <> (BL8.pack $ show n)}
+
+
+
+makeServer :: IO (Server UnsafeApi)
+makeServer = do
+  ref <- newIORef 0
+  pure $ unsafeMunge ref
+    :<|> healthcheck ref
+
+unsafeMunge :: IORef Int -> Handler ()
+unsafeMunge ref = liftIO $ do
+  t <- readIORef ref
+  writeIORef ref (t+1)
+  t2 <- readIORef ref
+  writeIORef ref (t2-1)