diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Andrew Miller (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 Andrew Miller 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,6 @@
+# polysemy-webserver
+
+A simple wrapper around Warp and Wai to make it easier to write web servers
+using Polysemy.
+
+See test/Spec.hs for a simple example of how to use it.
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/polysemy-webserver.cabal b/polysemy-webserver.cabal
new file mode 100644
--- /dev/null
+++ b/polysemy-webserver.cabal
@@ -0,0 +1,65 @@
+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: 1125f9e81101158130a70f12db4783c3043caf583c7f7d28e039506c7aed885b
+
+name:           polysemy-webserver
+version:        0.1.0.0
+synopsis:       Start web servers from within a Polysemy effect stack
+description:    Please see the README on GitLab at <https://gitlab.com/A1kmm/polysemy-webserver/-/blob/master/README.md>
+category:       Web
+author:         Andrew Miller
+maintainer:     andrew@amxl.com
+copyright:      Copyright (C) 2020 Andrew Miller
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+
+source-repository head
+  type: git
+  location: https://gitlab.com/A1kmm/polysemy-webserver
+
+library
+  exposed-modules:
+      Polysemy.WebServer
+  other-modules:
+      Paths_polysemy_webserver
+  hs-source-dirs:
+      src
+  default-extensions: DataKinds FlexibleContexts GADTs LambdaCase PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeOperators TypeFamilies
+  ghc-options: -O2 -flate-specialise -fspecialise-aggressively -Wall -fno-warn-orphans -fplugin=Polysemy.Plugin
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , http-types
+    , polysemy
+    , polysemy-plugin
+    , wai
+    , warp
+  default-language: Haskell2010
+
+test-suite polysemy-webserver-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_polysemy_webserver
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , hspec
+    , http-conduit
+    , http-types
+    , polysemy
+    , polysemy-plugin
+    , polysemy-webserver
+    , wai
+    , warp
+  default-language: Haskell2010
diff --git a/src/Polysemy/WebServer.hs b/src/Polysemy/WebServer.hs
new file mode 100644
--- /dev/null
+++ b/src/Polysemy/WebServer.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Polysemy.WebServer (WebServer, PendingWebRequest, startWebServer,
+  respondWebRequest, getBody, runWebServerFinal) where
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Network.HTTP.Types.Status as HTTP
+import Polysemy
+import Polysemy.Final
+import Data.Functor
+import Control.Monad
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+
+newtype PendingWebRequest =
+  PendingWebRequest (Wai.Response -> IO Wai.ResponseReceived)
+
+data WebServer m a where
+  StartWebServer :: Warp.Port -> (
+    Wai.Request -> PendingWebRequest -> m Wai.ResponseReceived) ->
+    WebServer m ()
+  RespondWebRequest :: PendingWebRequest -> Wai.Response ->
+                       WebServer m Wai.ResponseReceived
+  GetBody :: Int -> Wai.Request -> WebServer m (Maybe BS.ByteString)
+makeSem ''WebServer
+
+runStartWebServer :: forall rInitial r f.
+  ((Final IO) `Member` r, Functor f) =>
+  Warp.Port -> (
+    Wai.Request -> PendingWebRequest ->
+    Sem rInitial Wai.ResponseReceived) ->
+  Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
+runStartWebServer port app = do
+  s0 <- getInitialStateT
+  appFnS <- bindT $ uncurry app
+  ins <- getInspectorT
+  let
+    appFn :: (Wai.Request, PendingWebRequest) ->
+             Sem r (Maybe Wai.ResponseReceived)
+    appFn = runWebServerFinal . (fmap (inspect ins)) . appFnS . (s0 $>)
+  withStrategicToFinal $ do
+    appFnS' <- bindS (raise . appFn)
+    ins' <- getInspectorS
+    s1 <- getInitialStateS
+    let
+      appFn' :: (Wai.Request, PendingWebRequest) ->
+                IO (Maybe Wai.ResponseReceived)
+      appFn' = (fmap (join . inspect ins')) . appFnS' . (s1 $>)
+    return $ do
+      let
+        doRequestIO :: Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) ->
+                       IO Wai.ResponseReceived
+        doRequestIO req respond = do
+          maybeRR <- appFn' (req, PendingWebRequest respond)
+          case maybeRR of
+            Just rr -> return rr
+            Nothing -> respond $
+              Wai.responseLBS (HTTP.status500) [] "Internal server error"
+          
+      Warp.run port $ \req reply -> doRequestIO req reply
+      return $ s1 $> s0
+
+runRespondWebRequest :: forall rInitial r f.
+  ((Final IO) `Member` r, Functor f) =>
+  PendingWebRequest -> Wai.Response ->
+  Sem (WithTactics WebServer f (Sem rInitial) r) (f Wai.ResponseReceived)
+runRespondWebRequest (PendingWebRequest respond) resp = do
+  s0 <- getInitialStateT
+  withStrategicToFinal $ do
+    s1 <- getInitialStateS
+    return $ do
+      rr <- respond (resp)
+      return $ s1 $> (s0 $> rr)
+
+runGetBody :: forall rInitial r f.
+  ((Final IO) `Member` r, Functor f) =>
+  Int -> Wai.Request ->
+  Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe BS.ByteString))
+runGetBody maxLen req = do
+  body <- embedFinal $ Wai.lazyRequestBody req
+  let strictBody = LBS.toStrict $ LBS.take (fromIntegral $ maxLen + 1) body
+  if BS.length strictBody > maxLen
+    then pureT Nothing
+    else pureT (Just strictBody)
+
+runWebServerFinal :: ((Final IO) `Member` r) =>
+                     Sem (WebServer ': r) a -> Sem r a
+runWebServerFinal =
+  interpretH (\v -> case v of
+                 StartWebServer port app -> runStartWebServer port app
+                 RespondWebRequest reqId response -> runRespondWebRequest reqId response
+                 GetBody maxLen req -> runGetBody maxLen req
+             )
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Polysemy
+import Polysemy.Final
+import Polysemy.WebServer
+import qualified Data.ByteString.Lazy as LBS
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Network.HTTP.Types.Status as HTTP
+import Network.HTTP.Simple
+import Polysemy.Async
+import Test.Hspec
+
+testServerApp :: WebServer `Member` r =>
+  Wai.Request -> PendingWebRequest -> Sem r Wai.ResponseReceived
+testServerApp _req pendingReq = respondWebRequest pendingReq (
+  Wai.responseLBS (HTTP.status200) [] "Success")
+
+main :: IO ()
+main = runFinal . runWebServerFinal . asyncToIOFinal $ do
+  -- With the WebServer effect, start a new server...
+  async $ startWebServer 8123 testServerApp
+
+  embedFinal . hspec $ do
+    describe "Web Server" $ do
+      it "should respond to requests" $ do
+        -- Use a client library to test...
+        req <- parseRequest "http://localhost:8123/"
+        resp <- httpLBS req
+        getResponseStatusCode resp `shouldBe` 200
+        getResponseBody resp `shouldBe` "Success"