diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Robert Fischer (c) 2017
+
+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 Robert Fischer 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,5 @@
+# Request For Comments
+## aka: Robert Fischer Commons
+
+This is a place where I put Haskell that I like to use, and things that I would eventually like to break out into libraries,
+but I want to exercise/refine the API first.
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/rfc.cabal b/rfc.cabal
new file mode 100644
--- /dev/null
+++ b/rfc.cabal
@@ -0,0 +1,108 @@
+name:                rfc
+version:             0.0.0.1
+synopsis:            Robert Fischer's Common library, for all Robert Fischer's common needs.
+description:         See README.md
+homepage:            https://github.com/RobertFischer/rfc#README.md
+license:             BSD3
+license-file:        LICENSE
+author:              Robert Fischer
+maintainer:          smokejumperit+rfc@gmail.com
+copyright:           (c)2017 Robert Fischer
+category:            Library
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+Flag Development
+  Description: Enable warnings
+  Default:     False
+  Manual:      True
+
+library
+  hs-source-dirs:      src
+  build-depends:       base >= 4.7 && < 5
+  default-language:    Haskell2010
+  if flag(development)
+    ghc-options:       -pedantic -fno-warn-orphans -fno-warn-name-shadowing
+  else
+    ghc-options:       -O2
+  default-extensions:  NoImplicitPrelude
+                     , DataKinds
+                     , TemplateHaskell
+                     , TypeOperators
+                     , OverloadedStrings
+                     , PackageImports
+                     , LambdaCase
+                     , MultiWayIf
+                     , Rank2Types
+                     , ConstraintKinds
+                     , FlexibleContexts
+                     , TypeSynonymInstances
+                     , FlexibleInstances
+                     , DeriveGeneric
+                     , ScopedTypeVariables
+                     , MultiParamTypeClasses
+                     , DefaultSignatures
+  build-depends:       base >= 4.7 && < 5
+                     , aeson
+                     , servant
+                     , servant-server
+                     , wai
+                     , classy-prelude
+                     , uuid-types
+                     , containers
+                     , unordered-containers
+                     , string-conversions
+                     , monad-control
+                     , postgresql-simple >= 0.5.3.0
+                     , resource-pool
+                     , hedis
+                     , async
+                     , simple-logger
+                     , http-client-tls
+                     , wreq
+                     , servant-docs
+                     , data-default
+                     , servant-blaze
+                     , wai-extra
+                     , temporary
+                     , blaze-html
+                     , servant-swagger
+                     , swagger2
+                     , markdown
+                     , url
+                     , lens
+                     , http-types
+                     , exceptions
+                     , http-api-data
+                     , time-units
+                     , wai-cors
+                     , aeson-diff
+                     , vector
+                     , lifted-async
+                     , text
+  exposed-modules:     RFC.Prelude
+                     , RFC.Psql
+                     , RFC.Redis
+                     , RFC.String
+                     , RFC.Concurrent
+                     , RFC.Throttle
+                     , RFC.JSON
+                     , RFC.Log
+                     , RFC.HTTP.Client
+                     , RFC.HTTP.Types
+                     , RFC.Servant
+                     , RFC.Servant.ApiDoc
+                     , RFC.Wai
+                     , RFC.Env
+                     , RFC.Google.Places.NearbySearch
+                     , RFC.Google.Places.PlaceSearch
+                     , RFC.Google.Places.SearchResults
+                     , RFC.Data.LatLng
+                     , RFC.Data.IdAnd
+                     , RFC.Data.ListMoveDirection
+                     , RFC.Data.UUID
+
+source-repository head
+  type:     git
+  location: https://github.com/RobertFischer/rfc
diff --git a/src/RFC/Concurrent.hs b/src/RFC/Concurrent.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Concurrent.hs
@@ -0,0 +1,22 @@
+module RFC.Concurrent
+  ( module RFC.Concurrent
+  , module Control.Concurrent.Async.Lifted
+  ) where
+
+import RFC.Prelude hiding (mapConcurrently)
+import Control.Concurrent.Async.Lifted (mapConcurrently, mapConcurrently_)
+
+-- |Executes all the IO actions simultaneously and returns the original data structure with the arguments replaced
+--  by the results of the execution.
+doConcurrently :: (Traversable t, MonadBaseControl IO m) => t (m a) -> m (t a)
+doConcurrently = mapConcurrently id
+
+-- |Executes all the IO actions simulataneously and discards the results.
+doConcurrently_ :: (Foldable f, MonadBaseControl IO m) => f (m a) -> m ()
+doConcurrently_ = mapConcurrently_ id
+
+-- |Executes all the IO actions simultaneously, feeds them into the filter function, and then
+-- filters the results.
+filterConcurrently :: (MonadBaseControl IO m) => (a -> Bool) -> [m a] -> m [a] -- TODO Seems like we should be able to do this with Foldable/Traversable
+filterConcurrently filterFunc actions =
+    filter filterFunc <$> doConcurrently actions
diff --git a/src/RFC/Data/IdAnd.hs b/src/RFC/Data/IdAnd.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Data/IdAnd.hs
@@ -0,0 +1,52 @@
+module RFC.Data.IdAnd
+  ( idAndsToMap
+  , IdAnd(..)
+  , valuesToIdAnd
+  , idAndToTuple
+  , tupleToIdAnd
+  , idAndToPair
+  ) where
+
+import RFC.Prelude
+import RFC.JSON
+import Data.Aeson as JSON
+import Data.Map as Map
+import Data.List as List hiding ((++))
+import Database.PostgreSQL.Simple.ToRow
+import Database.PostgreSQL.Simple.FromRow
+import Database.PostgreSQL.Simple.ToField
+import Database.PostgreSQL.Simple.FromField()
+
+-- |Represents something which has an ID.
+newtype IdAnd a = IdAnd (UUID, a)
+  deriving (Eq, Ord, Show, Generic, Typeable)
+
+tupleToIdAnd :: (UUID, a) -> IdAnd a
+tupleToIdAnd = IdAnd
+
+valuesToIdAnd :: UUID -> a -> IdAnd a
+valuesToIdAnd id a = IdAnd(id,a)
+
+idAndToTuple :: IdAnd a -> (UUID, a)
+idAndToTuple (IdAnd it) = it
+
+idAndToPair :: IdAnd a -> (UUID, IdAnd a)
+idAndToPair idAnd@(IdAnd (id,_)) = (id, idAnd)
+
+idAndsToMap :: [IdAnd a] -> Map UUID a
+idAndsToMap list = Map.fromList $ List.map idAndToTuple list
+
+instance (FromJSON a) => FromJSON (IdAnd a) where
+  parseJSON = JSON.withObject "IdAnd" $ \o -> do
+    id <- o .: "id"
+    value <- o .: "value"
+    return $ IdAnd(id, value)
+
+instance (ToJSON a) => ToJSON (IdAnd a) where
+  toJSON (IdAnd (id,value)) = object [ "id".=id, "value".=value ]
+
+instance (FromRow a) => FromRow (IdAnd a) where
+  fromRow = valuesToIdAnd <$> field <*> fromRow
+
+instance (ToRow a) => ToRow (IdAnd a) where
+  toRow (IdAnd (id,a)) = toField id : toRow a
diff --git a/src/RFC/Data/LatLng.hs b/src/RFC/Data/LatLng.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Data/LatLng.hs
@@ -0,0 +1,53 @@
+module RFC.Data.LatLng
+  ( LatLng(..)
+  , Longitude
+  , Latitude
+  , latLng
+  , lngLat
+  ) where
+
+import RFC.Prelude
+import RFC.Psql as Psql
+import RFC.JSON as JSON
+
+type Latitude = Double
+type Longitude = Double
+
+
+data LatLng = LatLng {
+  latitude :: Latitude,
+  longitude :: Longitude
+} deriving (Eq, Ord, Show, Typeable, Generic)
+$(JSON.deriveJSON JSON.jsonOptions ''LatLng)
+
+noLat :: Maybe Latitude
+noLat = Nothing
+
+noLng :: Maybe Longitude
+noLng = Nothing
+
+instance ToRow LatLng where
+  toRow latLng = Psql.toRow (latitude latLng, longitude latLng)
+
+instance ToRow (Maybe LatLng) where
+  toRow maybeLatLng =
+    case maybeLatLng of
+      Nothing -> map toField [noLat, noLng]
+      (Just latLng) -> Psql.toRow latLng
+
+instance FromRow LatLng where
+  fromRow = latLng <$> Psql.field <*> Psql.field
+
+instance FromRow (Maybe LatLng) where
+  fromRow = do
+    parsed <- (fromRow :: RowParser (Maybe (Maybe Latitude, Maybe Longitude)))
+    case parsed of
+      (Just (Just lat, Just lng)) -> return $ Just $ latLng lat lng
+      _ -> return Nothing
+
+
+latLng :: Latitude -> Longitude -> LatLng
+latLng lat lng = LatLng lat lng
+
+lngLat :: Longitude -> Latitude -> LatLng
+lngLat = flip latLng
diff --git a/src/RFC/Data/ListMoveDirection.hs b/src/RFC/Data/ListMoveDirection.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Data/ListMoveDirection.hs
@@ -0,0 +1,50 @@
+module RFC.Data.ListMoveDirection (
+  module RFC.Data.ListMoveDirection
+) where
+
+import RFC.Prelude
+import RFC.JSON
+import Data.Text as Text
+import Data.Aeson as Aeson
+
+data ListMoveDirection = TowardsHead | TowardsTail
+  deriving (Show,Eq,Generic,Typeable)
+
+instance FromJSON ListMoveDirection where
+    parseJSON = withText "ListMoveDirection" $ \t -> do
+      let head = return TowardsHead
+      let tail = return TowardsTail
+      case Text.strip $ Text.toUpper t of
+        "UP" -> head
+        "DOWN" -> tail
+
+        "FORWARD" -> head
+        "BACKWARD" -> tail
+
+        "FRONT" -> head
+        "BACK" -> tail
+
+        "-1" -> head
+        "+1" -> tail
+
+        "TOWARDSSTART" -> head
+        "TOWARDSTART" -> head
+        "TOWARDSEND" -> tail
+
+        "TOWARDSFRONT" -> head
+        "TOWARDSBACK" -> tail
+
+        "TOWARDSHEAD" -> head
+        "TOWARDSTAIL" -> tail
+
+        "HEADWARDS" -> head
+        "TAILWARDS" -> tail
+
+        _ -> fail . cs $ Text.append "Could not parse string to direction: " t
+
+instance ToJSON ListMoveDirection where
+  toJSON dir = Aeson.String (
+    case dir of
+      TowardsHead -> "UP"
+      TowardsTail -> "DOWN"
+    )
diff --git a/src/RFC/Data/UUID.hs b/src/RFC/Data/UUID.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Data/UUID.hs
@@ -0,0 +1,34 @@
+module RFC.Data.UUID
+  ( module Data.UUID.Types
+  ) where
+
+import Prelude (return, ($), String)
+import Data.UUID.Types
+import qualified Data.UUID.Types as UUID
+import Database.PostgreSQL.Simple.FromRow
+import Database.PostgreSQL.Simple.ToRow
+import Database.PostgreSQL.Simple.Types (Only(..))
+import RFC.String
+
+instance FromRow UUID where
+  fromRow = do
+    (Only id) <- fromRow
+    return id
+
+instance ToRow UUID where
+  toRow id = toRow $ Only id
+
+instance ConvertibleStrings UUID String where
+  convertString = UUID.toString
+
+instance ConvertibleStrings UUID StrictText where
+  convertString = UUID.toText
+
+instance ConvertibleStrings UUID LazyText where
+  convertString = toLazyText
+
+instance ConvertibleStrings UUID StrictByteString where
+  convertString = UUID.toASCIIBytes
+
+instance ConvertibleStrings UUID LazyByteString where
+  convertString = UUID.toLazyASCIIBytes
diff --git a/src/RFC/Env.hs b/src/RFC/Env.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Env.hs
@@ -0,0 +1,111 @@
+module RFC.Env
+  ( readGoogleMapsAPIKey
+  , isDevelopment
+  , readEnvironment
+  , readPsqlConnectInfo
+  , readRedisConnectInfo
+  ) where
+
+import RFC.Prelude
+import System.Environment (lookupEnv)
+import Database.PostgreSQL.Simple as Psql
+import Database.Redis as Redis
+import Data.Word (Word16)
+
+-- TODO Create a Monad that only logs reading the env var once, and reads all the environment variables at once, and is pure.
+
+readEnv :: (MonadIO m) => String -> Maybe String -> m String
+readEnv envKey defaultValue = do
+  foundValue <- liftIO $ lookupEnv envKey
+  case foundValue of
+    Nothing ->
+      case defaultValue of
+        Nothing -> fail $ "No value of " ++ (show envKey) ++ " environment variable, and no default configured."
+        (Just s) -> do
+          return s
+    (Just s) -> do
+      return s
+
+isDevelopment :: (MonadIO m) =>  m Bool
+isDevelopment = ((==) "development") <$> readEnvironment
+
+forDevOnly :: (MonadIO m) => String -> m (Maybe String)
+forDevOnly defaultValue = do
+  isDev <- isDevelopment
+  return $ if isDev then
+    Just defaultValue
+  else
+    Nothing
+
+readEnvironment :: (MonadIO m) => m String
+readEnvironment = readEnv "ENV" defaultEnv
+  where
+    defaultEnv = Just "development"
+
+readGoogleMapsAPIKey :: (MonadIO m) => m String
+readGoogleMapsAPIKey = readEnv "GMAPS_API_KEY" Nothing
+
+readPsqlUser :: (MonadIO m) => m String
+readPsqlUser = do
+  projectThunk <- readAppSlug >>= forDevOnly
+  readEnv "PSQL_USERNAME" $ projectThunk
+
+readPsqlPassword :: (MonadIO m) => m String
+readPsqlPassword = do
+  projectThunk <- readAppSlug >>= forDevOnly
+  readEnv "PSQL_PASSWORD" projectThunk
+
+readPsqlDatabase :: (MonadIO m) => m String
+readPsqlDatabase = do
+  projectThunk <- readAppSlug >>= forDevOnly
+  readEnv "PSQL_DATABASE" projectThunk
+
+readPsqlHost :: (MonadIO m) => m String
+readPsqlHost = readEnv "PSQL_HOST" $ Just $ Psql.connectHost Psql.defaultConnectInfo
+
+readPsqlPort :: (MonadIO m) => m Word16
+readPsqlPort = do
+  result <- readEnv "PSQL_PORT" $ Just $ show $ Psql.connectPort Psql.defaultConnectInfo
+  return $ read result
+
+readPsqlConnectInfo :: (MonadIO m) => m Psql.ConnectInfo
+readPsqlConnectInfo =
+  Psql.ConnectInfo
+    <$> readPsqlHost
+    <*> readPsqlPort
+    <*> readPsqlUser
+    <*> readPsqlPassword
+    <*> readPsqlDatabase
+
+readRedisConnectInfo :: (MonadIO m) => m Redis.ConnectInfo
+readRedisConnectInfo =
+  Redis.ConnInfo
+    <$> readRedisHost
+    <*> readRedisPort
+    <*> readRedisPassword
+    <*> readRedisDbNumber
+    <*> (return $ Redis.connectMaxConnections Redis.defaultConnectInfo)
+    <*> (return $ Redis.connectMaxIdleTime Redis.defaultConnectInfo)
+    <*> (return $ Just 10)
+
+readRedisHost :: (MonadIO m) => m Redis.HostName
+readRedisHost = readEnv "REDIS_HOST" $ Just $ Redis.connectHost Redis.defaultConnectInfo
+
+readRedisPort :: (MonadIO m) => m Redis.PortID
+readRedisPort = do
+  result <- readEnv "REDIS_PORT" $ Just "6379" -- Default Redis port
+  return $ PortNumber $ read result
+
+readRedisPassword :: (MonadIO m) => m (Maybe ByteString)
+readRedisPassword = do
+  result <- readEnv "REDIS_PASSWORD" $ Just ""
+  return $
+    case result of
+      "" -> Nothing
+      _ -> Just $ cs result
+
+readRedisDbNumber :: (MonadIO m) => m Integer
+readRedisDbNumber = read <$> readEnv "REDIS_DATABASE" (Just $ show $ Redis.connectDatabase Redis.defaultConnectInfo)
+
+readAppSlug :: (MonadIO m) => m String
+readAppSlug = readEnv "APP_SLUG" Nothing
diff --git a/src/RFC/Google/Places/NearbySearch.hs b/src/RFC/Google/Places/NearbySearch.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Google/Places/NearbySearch.hs
@@ -0,0 +1,83 @@
+module RFC.Google.Places.NearbySearch
+  ( module RFC.Google.Places.NearbySearch
+  , module RFC.Google.Places.SearchResults
+  , module RFC.Data.LatLng
+  , HasAPIClient
+  ) where
+
+import RFC.Prelude
+import RFC.Log
+import RFC.HTTP.Client
+import qualified Data.Maybe as Maybe
+import qualified Data.List as List
+import RFC.Data.LatLng
+import RFC.Google.Places.SearchResults
+
+endpoint :: URL
+endpoint =
+  case importURL endpointStr of
+    Nothing -> error $ "Could not parse the Google Places API endpoint into a URL: " ++ endpointStr
+    (Just it) -> it
+  where
+    endpointStr = "https://maps.googleapis.com/maps/api/place/nearbysearch/json"
+
+data Params = Params
+  { apiKey :: String
+  , location :: LatLng
+  , radiusMeters :: Integer -- ^ maximum of 50,000
+  , rankBy :: RankBy
+  , keyword :: Maybe String
+  , language :: Maybe String
+  , region :: Maybe String
+  , placeType :: Maybe PlaceType -- ^ "type"
+  }
+
+data RankBy = Distance | Prominence
+
+rankByToString :: RankBy -> String
+rankByToString Distance = "distance"
+rankByToString Prominence = "prominence"
+
+data OptionalParams = OptionalParams
+
+data PlaceType =
+  Hospital | Doctor
+
+placeTypeToString :: PlaceType -> String
+placeTypeToString Hospital = "hospital"
+placeTypeToString Doctor = "doctor"
+
+paramsToPairs :: Params -> [(String,String)]
+paramsToPairs params =
+    [ ("key", apiKey params)
+    , ("location", (show lat) ++ "," ++ (show lng))
+    , ("radius", show $ radiusMeters params)
+    , ("rankBy", rankByToString $ rankBy params)
+    ] ++ optionalPairs
+  where
+    loc = location params
+    (lat,lng) = (latitude loc, longitude loc)
+    toPair = optionalParamToPair params
+    optionalPairs = Maybe.catMaybes
+      [ toPair keyword "keyword"
+      , toPair language "language"
+      , toPair region "region"
+      , toPair (fmap placeTypeToString . placeType) "type"
+      ]
+
+optionalParamToPair :: Params -> (Params -> Maybe String) -> String -> Maybe (String,String)
+optionalParamToPair param field paramName = (\paramVal -> (paramName, paramVal)) <$> field param
+
+paramsToUrl :: Params -> URL
+paramsToUrl params =
+    List.foldr fold endpoint $ paramsToPairs params
+  where
+    fold = flip add_param
+
+query :: (HasAPIClient m, MonadCatch m) => Params -> m Results
+query params = apiGet (paramsToUrl params) onError
+  where
+    onError :: (MonadIO m) => SomeException -> m Results
+    onError err = do
+      logWarn . cs $ "Error performing Google Nearby Search: " ++ (show err)
+      return $ Results (show err, [])
diff --git a/src/RFC/Google/Places/PlaceSearch.hs b/src/RFC/Google/Places/PlaceSearch.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Google/Places/PlaceSearch.hs
@@ -0,0 +1,65 @@
+module RFC.Google.Places.PlaceSearch
+  ( module RFC.Google.Places.PlaceSearch
+  , module RFC.Google.Places.SearchResults
+  , module RFC.Data.LatLng
+  , HasAPIClient
+  ) where
+
+import RFC.Prelude
+import RFC.Log
+import RFC.HTTP.Client
+import qualified Data.Maybe as Maybe
+import qualified Data.List as List
+import RFC.Data.LatLng
+import RFC.Google.Places.SearchResults
+
+endpoint :: URL
+endpoint =
+  case importURL endpointStr of
+    Nothing -> error $ "Could not parse the Google Place Search API endpoint into a URL: " ++ endpointStr
+    (Just it) -> it
+  where
+    endpointStr = "https://maps.googleapis.com/maps/api/place/textsearch/json"
+
+data Params = Params
+  { apiKey :: String
+  , search :: String
+  , language :: Maybe String
+  , placeType :: Maybe PlaceType -- ^ "type"
+  }
+
+data PlaceType =
+  Hospital | Doctor deriving (Show,Eq,Ord,Enum,Bounded,Generic,Typeable)
+
+placeTypeToString :: PlaceType -> String
+placeTypeToString Hospital = "hospital"
+placeTypeToString Doctor = "doctor"
+
+paramsToPairs :: Params -> [(String,String)]
+paramsToPairs params =
+    [ ("key", apiKey params)
+    , ("query", search params)
+    ]  ++ optionalPairs
+  where
+    toPair = optionalParamToPair params
+    optionalPairs = Maybe.catMaybes
+      [ toPair language "language"
+      , toPair (fmap placeTypeToString . placeType) "type"
+      ]
+
+optionalParamToPair :: Params -> (Params -> Maybe String) -> String -> Maybe (String,String)
+optionalParamToPair param field paramName = (\paramVal -> (paramName, paramVal)) <$> field param
+
+paramsToUrl :: Params -> URL
+paramsToUrl params =
+    List.foldr fold endpoint $ paramsToPairs params
+  where
+    fold = flip add_param
+
+query :: (MonadCatch m, HasAPIClient m) => Params -> m Results
+query params = apiGet (paramsToUrl params) onError
+  where
+    onError :: (MonadIO m) => SomeException -> m Results
+    onError err = do
+      logWarn . cs $ "Error performing Google Place Search: " ++ (show err)
+      return $ Results (show err, [])
diff --git a/src/RFC/Google/Places/SearchResults.hs b/src/RFC/Google/Places/SearchResults.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Google/Places/SearchResults.hs
@@ -0,0 +1,60 @@
+module RFC.Google.Places.SearchResults
+  ( module RFC.Google.Places.SearchResults
+  ) where
+
+import Data.Aeson ((.:), (.:?), withObject)
+import RFC.Prelude
+import RFC.JSON
+import qualified Data.Maybe as Maybe
+import RFC.Data.LatLng
+import Data.Map as Map
+
+type ResultsStatus = String
+newtype Results = Results (ResultsStatus, [Result])
+
+instance ToJSON Results where
+  toJSON (Results (status, results)) =
+    toJSON $ Map.fromList
+      [ ("status"::String, toJSON status)
+      , ("results"::String, toJSON results)
+      ]
+
+instance FromJSON Results where
+  parseJSON = withObject "Places.Results" $ \topObj -> do
+    status <- topObj .: "status"
+    results <- topObj .:? "results"
+    return $ Results (status, Maybe.fromMaybe [] results)
+
+data Result = Result
+  { resultLocation :: LatLng
+  , resultName :: String
+  , resultPlaceId :: String
+  , resultVicinity :: Maybe String
+  }
+
+instance FromJSON Result where
+  parseJSON = withObject "Places.Result" $ \topObj -> do
+    geometry <- topObj .: "geometry"
+    location <- geometry .: "location"
+    lat <- location .: "lat"
+    lng <- location .: "lng"
+    let latLngLoc = latLng lat lng
+    name <- topObj .: "name"
+    id <- topObj .: "place_id"
+    vicinity <- topObj .:? "vicinity"
+    return $ Result latLngLoc name id vicinity
+
+instance ToJSON Result where
+  toJSON result = toJSON . Map.fromList $
+    [ ("geometry"::String, toJSON . Map.fromList $
+        [ ("location"::String, Map.fromList $
+            [ ("lat"::String, latitude . resultLocation $ result)
+            , ("lng"::String, longitude . resultLocation $ result)
+            ]
+          )
+        ]
+      )
+    , ("name"::String, toJSON . resultName $ result)
+    , ("place_id"::String, toJSON . resultPlaceId $ result)
+    , ("vicinity"::String, toJSON . resultVicinity $ result)
+    ]
diff --git a/src/RFC/HTTP/Client.hs b/src/RFC/HTTP/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/HTTP/Client.hs
@@ -0,0 +1,46 @@
+module RFC.HTTP.Client
+  ( withAPISession
+  , HasAPIClient(..)
+  , BadStatusException
+  , apiGet
+  , module Network.Wreq.Session
+  , module Network.URL
+  , module Network.HTTP.Types.Status
+  ) where
+
+import RFC.Prelude
+import RFC.String
+import RFC.JSON (FromJSON, decodeOrDie)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.Wreq.Session hiding (withAPISession)
+import Network.URL
+import Network.Wreq.Lens
+import Control.Lens
+import Network.HTTP.Types.Status hiding (statusMessage, statusCode)
+
+withAPISession :: (Session -> IO a) -> IO a
+withAPISession = withSessionControl Nothing tlsManagerSettings
+
+newtype BadStatusException = BadStatusException (Status,URL)
+  deriving (Show,Eq,Ord,Generic,Typeable)
+instance Exception BadStatusException
+
+apiExecute :: (HasAPIClient m, ConvertibleString LazyByteString s)  =>
+  URL -> (Session -> String -> IO (Response LazyByteString)) -> (s -> m a) -> m a
+apiExecute rawUrl action converter = do
+    session <- getAPIClient
+    response <- liftIO $ action session url
+    let status = response ^. responseStatus
+    case status ^. statusCode of
+      200 -> converter . cs $ response ^. responseBody
+      _ -> throwM $ badResponseStatus status
+  where
+    url = exportURL rawUrl
+    badResponseStatus status = BadStatusException (status, rawUrl)
+
+apiGet :: (HasAPIClient m, FromJSON a, MonadCatch m, Exception e) => URL -> (e -> m a) -> m a
+apiGet url onError =
+    handle onError $ apiExecute url get decodeOrDie
+
+class (MonadThrow m, MonadIO m) => HasAPIClient m where
+  getAPIClient :: m Session
diff --git a/src/RFC/HTTP/Types.hs b/src/RFC/HTTP/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/HTTP/Types.hs
@@ -0,0 +1,5 @@
+module RFC.HTTP.Types
+  ( module Web.HttpApiData
+  ) where
+
+import Web.HttpApiData (FromHttpApiData(..), ToHttpApiData(..))
diff --git a/src/RFC/JSON.hs b/src/RFC/JSON.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/JSON.hs
@@ -0,0 +1,51 @@
+module RFC.JSON
+( jsonOptions
+, deriveJSON
+, FromJSON(..)
+, ToJSON(..)
+, eitherDecode
+, decodeEither
+, eitherDecode'
+, decodeEither'
+, decodeOrDie
+, DecodeError
+, Value(..)
+, encode
+, decode
+) where
+
+import RFC.Prelude
+import Data.Aeson as JSON
+import Data.Aeson.TH (deriveJSON)
+import Data.Aeson.Types (Options(..), SumEncoding(..))
+
+jsonOptions :: Options
+jsonOptions = defaultOptions
+    { sumEncoding = ObjectWithSingleField
+    , unwrapUnaryRecords = True
+    , fieldLabelModifier = flm
+    , constructorTagModifier = ctm
+    }
+  where
+    ctm [] = []
+    ctm (c:cs) = (charToLower c):cs
+    flm = flm' . span charIsLower
+    flm' (cs, []) = cs
+    flm' (_, cs) = lowerFirst cs
+    lowerFirst [] = []
+    lowerFirst (c:cs) = (charToLower c):cs
+
+decodeEither :: (FromJSON a) => LazyByteString -> Either String a
+decodeEither = eitherDecode
+
+decodeEither' :: (FromJSON a) => LazyByteString -> Either String a
+decodeEither' = eitherDecode'
+
+newtype DecodeError = DecodeError (LazyByteString, String) deriving (Show,Eq,Ord,Generic,Typeable)
+instance Exception DecodeError
+
+decodeOrDie :: (FromJSON a, MonadThrow m) => LazyByteString -> m a
+decodeOrDie input =
+  case decodeEither' input of
+    Left err -> throwM $ DecodeError (input, err)
+    Right a -> return a
diff --git a/src/RFC/Log.hs b/src/RFC/Log.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Log.hs
@@ -0,0 +1,24 @@
+module RFC.Log
+  ( module Control.Logger.Simple
+  , module RFC.Log
+  ) where
+
+import RFC.Prelude
+import RFC.Env as Env
+import Control.Logger.Simple (pureDebug, pureInfo, pureWarn, pureError, logDebug, logInfo, logWarn, logError)
+import Control.Logger.Simple as Log
+import System.IO (stderr, hSetBuffering, BufferMode(..))
+
+withLogging :: IO a -> IO a
+withLogging action = do
+  isDev <- Env.isDevelopment
+  hSetBuffering stderr LineBuffering
+  Log.withGlobalLogging (logConfig isDev) action
+  where
+    logConfig isDev =
+      if isDev then
+          Log.LogConfig { Log.lc_file = Nothing, Log.lc_stderr = True }
+      else
+          Log.LogConfig { Log.lc_file = Just "./log/api-server.log", Log.lc_stderr = False }
+
+
diff --git a/src/RFC/Prelude.hs b/src/RFC/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Prelude.hs
@@ -0,0 +1,44 @@
+module RFC.Prelude
+  ( module ClassyPrelude
+  , module RFC.Prelude
+  , module RFC.Data.UUID
+  , module Data.String.Conversions
+  , module GHC.Generics
+  , module Text.Read
+  , module Data.Time.Units
+  , module Data.Function
+  , module Data.Typeable
+  ) where
+
+import Prelude ()
+import ClassyPrelude hiding (Handler, unpack, Day)
+import Data.Char as Char
+import Data.String.Conversions (cs, LazyByteString, StrictByteString, LazyText, StrictText)
+import GHC.Generics (Generic)
+import qualified Data.List as List
+import Text.Read (Read, read)
+import Data.Time.Units
+import RFC.Data.UUID (UUID)
+import Data.Function ((&))
+import Data.Typeable (TypeRep, typeOf)
+
+charIsUpper :: Char -> Bool
+charIsUpper = Char.isUpper
+
+charIsLower :: Char -> Bool
+charIsLower = Char.isLower
+
+uniq :: (Eq a) => [a] -> [a]
+uniq = List.nub
+
+mapFst :: (a -> c) -> (a,b) -> (c,b)
+mapFst f (a,b) = (f a, b)
+
+mapSnd :: (b -> c) -> (a,b) -> (a,c)
+mapSnd f (a,b) = (a, f b)
+
+safeHead :: [a] -> Maybe a
+safeHead [] = Nothing
+safeHead (x:_) = Just x
+
+type Boolean = Bool -- I keep forgetting which Haskell uses....
diff --git a/src/RFC/Psql.hs b/src/RFC/Psql.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Psql.hs
@@ -0,0 +1,95 @@
+module RFC.Psql
+  ( module Database.PostgreSQL.Simple
+  , module Database.PostgreSQL.Simple.FromField
+  , module Database.PostgreSQL.Simple.FromRow
+  , module Database.PostgreSQL.Simple.ToField
+  , module Database.PostgreSQL.Simple.ToRow
+  , module Database.PostgreSQL.Simple.SqlQQ
+  , module Database.PostgreSQL.Simple.Types
+  , module RFC.Psql
+  ) where
+
+import RFC.Prelude
+import RFC.Env
+import Database.PostgreSQL.Simple (Connection, connectUser, connectPassword, connectDatabase, ConnectInfo, FromRow, Only(..), In(..), commit, Query)
+import qualified Database.PostgreSQL.Simple as Psql
+import Data.Pool
+import Database.PostgreSQL.Simple.FromField hiding (Binary)
+import Database.PostgreSQL.Simple.FromRow
+import Database.PostgreSQL.Simple.ToField
+import Database.PostgreSQL.Simple.ToRow
+import Database.PostgreSQL.Simple.SqlQQ
+import Database.PostgreSQL.Simple.Types
+import Control.Monad.Trans.Control
+import RFC.Log
+
+type ConnectionPool = Pool Connection
+
+class (MonadIO m, MonadCatch m, MonadBaseControl IO m) => HasPsql m where
+  getPsqlPool :: m ConnectionPool
+
+  withPsqlConnection :: (Connection -> m a) -> m a
+  withPsqlConnection action = do
+    pool <- getPsqlPool
+    withResource pool action
+
+  withPsqlTransaction :: (Connection -> m a) -> m a
+  withPsqlTransaction action = withPsqlConnection $ \conn ->
+    (liftBaseOp_ (Psql.withTransaction conn)) (action conn)
+
+defaultConnectInfo :: (MonadIO m) => m ConnectInfo
+defaultConnectInfo = RFC.Env.readPsqlConnectInfo
+
+createConnectionPool :: (MonadIO m) => ConnectInfo -> m ConnectionPool
+createConnectionPool connInfo = liftIO $
+    createPool connect close 1 10 100
+  where
+    connect = do
+      logDebug "Opening DB connection"
+      Psql.connect connInfo
+    close conn = do
+      logDebug "Closing DB connection"
+      Psql.close conn
+
+query :: (MonadIO m, FromRow r, ToRow q) => Connection -> Query -> q -> m [r]
+query conn qry q = liftIO $ Psql.query conn qry q
+
+query_ :: (MonadIO m, FromRow r) => Connection -> Query -> m [r]
+query_ conn qry = liftIO $ Psql.query_ conn qry
+
+query1 :: (MonadIO m, FromRow r, ToRow q) => Connection -> Query -> q -> m (Maybe r)
+query1 conn qry q = do
+  result <- query conn qry q
+  return $ case result of
+    [] -> Nothing
+    (r:_) -> Just r
+
+query1_ :: (MonadIO m, FromRow r) => Connection -> Query -> m (Maybe r)
+query1_ conn qry = do
+  result <- query_ conn qry
+  return $ case result of
+    [] -> Nothing
+    (r:_) -> Just r
+
+query1Else :: (MonadIO m, FromRow r, ToRow q, Exception e) => Connection -> Query -> q -> e -> m (Maybe r)
+query1Else conn qry q e = do
+  result <- query1 conn qry q
+  case result of
+    (Just _) -> return result
+    Nothing -> liftIO $ throwIO e
+
+query1Else_ :: (MonadIO m, FromRow r, Exception e) => Connection -> Query -> e -> m (Maybe r)
+query1Else_ conn qry e = do
+  result <- query1_ conn qry
+  case result of
+    (Just _) -> return result
+    Nothing -> liftIO $ throwIO e
+
+execute :: (MonadIO m, ToRow q) => Connection -> Query -> q -> m Int64
+execute conn qry q = liftIO $ Psql.execute conn qry q
+
+execute_ :: (MonadIO m) => Connection -> Query -> m Int64
+execute_ conn qry = liftIO $ Psql.execute_ conn qry
+
+executeMany :: (MonadIO m, ToRow q) => Connection -> Query -> [q] -> m Int64
+executeMany conn qry qs = liftIO $ Psql.executeMany conn qry qs
diff --git a/src/RFC/Redis.hs b/src/RFC/Redis.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Redis.hs
@@ -0,0 +1,49 @@
+module RFC.Redis
+  ( createConnectionPool
+  , ConnectionPool
+  , HasRedis(..)
+  , RedisException(..)
+  , get
+  , setex
+  ) where
+
+import RFC.Prelude
+import qualified Database.Redis as R
+import RFC.String
+import RFC.Env as Env
+
+type ConnectionPool = R.Connection
+
+newtype RedisException = RedisException R.Reply deriving (Typeable, Show)
+instance Exception RedisException
+
+class (MonadIO m, MonadThrow m) => HasRedis m where
+  getRedisPool :: m ConnectionPool
+
+  runRedis :: R.Redis a -> m a
+  runRedis r = do
+    conn <- getRedisPool
+    liftIO $ R.runRedis conn r
+
+createConnectionPool :: (MonadIO m) => m ConnectionPool
+createConnectionPool = do
+  connInfo <- Env.readRedisConnectInfo
+  liftIO $ R.connect connInfo
+
+get :: (HasRedis m, ConvertibleToSBS tIn, ConvertibleFromSBS tOut) => tIn -> m (Maybe tOut)
+get key = do
+  result <- runRedis $ R.get $ cs key
+  maybeResult <- unpack result
+  return $ cs <$> maybeResult
+
+unpack :: (MonadThrow m) => Either R.Reply a -> m a
+unpack (Left reply) = throw $ RedisException reply
+unpack (Right it) = return it
+
+setex :: (HasRedis m, ConvertibleToSBS key, ConvertibleToSBS value, TimeUnit expiry) => key -> value -> expiry -> m ()
+setex key value expiry = do
+    result <- runRedis $ R.setex (cs key) milliseconds (cs value)
+    _ <- unpack result
+    return ()
+  where
+    milliseconds = fromIntegral $ ( (convertUnit expiry)::Millisecond )
diff --git a/src/RFC/Servant.hs b/src/RFC/Servant.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Servant.hs
@@ -0,0 +1,157 @@
+module RFC.Servant
+  ( ApiCtx
+  , apiCtxToHandler
+  , ResourceDefinition(..)
+  , ServerAPI
+  , ServerImpl
+  , module Servant
+  , module Servant.Docs
+  , module Servant.HTML.Blaze
+  , module Text.Blaze.Html
+  , module Data.Swagger
+  , module RFC.Data.IdAnd
+  ) where
+
+import RFC.Prelude
+import Servant
+import qualified RFC.Redis as Redis
+import qualified RFC.Psql as Psql
+import RFC.JSON
+import RFC.HTTP.Client
+import Data.Aeson as JSON
+import Servant.Docs hiding (API)
+import Servant.HTML.Blaze (HTML)
+import Text.Blaze.Html
+import Data.Swagger (Swagger, ToSchema)
+import Network.Wreq.Session as Wreq
+import qualified Data.Aeson.Diff as JSON
+import Database.PostgreSQL.Simple (SqlError(..))
+import RFC.Data.IdAnd
+import qualified Data.Map.Strict as Map
+
+type ApiCtx =
+  ReaderT Wreq.Session
+    ( ReaderT Psql.ConnectionPool
+      ( ReaderT Redis.ConnectionPool
+        Handler
+      )
+    )
+
+instance HasAPIClient ApiCtx where
+  getAPIClient = ask
+
+instance Psql.HasPsql ApiCtx where
+  getPsqlPool = lift ask
+
+instance Redis.HasRedis ApiCtx where
+  getRedisPool = lift $ lift ask
+
+apiCtxToHandler :: Wreq.Session -> Redis.ConnectionPool -> Psql.ConnectionPool -> ApiCtx :~> Handler
+apiCtxToHandler apiClient redisPool psqlPool = NT toHandler
+  where
+    toHandler :: forall a. ApiCtx a -> Handler a
+    toHandler a = withRedis $ withPsql $ withAPIClient a
+      where
+        withAPIClient m = runReaderT m apiClient
+        withRedis m = runReaderT m redisPool
+        withPsql m = runReaderT m psqlPool
+
+type FetchAllImpl a = ApiCtx (Map UUID (IdAnd a))
+type FetchAllAPI a = Get '[JSON] (Map UUID (IdAnd a))
+type FetchImpl a = UUID -> ApiCtx (IdAnd a)
+type FetchAPI a = Capture "id" UUID :> Get '[JSON] (IdAnd a)
+type CreateImpl a = a -> ApiCtx (IdAnd a)
+type CreateAPI a = ReqBody '[JSON] a :> Post '[JSON] (IdAnd a)
+type PatchImpl a = UUID -> JSON.Patch -> ApiCtx (IdAnd a)
+-- type PatchAPI a = Capture "id" UUID :> ReqBody '[JSON] JSON.Patch :> Patch '[JSON] (IdAnd a)
+type ReplaceImpl a = UUID -> a -> ApiCtx (IdAnd a)
+type ReplaceAPI a = Capture "id" UUID :> ReqBody '[JSON] a :> Post '[JSON] (IdAnd a)
+
+type ServerImpl a =
+  (FetchAllImpl a)
+  :<|> (FetchImpl a)
+  :<|> (CreateImpl a)
+  -- :<|> (PatchImpl a)
+  :<|> (ReplaceImpl a)
+type ServerAPI a =
+  (FetchAllAPI a)
+  :<|> (FetchAPI a)
+  :<|> (CreateAPI a)
+  -- :<|> (PatchAPI a)
+  :<|> (ReplaceAPI a)
+
+
+class (FromJSON a, ToJSON a, Show a) => ResourceDefinition a where
+  restFetchAll :: FetchAllImpl a
+  restFetchAll = do
+    resources <- fetchAllResources
+    return $ Map.fromList $ map idAndToPair resources
+
+  restFetch :: FetchImpl a
+  restFetch uuid = do
+    maybeResource <- fetchResource uuid
+    case maybeResource of
+      Nothing -> throwError $ err404
+        { errReasonPhrase = "No resource found for id"
+        , errBody = cs $ "Could not find a resource with UUID: " ++ show uuid
+        }
+      Just value -> return $ IdAnd (uuid, value)
+
+  restCreate :: CreateImpl a
+  restCreate a = handleDupes $ do
+      maybeId <- createResource a
+      case maybeId of
+        (Just id) -> restFetch id
+        Nothing -> throwIO $ err400
+          { errReasonPhrase = "Could not create resource"
+          , errBody = cs $ show a
+          }
+
+  restPatch :: PatchImpl a
+  restPatch id patch = handleDupes $ do
+    (IdAnd (_,original::a)) <- restFetch id
+    case JSON.patch patch $ toJSON original of
+      Error str -> throwError $ err400
+        { errReasonPhrase = "Error applying patch"
+        , errBody = cs str
+        }
+      Success jsonValue ->
+        case JSON.eitherDecode' $ JSON.encode jsonValue of
+          Left err -> throwError $ err400
+            { errReasonPhrase = "Error rebuilding object after patch"
+            , errBody = cs err
+            }
+          Right value -> restReplace id value
+
+  restReplace :: ReplaceImpl a
+  restReplace id value = handleDupes $ do
+      replaceResource newValue
+      restFetch id
+    where
+      newValue = IdAnd (id,value)
+
+  restServer :: ServerImpl a
+  restServer =
+    restFetchAll
+    :<|> restFetch
+    :<|> restCreate
+    -- :<|> restPatch
+    :<|> restReplace
+
+  fetchResource :: UUID -> ApiCtx (Maybe a)
+  fetchAllResources :: ApiCtx [IdAnd a]
+  createResource :: a -> ApiCtx (Maybe UUID)
+  replaceResource :: (IdAnd a) -> ApiCtx ()
+
+handleDupes :: ApiCtx a -> ApiCtx a
+handleDupes =
+    handleJust isDuplicate throwUp
+  where
+    throwUp err = throwError $ err409
+      { errReasonPhrase = cs $ sqlErrorMsg err
+      , errBody = cs $ sqlErrorDetail err
+      }
+    isDuplicate (sqle::SqlError)
+      | sqlState sqle  == "23505" = Just sqle
+    isDuplicate _ = Nothing
+
diff --git a/src/RFC/Servant/ApiDoc.hs b/src/RFC/Servant/ApiDoc.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Servant/ApiDoc.hs
@@ -0,0 +1,26 @@
+module RFC.Servant.ApiDoc
+  ( apiToHtml
+  , apiToAscii
+  , apiToSwagger
+  ) where
+
+import RFC.Prelude
+import RFC.String
+import RFC.Servant
+import Servant.Swagger
+import Data.Default (def)
+import qualified Text.Markdown as MD
+
+apiToHtml :: (HasDocs a) => Proxy a -> Html
+apiToHtml = preEscapedToHtml . (MD.markdown mdSettings) . cs . markdown . docs
+  where
+    mdSettings = def
+      { MD.msLinkNewTab = False
+      , MD.msAddHeadingId = True
+      }
+
+apiToAscii :: (ConvertibleString String s, HasDocs a) => Proxy a -> s
+apiToAscii = cs . markdown . docs
+
+apiToSwagger :: (HasSwagger a) => Proxy a -> Swagger
+apiToSwagger = toSwagger
diff --git a/src/RFC/String.hs b/src/RFC/String.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/String.hs
@@ -0,0 +1,14 @@
+module RFC.String
+  ( module RFC.String
+  , module Data.String.Conversions
+  , module Data.String.Conversions.Monomorphic
+  ) where
+
+import Data.String.Conversions hiding ((<>))
+import Data.String.Conversions.Monomorphic hiding (fromString, toString)
+
+type ConvertibleString = ConvertibleStrings -- I keep forgetting to pluralize this.
+type ConvertibleToSBS a = ConvertibleStrings a StrictByteString
+type ConvertibleFromSBS a = ConvertibleStrings StrictByteString a
+
+
diff --git a/src/RFC/Throttle.hs b/src/RFC/Throttle.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Throttle.hs
@@ -0,0 +1,33 @@
+module RFC.Throttle
+  ( createThrottle
+  , withThrottle
+  , Throttle
+  ) where
+
+import RFC.Prelude
+import Data.Pool
+import GHC.Conc (numCapabilities)
+
+newtype Throttle = Throttle (Pool ())
+
+createThrottle :: (MonadIO m)  => Int -> m Throttle
+createThrottle maxSimultaneous = do
+    let stripes = min maxSimultaneous $ log2 numCapabilities
+    let perStripe = maxPerStripe stripes
+    liftIO $ Throttle <$> createPool
+      ioUnit
+      (const ioUnit)
+      stripes
+      0.5
+      perStripe
+  where
+    ioUnit = return () :: IO ()
+    maxPerStripe :: Int -> Int
+    maxPerStripe stripes = max 1 $ maxSimultaneous `quot` stripes
+    log2 :: Int -> Int
+    log2 x
+      | (toInteger x) <= 2 = 1
+      | otherwise = 1 + log2 (x `quot` 2)
+
+withThrottle :: (MonadBaseControl IO m) => Throttle -> m b -> m b
+withThrottle (Throttle pool) action = withResource pool (const action)
diff --git a/src/RFC/Wai.hs b/src/RFC/Wai.hs
new file mode 100644
--- /dev/null
+++ b/src/RFC/Wai.hs
@@ -0,0 +1,54 @@
+module RFC.Wai
+  ( defaultMiddleware
+  ) where
+
+import RFC.Prelude
+import RFC.Env (isDevelopment)
+import Network.Wai
+import Network.Wai.Middleware.AcceptOverride
+import Network.Wai.Middleware.Approot (envFallback)
+import Network.Wai.Middleware.Autohead
+import Network.Wai.Middleware.Gzip
+import Network.Wai.Middleware.Jsonp
+import Network.Wai.Middleware.MethodOverridePost
+import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
+import System.IO.Temp (getCanonicalTemporaryDirectory, createTempDirectory)
+import Network.Wai.Middleware.Cors
+import Network.HTTP.Types.Method
+import Network.HTTP.Types.Header
+
+defaultMiddleware :: IO Middleware
+defaultMiddleware = do
+  isDev <- isDevelopment
+  approot <- envFallback
+  tmpDir <- getCanonicalTemporaryDirectory
+  gzipDir <- createTempDirectory tmpDir "wai-gzip-middleware"
+  return $
+    methodOverridePost .
+    acceptOverride .
+    (cors $ const $ Just corsConfig).
+    autohead .
+    jsonp .
+    approot .
+    gzip (gzipConfig gzipDir) .
+    (if isDev then logStdoutDev else logStdout)
+  where
+    corsConfig = simpleCorsResourcePolicy
+      { corsRequireOrigin = False
+      , corsVaryOrigin = False
+      , corsMaxAge = Nothing
+      , corsRequestHeaders = hContentType : simpleHeaders
+      , corsMethods =
+        [ methodGet
+        , methodPost
+        , methodHead
+        , methodDelete
+        , methodPatch
+        , methodOptions
+        , methodPut
+        ]
+      }
+    gzipConfig gzipDir = def
+      { gzipFiles = GzipCacheFolder gzipDir
+      , gzipCheckMime = const True
+      }