diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Andrew Martin (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 Andrew Martin 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/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Trasa/Server.hs b/src/Trasa/Server.hs
new file mode 100644
--- /dev/null
+++ b/src/Trasa/Server.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-# OPTIONS_GHC -Wall -Werror #-}
+module Trasa.Server
+  ( TrasaT
+  , runTrasaT
+  , serveWith
+  ) where
+
+import Control.Monad (join)
+import Data.Traversable (for)
+import Data.Functor.Identity
+
+import Network.HTTP.Types.Header (hAccept,hContentType)
+import qualified Network.HTTP.Types.Status as S
+import Data.CaseInsensitive (CI)
+import qualified Network.Wai as WAI
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Map.Strict as M
+import Control.Monad.Reader (ReaderT,runReaderT,MonadReader(..),MonadTrans(..))
+import Control.Monad.Except (ExceptT,runExceptT,MonadError(..),MonadIO(..))
+import Control.Monad.State.Strict (StateT,runStateT,MonadState(..))
+
+import Trasa.Core
+
+type Headers = M.Map (CI BS.ByteString) T.Text
+
+newtype TrasaT m a = TrasaT
+  { unTrasaT :: ExceptT TrasaErr (StateT Headers (ReaderT Headers m)) a
+  } deriving
+  ( Functor
+  , Applicative
+  , Monad
+  , MonadError TrasaErr
+  , MonadIO
+  , MonadState (M.Map (CI BS.ByteString) T.Text)
+  , MonadReader (M.Map (CI BS.ByteString) T.Text))
+
+instance MonadTrans TrasaT where
+  lift = TrasaT . lift . lift . lift
+
+runTrasaT
+  :: TrasaT m a
+  -> M.Map (CI BS.ByteString) T.Text -- ^ Headers
+  -> m (Either TrasaErr a, M.Map (CI BS.ByteString) T.Text)
+runTrasaT trasa headers = (flip runReaderT headers . flip runStateT M.empty . runExceptT  . unTrasaT) trasa
+
+serveWith
+  :: (forall caps qrys req resp. route caps qrys req resp -> Rec (Query CaptureDecoding) qrys)
+  -- ^ How to decode the query parameters from a route
+  -> (forall caps qrys req resp. route caps qrys req resp -> RequestBody (Many BodyDecoding) req)
+  -- ^ How to decode the request body from a route
+  -> (forall caps qrys req resp. route caps qrys req resp -> ResponseBody (Many BodyEncoding) resp)
+  -- ^ How to encode the response body from a route
+  -> (forall caps qrys req resp.
+         route caps qrys req resp
+      -> Rec Identity caps
+      -> Rec Parameter qrys
+      -> RequestBody Identity req
+      -> TrasaT IO resp)
+  -- ^ Actions to perform when requests come in
+  -> Router route -- ^ Router
+  -> WAI.Application -- ^ WAI Application
+serveWith toQuerys toReqBody toRespBody makeResponse router =
+  \req respond ->
+    case TE.decodeUtf8' (WAI.requestMethod req) of
+      Left _ -> respond (WAI.responseLBS S.status400 [] "Non utf8 encoded request method")
+      Right method -> case parseHeaders req of
+        Left _ -> respond (WAI.responseLBS S.status400 [] "Non utf8 encoded headers")
+        Right headers -> case parseAccepts headers of
+          Nothing -> respond (WAI.responseLBS S.status415 [] "Accept header missing")
+          Just accepts -> do
+            content <- for (M.lookup hContentType headers) $ \typ ->
+              Content typ <$> WAI.strictRequestBody req
+            let url = Url (WAI.pathInfo req) (decodeQuery (WAI.queryString req))
+                dispatch = dispatchWith toQuerys toReqBody toRespBody makeResponse router method accepts url content
+            runTrasaT dispatch headers >>= \case
+              (resErr,newHeaders) -> case join resErr of
+                Left (TrasaErr stat errBody) ->
+                  respond (WAI.responseLBS stat (encodeHeaders newHeaders) errBody)
+                Right (Content typ lbs) -> do
+                  let encodedHeaders = encodeHeaders (M.insert hContentType typ newHeaders)
+                  respond (WAI.responseLBS S.status200 encodedHeaders lbs)
+  where
+    encodeHeaders = M.toList . fmap TE.encodeUtf8
+    parseHeaders = traverse TE.decodeUtf8' . M.fromList . WAI.requestHeaders
+    parseAccepts = fmap (fmap T.strip . T.splitOn (T.singleton ',')) . M.lookup hAccept
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+import Trasa.Core
+import Trasa.Server
+import Data.Vinyl
+import Data.Functor.Identity
+import Data.Kind (Type)
+import Text.Read (readMaybe)
+import Network.Wai.Handler.Warp (withApplication)
+import qualified Data.Text as T
+import qualified Data.ByteString.Lazy.Char8 as LBSC
+import qualified Network.HTTP.Client as HC
+
+main :: IO ()
+main = do
+  putStrLn "\nStarting trasa server test suite"
+  let app = serveWith
+        (mapQuery captureCodecToCaptureDecoding . metaQuery . meta)
+        (mapRequestBody (Many . pure . bodyCodecToBodyDecoding) . metaRequestBody . meta)
+        (mapResponseBody (Many . pure . bodyCodecToBodyEncoding) . metaResponseBody . meta)
+        handle
+        router
+  withApplication (return app) $ \port -> do
+    manager <- HC.newManager HC.defaultManagerSettings
+    attempt manager ("GET http://127.0.0.1:" ++ show port ++ "/") $ \x -> x
+      { HC.requestHeaders = [("Accept","text/plain"),("ContentType","text/plain")]
+      }
+    attempt manager ("GET http://127.0.0.1:" ++ show port ++ "/hello") $ \x -> x
+      { HC.requestHeaders = [("Accept","text/plain"),("ContentType","text/plain")]
+      }
+    return ()
+
+attempt :: HC.Manager -> String -> (HC.Request -> HC.Request) -> IO ()
+attempt mngr url modify = do
+  req <- HC.parseUrlThrow url
+  let req' = modify req
+  _ <- HC.httpLbs req' mngr
+  return ()
+
+handle :: Route caps qrys req resp -> Rec Identity caps -> Rec Parameter qrys -> RequestBody Identity req -> TrasaT IO resp
+handle r = case r of
+  EmptyR -> \_ _ _ -> return (55 :: Int)
+  HelloR -> \_ _ _ -> return (67 :: Int)
+
+data Route :: [Type] -> [Param] -> Bodiedness -> Type -> Type where
+  EmptyR :: Route '[] '[] Bodyless Int
+  HelloR :: Route '[] '[] Bodyless Int
+  AdditionR :: Route '[Int,Int] '[Optional Int] Bodyless Int
+  IdentityR :: Route '[String] '[] Bodyless String
+  LeftPadR :: Route '[Int] '[] (Body String) String
+  TrickyOneR :: Route '[Int] '[] Bodyless String
+  TrickyTwoR :: Route '[Int,Int] '[] Bodyless String
+
+
+prepare :: Route cs qs rq rp -> Arguments cs qs rq (Prepared Route rp)
+prepare = prepareWith (metaPath . meta) (metaQuery . meta) (metaRequestBody . meta)
+
+link :: Prepared Route rp -> Url
+link = linkWith
+  (mapPath (CaptureEncoding . captureCodecEncode) . metaPath . meta)
+  (mapQuery captureCodecToCaptureEncoding . metaQuery . meta)
+
+parse :: T.Text -> Maybe Content -> Either TrasaErr (Concealed Route)
+parse url = parseWith
+  (mapQuery captureCodecToCaptureDecoding . metaQuery . meta)
+  (mapRequestBody (Many . pure . bodyCodecToBodyDecoding) . metaRequestBody . meta)
+  router
+  "GET"
+  (decodeUrl url)
+
+allRoutes :: [Constructed Route]
+allRoutes = 
+  [ Constructed HelloR
+  , Constructed AdditionR
+  , Constructed IdentityR
+  , Constructed LeftPadR
+  , Constructed TrickyOneR
+  , Constructed TrickyTwoR
+  , Constructed EmptyR
+  ]
+
+router :: Router Route
+router = routerWith
+  (metaMethod . meta)
+  (mapPath (CaptureDecoding . captureCodecDecode) . metaPath . meta)
+  allRoutes
+
+data Meta ps qs rq rp = Meta
+  { metaPath :: Path CaptureCodec ps
+  , metaQuery :: Rec (Query CaptureCodec) qs
+  , metaRequestBody :: RequestBody BodyCodec rq
+  , metaResponseBody :: ResponseBody BodyCodec rp
+  , metaMethod :: T.Text
+  }
+
+meta :: Route ps qs rq rp -> Meta ps qs rq rp
+meta x = case x of
+  EmptyR -> Meta
+    end
+    qend
+    bodyless (resp bodyInt) "GET"
+  HelloR -> Meta
+    (match "hello" ./ end)
+    qend
+    bodyless (resp bodyInt) "GET"
+  AdditionR -> Meta
+    (match "add" ./ capture int ./ capture int ./ end)
+    (optional "more" int .& qend)
+    bodyless (resp bodyInt) "GET"
+  IdentityR -> Meta
+    (match "identity" ./ capture string ./ end)
+    qend
+    bodyless (resp bodyString) "GET"
+  LeftPadR -> Meta
+    (match "pad" ./ match "left" ./ capture int ./ end)
+    qend
+    (body bodyString) (resp bodyString) "GET"
+  TrickyOneR -> Meta
+    (match "tricky" ./ capture int ./ match "one" ./ end)
+    qend
+    bodyless (resp bodyString) "GET"
+  TrickyTwoR -> Meta
+    (capture int ./ capture int ./ match "two" ./ end)
+    qend
+    bodyless (resp bodyString) "GET"
+
+
+int :: CaptureCodec Int
+int = CaptureCodec (T.pack . show) (readMaybe . T.unpack)
+
+string :: CaptureCodec String
+string = CaptureCodec T.pack (Just . T.unpack)
+
+bodyString :: BodyCodec String
+bodyString = BodyCodec (pure "text/plain") LBSC.pack (Right . LBSC.unpack)
+
+bodyUnit :: BodyCodec ()
+bodyUnit = BodyCodec (pure "text/plain") (const "") (const (Right ()))
+
+note :: e -> Maybe a -> Either e a
+note e Nothing = Left e
+note _ (Just x) = Right x
+
+bodyInt :: BodyCodec Int
+bodyInt = BodyCodec (pure "text/plain") (LBSC.pack . show)
+                    (note "Could not decode int" . readMaybe . LBSC.unpack)
diff --git a/trasa-server.cabal b/trasa-server.cabal
new file mode 100644
--- /dev/null
+++ b/trasa-server.cabal
@@ -0,0 +1,52 @@
+name: trasa-server
+version: 0.1
+synopsis: Type safe web server
+homepage: https://github.com/haskell-trasa/trasa#readme
+license: BSD3
+license-file: LICENSE
+author: Kyle McKean
+maintainer: mckean.kylej@gmail.com
+copyright: 2017 Kyle McKean
+category: Web
+build-type: Simple
+cabal-version: >=1.10
+description: WAI integration for trasa
+
+library
+  hs-source-dirs: src
+  exposed-modules:
+    Trasa.Server
+  build-depends:
+      base >= 4.7 && < 5
+    , bytestring == 0.10.*
+    , text == 1.2.*
+    , wai == 3.2.*
+    , http-types == 0.9.*
+    , case-insensitive == 1.2.*
+    , containers == 0.5.*
+    , mtl == 2.2.*
+    , trasa
+  default-language: Haskell2010
+
+test-suite test
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Main.hs
+  build-depends: 
+      base
+    , trasa
+    , trasa-server
+    , tasty
+    , tasty-quickcheck
+    , tasty-hunit
+    , bytestring
+    , text
+    , vinyl
+    , doctest
+    , warp
+    , http-client
+  default-language: Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/haskell-trasa/trasa