diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,34 @@
+0.9.4
+=====
+
+* Combine the multiple header fields into one "field-name: field-value" pair
+  with a comma-separated list for the field-value (Instead of removing duplicates).
+* `sproxy [ -h | --help ]` works (using [docopt](https://hackage.haskell.org/package/docopt))
+* Stop counting client parsing failures as errors.
+
+
+0.9.3
+=====
+
+* Made some options in configuration file optional with reasonable default values:
+  - `log_target`: `stderr`
+  - `listen`: `443`
+  - `redirect_http_to_https`: yes if `listen == 443`
+  - `backend_address`: `"127.0.0.1"`
+  - `backend_port`: `8080`
+* Allow backend at UNIX socket: new option `backend_socket`.
+* Removed tests (unsupported).
+* Don't build Sproxy library.
+
+
+0.9.2
+=====
+
+* Deny SSLv3.
+
+* Removed the `auth_token_key` option from the config file.
+  The token is generated randomly on startup.
+	Restarting sproxy invalidates existing sessions.
+
+* Added `ChangeLog.md`
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,19 @@
+Copyright (c) 2013-2016 Zalora South East Asia Pte. Ltd
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,154 @@
+# sproxy - secure proxy - HTTP proxy for authenticating users via Google OAuth2
+
+## Motivation
+
+Why use a proxy for doing OAuth? Isn't that up to the application?
+
+ * sproxy is secure by default.  No requests make it to the web server if they
+   haven't been explicitly whitelisted.
+ * sproxy is independent.  Any web application written in any language can use
+   it.
+
+## How it Works
+
+When an HTTP client makes a request, sproxy checks for a *session cookie*.  If it
+doesn't exist (or it's invalid), it redirects the client to a Google
+authentication page.  The user is then prompted to allow the application to
+access information on the user (email address).  If the user proceeds, they're
+redirected back to sproxy with a code from Google.  We then take that code and
+send it to Google ourselves to get back an access token.  Then, we use the
+access token to make another call to Google, this time to their user info API
+to retrieve the user's email address.  Finally, we store the the email address
+in a session cookie: signed with a hash to prevent tampering, set for HTTP only (to
+prevent malicious JavaScript from reading it), and set it for secure (since we
+don't want it traveling over plaintext HTTP connections).
+
+From that point on, when sproxy detects a valid session cookie it extracts the
+email, checks it against the access rules, and relays the request to the
+back-end server (if allowed).
+
+## Logout
+
+Hitting the endpoint `/sproxy/logout` will invalidate the session
+cookie.  The user will be redirected to `/` after logout.  The
+query parameter `state` can be provided to specify an alternate redirect path
+(the path has to be percent-encoded, e.g. with `urlEncode` from
+`Network.HTTP.Types.URI`).
+
+## Robots
+
+Since all sproxied resources are private, it doesn't make sense for web crawlers
+to try to index them. In fact, crawlers will index only the Google authentication
+page. To prevent this, sproxy returns the following for `/robots.txt`:
+
+```
+User-agent: *
+Disallow: /
+```
+
+## Permissions system
+
+Permissions are stored in a PostgreSQL database. See sproxy.sql for details.
+Here are the main concepts:
+
+- A `group` is identified by a name. Every group has
+  - members (identified by email address, through `group_member`) and
+  - associated privileges (through `group_privilege`).
+- A `privilege` is identified by a name _and_ a domain. It has associated rules
+  (through `privilege_rule`) that define what the privilege gives access to.
+- A `rule` is a combination of sql patterns for a `domain`, a `path` and an
+  HTTP `method`. A rule matches an HTTP request, if all of these components
+  match the respective attributes of the request. However of all the matching
+  rules only the rule with the longest `path` pattern will be used to determine
+  whether a user is allowed to perform a request. This is often a bit
+  surprising, please see the following example:
+
+### Privileges example
+
+Consider this `group_privilege` and `privilege_rule` relations:
+
+group            | privilege | domain
+---------------- | --------- | -----------------
+`readers`        | `basic`   | `wiki.zalora.com`
+`readers`        | `read`    | `wiki.zalora.com`
+`editors`        | `basic`   | `wiki.zalora.com`
+`editors`        | `read`    | `wiki.zalora.com`
+`editors`        | `edit`    | `wiki.zalora.com`
+`administrators` | `basic`   | `wiki.zalora.com`
+`administrators` | `read`    | `wiki.zalora.com`
+`administrators` | `edit`    | `wiki.zalora.com`
+`administrators` | `admin`   | `wiki.zalora.com`
+
+privilege   | domain            | path           | method
+----------- | ----------------- | -------------- | ------
+`basic`     | `wiki.zalora.com` | `/%`           | `GET`
+`read`      | `wiki.zalora.com` | `/wiki/%`      | `GET`
+`edit`      | `wiki.zalora.com` | `/wiki/edit/%` | `%`
+`admin`     | `wiki.zalora.com` | `/admin/%`     | `%`
+
+With this setup, everybody (that is `readers`, `editors` and `administrators`s)
+will have access to e.g. `/imgs/logo.png` and `/favicon.ico`, but only
+administrators will have access to `/admin/index.php`, because the longest
+matching path pattern is `/admin/%` and only `administrator`s have the `admin`
+privilege.
+
+Likewise `readers` have no access to e.g. `/wiki/edit/delete_everything.php`.
+
+
+## HTTP headers passed to the back-end server:
+
+header               | value
+-------------------- | -----
+`From:`              | visitor's email address
+`X-Groups:`          | all groups that granted access to this resource, separated by commas (see the note below)
+`X-Given-Name:`      | the visitor's given (first) name
+`X-Family-Name:`     | the visitor's family (last) name
+`X-Forwarded-Proto:` | the visitor's protocol of an HTTP request, always `https`
+`X-Forwarded-For`    | the visitor's IP address (added to the end of the list if header is already present in client request)
+
+
+`X-Groups` denotes an intersection of the groups the visitor belongs to and the groups that granted access:
+
+Visitor's groups | Granted groups | `X-Groups`
+---------------- | -------------- | ---------
+all              | all, devops    | all
+all, devops      | all            | all
+all, devops      | all, devops    | all,devops
+all, devops      | devops         | devops
+devops           | all, devops    | devops
+devops           | all            | Access denied
+
+## Configuration File
+
+By default `sproxy` will read its configuration from `config/sproxy.yml`.  You
+can specify a custom path with:
+
+```
+sproxy --config /path/to/sproxy.yml
+```
+
+## Development
+
+```
+$ cp config/sproxy.yml.example config/sproxy.yml
+```
+
+Make sure that you have the following entry in `/etc/hosts`:
+
+```
+127.0.0.1       dev.zalora.com
+```
+
+
+### Create OAuth credentials
+
+Create a project in the [Google Developers Console](https://console.developers.google.com/project).
+
+ - visit *APIs & auth* -> *Credentials*
+ - select *CREATE NEW CLIENT ID*
+ - use `https://dev.zalora.com` as *Authorized JavaScript origins*
+ - use `https://dev.zalora.com/sproxy/oauth2callback` as *Authorized redirect URI*
+
+Put the `Client ID` in `config/sproxy.yml` and the `Client secret` in a file
+called `config/client_secret`.
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/sproxy.cabal b/sproxy.cabal
new file mode 100644
--- /dev/null
+++ b/sproxy.cabal
@@ -0,0 +1,60 @@
+name: sproxy
+version: 0.9.4
+synopsis: HTTP proxy for authenticating users via Google OAuth2
+license: MIT
+license-file: LICENSE
+copyright: 2013-2016, Zalora South East Asia Pte. Ltd
+author: Chris Forno <jekor@jekor.com>
+maintainer: Igor Pashev <pashev.igor@gmail.com>
+category: Web
+build-type: Simple
+extra-source-files: README.md ChangeLog.md
+cabal-version: >=1.10
+data-files: sproxy.sql
+
+executable sproxy
+  main-is: Main.hs
+  other-modules:
+      Authenticate
+    , Authorize
+    , ConfigFile
+    , Cookies
+    , HTTP
+    , Logging
+    , Proxy
+    , Type
+    , Util
+
+  hs-source-dirs: src
+  default-language: Haskell2010
+  ghc-options: -Wall -static
+  build-depends:
+      base >= 4.8 && < 5
+    , SHA
+    , aeson >= 0.7.0.4
+    , attoparsec
+    , base64-bytestring
+    , bytestring
+    , containers >= 0.5
+    , data-default
+    , docopt >= 0.7
+    , entropy
+    , http-conduit >= 2.1.8
+    , http-kit >= 0.5
+    , http-types >= 0.8.5
+    , interpolatedstring-perl6
+    , logging-facade
+    , logsink
+    , network
+    , postgresql-simple
+    , raw-strings-qq >= 1.1
+    , resource-pool
+    , split
+    , string-conversions
+    , time
+    , tls >= 1.3.3
+    , unix
+    , utf8-string
+    , x509
+    , yaml >= 0.8
+
diff --git a/sproxy.sql b/sproxy.sql
new file mode 100644
--- /dev/null
+++ b/sproxy.sql
@@ -0,0 +1,148 @@
+-- CREATE DATABASE sproxy;
+-- CREATE ROLE sproxy WITH LOGIN;
+-- GRANT SELECT ON ALL TABLES IN SCHEMA public TO sproxy;
+
+CREATE TABLE IF NOT EXISTS "group" (
+  "group" TEXT NOT NULL PRIMARY KEY
+);
+
+-- | group        |
+-- |--------------|
+-- | data science |
+-- | devops       |
+-- | all          |
+-- | regional     |
+-- | SG HQ        |
+
+CREATE EXTENSION IF NOT EXISTS citext;
+
+CREATE TABLE IF NOT EXISTS group_member (
+  "group" TEXT REFERENCES "group" ("group") ON UPDATE CASCADE ON DELETE CASCADE NOT NULL,
+  email citext NOT NULL,
+  PRIMARY KEY ("group", email)
+);
+
+-- | group        | email                  |
+-- |--------------+------------------------|
+-- | data science | blah@zalora.com        |
+-- | data science | foo@zalora.com         |
+-- | devops       | devops1@zalora.com     |
+-- | devops       | devops2@zalora.com     |
+-- | all          | %@zalora.com           |
+-- | all          | %@zalora.sg            |
+-- | all          | %@zalora.vn            |
+-- | all          | %@zalora.com.hk        |
+-- | all          | %@zalora.com.my        |
+-- | all          | %@zalora.com.ph        |
+-- | all          | %@zalora.co.id         |
+-- | all          | %@zalora.co.th         |
+-- | regional     | %@zalora.com           |
+-- | SG           | %@zalora.sg            |
+
+-- Find out which groups a user (email address) belongs to:
+-- SELECT "group" FROM group_member WHERE 'email.address' LIKE email
+
+CREATE TABLE IF NOT EXISTS domain (
+  domain TEXT NOT NULL PRIMARY KEY
+);
+
+-- | domain                |
+-- |-----------------------|
+-- | app1.zalora.com       |
+-- | app2.zalora.com       |
+-- | app3.zalora.com       |
+
+CREATE TABLE IF NOT EXISTS privilege (
+  "domain" TEXT REFERENCES domain (domain) ON UPDATE CASCADE ON DELETE CASCADE NOT NULL,
+  privilege TEXT NOT NULL,
+  PRIMARY KEY ("domain", privilege)
+);
+
+-- | domain                | privilege  |
+-- |-----------------------+------------|
+-- | app3.zalora.com       | view       |
+-- | app3.zalora.com       | export     |
+-- | app1.zalora.com       | list users |
+-- | app1.zalora.com       | add users  |
+
+CREATE TABLE IF NOT EXISTS privilege_rule (
+  "domain" TEXT NOT NULL,
+  privilege TEXT NOT NULL,
+  "path" TEXT NOT NULL,
+  "method" TEXT NOT NULL,
+  FOREIGN KEY ("domain", privilege) REFERENCES privilege ("domain", privilege) ON UPDATE CASCADE ON DELETE CASCADE,
+  PRIMARY KEY ("domain", "path", "method")
+);
+
+-- | domain                | privilege  | path      | method |
+-- |-----------------------+------------+-----------+--------|
+-- | app3.zalora.com       | view       | /%        | %      |
+-- | app3.zalora.com       | export     | /export/% | %      |
+-- | app1.zalora.com       | list users | /users    | GET    |
+-- | app1.zalora.com       | list users | /user/%   | GET    |
+-- | app1.zalora.com       | add users  | /users    | POST   |
+
+CREATE TABLE IF NOT EXISTS group_privilege (
+  "group" TEXT REFERENCES "group" ("group") ON UPDATE CASCADE ON DELETE CASCADE NOT NULL,
+  "domain" TEXT NOT NULL,
+  privilege TEXT NOT NULL,
+  FOREIGN KEY ("domain", privilege) REFERENCES privilege ("domain", privilege) ON UPDATE CASCADE ON DELETE CASCADE,
+  PRIMARY KEY ("group", "domain", privilege)
+);
+
+-- | group        | domain                | privilege  |
+-- |--------------+-----------------------+------------|
+-- | data science | app3.zalora.com       | view       |
+-- | data science | app3.zalora.com       | export     |
+-- | all          | app1.zalora.com       | list users |
+-- | devops       | app1.zalora.com       | add users  |
+
+-- Check if the user is authorized for the request. Let's break it
+-- down for understanding:
+
+-- The privilege required to access a URL is the most specific
+-- (longest) match. To determine length, we look at the number of
+-- slashes in the URL pattern (number of path components).
+--
+-- SELECT p.privilege FROM privilege p
+-- INNER JOIN privilege_rule pr ON pr."domain" = p."domain" AND pr.privilege = p.privilege
+-- WHERE 'app3.zalora.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method"
+-- ORDER by array_length(regexp_split_to_array("path", '/'), 1) DESC LIMIT 1
+--
+-- To get the groups that grant the user access, put that in a subquery:
+--
+-- SELECT gp."group" FROM group_privilege gp
+-- INNER JOIN group_member gm ON gm."group" = gp."group"
+-- WHERE 'blah@zalora.com' LIKE email
+-- AND 'app3.zalora.com' LIKE "domain"
+-- AND privilege IN (
+--   SELECT p.privilege FROM privilege p
+--   INNER JOIN privilege_rule pr ON pr."domain" = p."domain" AND pr.privilege = p.privilege
+--   WHERE 'app3.zalora.com' LIKE pr."domain" AND '/export/test' LIKE "path" AND 'GET' ILIKE "method"
+--   ORDER by array_length(regexp_split_to_array("path", '/'), 1) DESC LIMIT 1
+-- )
+--
+-- If you just want to know if a user has access or not, you can
+-- change the first line to:
+--
+-- SELECT COUNT(*) > 0 FROM group_privilege gp
+--
+-- Note for the future: If you want to support wildcards that match
+-- only a single path component (e.g. app1.zalora.com/user/:/email),
+-- you could try something like:
+--
+-- WHERE 'url' ~ regexp_replace(url, ':', '[^/]+')
+--
+-- But you'd also have to escape any regexp special characters in the
+-- url as well (i.e. dots).
+
+-- Example data for development:
+/*
+  INSERT INTO domain (domain) VALUES ('dev.zalora.com');
+  INSERT INTO "group" ("group") VALUES ('dev');
+  INSERT INTO group_member ("group", email) VALUES ('dev', '%');
+  INSERT INTO privilege (domain, privilege) VALUES ('dev.zalora.com', 'full');
+  INSERT INTO group_privilege ("group", domain, privilege) VALUES ('dev', 'dev.zalora.com', 'full');
+  INSERT INTO privilege_rule (domain, privilege, path, method) VALUES ('dev.zalora.com', 'full', '%', '%');
+*/
+
diff --git a/src/Authenticate.hs b/src/Authenticate.hs
new file mode 100644
--- /dev/null
+++ b/src/Authenticate.hs
@@ -0,0 +1,198 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Authenticate (
+  AuthConfig(..)
+, AuthToken(..)
+, validAuth
+, redirectForAuth
+, authenticate
+, logout
+
+-- exported to silence warnings
+, AccessToken(..)
+) where
+
+import           Control.Applicative
+import           Control.Exception
+import           Text.Read (readMaybe)
+import           Data.Monoid
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.UTF8 as UTF8
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import           Data.String.Conversions (cs)
+import           Data.List.Split (splitOn)
+import           Data.Aeson
+import           Network.HTTP.Types
+import           System.Posix.Types (EpochTime)
+import           System.Posix.Time (epochTime)
+import           Data.Digest.Pure.SHA (hmacSha1, showDigest)
+import           Network.HTTP.Conduit (simpleHttp, parseUrl, httpLbs, RequestBody(..))
+import qualified Network.HTTP.Conduit as HTTP
+import           Network.HTTP.Toolkit
+
+import qualified System.Logging.Facade as Log
+
+import           Cookies
+import           HTTP
+
+data AuthConfig = AuthConfig {
+  authConfigCookieDomain :: String
+, authConfigCookieName :: String
+, authConfigClientID :: String
+, authConfigClientSecret :: String
+, authConfigAuthTokenKey :: String
+} deriving (Eq, Show)
+
+data AccessToken = AccessToken {
+  accessToken :: String
+, expiresIn :: Integer
+, tokenType :: String
+} deriving (Eq, Show)
+
+instance FromJSON AccessToken where
+  parseJSON (Object v) = AccessToken
+    <$> v .: "access_token"
+    <*> v .: "expires_in"
+    <*> v .: "token_type"
+  parseJSON _ = empty
+
+data AuthToken = AuthToken {
+  authEmail  :: String
+, authName   :: (String, String)
+, authExpiry :: EpochTime
+, authDigest :: String -- HMAC hash
+}
+
+-- Here is the format of the actual cookie we send to the client.
+instance Show AuthToken where
+  show a = authEmail a ++ ":" ++ authNameString (authName a) ++ ":" ++ show (authExpiry a) ++ ":" ++ authDigest a
+    where authNameString (given, family) = given ++ ":" ++ family
+
+instance Read AuthToken where
+  readsPrec _ s = case splitOn ":" s of
+    [email, given, family, expire, digest] -> [(AuthToken email (given, family) (read expire) digest, "")]
+    _ -> []
+
+data UserInfo = UserInfo {
+  userEmail :: String
+, userGivenName :: String
+, userFamilyName :: String
+} deriving (Eq, Show)
+
+instance FromJSON UserInfo where
+  parseJSON (Object v) = UserInfo
+    <$> v .: "email"
+    <*> v .: "given_name"
+    <*> v .: "family_name"
+  parseJSON _ = empty
+
+redirectUri :: ByteString -> ByteString
+redirectUri baseUri = baseUri <> "/sproxy/oauth2callback"
+
+authUrl :: ByteString -> ByteString -> AuthConfig -> ByteString
+authUrl path baseUri c = mconcat [
+    "https://accounts.google.com/o/oauth2/auth?scope=https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.email+https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.profile&"
+  , "state=", urlEncode True path
+  , "&redirect_uri=", redirectUri baseUri
+  , "&response_type=code&client_id=", B8.pack (authConfigClientID c)
+  , "&approval_prompt=force&access_type=offline"
+  ]
+
+redirectForAuth :: AuthConfig -> ByteString -> ByteString -> IO (Response BodyReader)
+redirectForAuth c path baseUri = mkResponse found302 [("Location", authUrl path baseUri c)] ""
+
+authenticate :: AuthConfig -> ByteString -> ByteString -> ByteString -> IO (Response BodyReader)
+authenticate config baseUri path code = do
+  Log.info ("authentication request with code " ++ show code)
+  tokenRes <- try $ post "https://accounts.google.com/o/oauth2/token"
+              (cs $ "code=" ++ cs code ++ "&client_id=" ++ clientID
+                ++ "&client_secret=" ++ clientSecret ++ "&redirect_uri="
+                ++ cs (redirectUri baseUri) ++ "&grant_type=authorization_code")
+  case tokenRes of
+    Left err -> authenticationFailed ("error while authenticating: " ++ show (err :: HTTP.HttpException))
+    Right resp ->
+      case decode (HTTP.responseBody resp) of
+        Nothing ->
+          authenticationFailed "Received an invalid response from Google's authentication server."
+        Just token -> do
+          infoRes <- try $ simpleHttp ("https://www.googleapis.com/oauth2/v1/userinfo?access_token=" ++ accessToken token)
+          case infoRes of
+            Left err -> authenticationFailed ("error while retrieving user info: " ++ show (err :: HTTP.HttpException))
+            Right body ->
+              case decode body of
+                Nothing -> authenticationFailed "Received an invalid user info response from Google's authentication server."
+                Just userInfo -> do
+                  clientToken <- authToken authTokenKey (userEmail userInfo) (userGivenName userInfo, userFamilyName userInfo)
+                  let cookie = setCookie cookieDomain cookieName (show clientToken) authShelfLife
+                  mkResponse found302 [("Location", baseUri <> urlDecode False path), ("Set-Cookie", UTF8.fromString cookie)] ""
+  where
+    cookieDomain = authConfigCookieDomain config
+    cookieName = authConfigCookieName config
+    clientID = authConfigClientID config
+    clientSecret = authConfigClientSecret config
+    authTokenKey = authConfigAuthTokenKey config
+
+logout :: AuthConfig -> ByteString -> IO (Response BodyReader)
+logout config url = do
+  let cookie = invalidateCookie cookieDomain cookieName
+  mkResponse found302 [("Location", url), ("Set-Cookie", UTF8.fromString cookie)] ""
+  where
+    cookieDomain = authConfigCookieDomain config
+    cookieName = authConfigCookieName config
+
+post :: String -> ByteString -> IO (HTTP.Response BL8.ByteString)
+post url body = do
+  r' <- parseUrl url
+  let r = r' { HTTP.method = "POST"
+             , HTTP.requestBody = RequestBodyBS body
+             , HTTP.requestHeaders
+               = [ ("Content-Type" , "application/x-www-form-urlencoded")
+                 ]
+             }
+  manager <- HTTP.newManager HTTP.tlsManagerSettings
+  httpLbs r manager
+
+validAuth :: AuthConfig -> String -> IO (Maybe AuthToken)
+validAuth config token =
+  case readMaybe token of
+    Nothing -> return Nothing
+    Just t -> do
+      now <- epochTime
+      if tokenDigest key t == authDigest t && authExpiry t > now
+        then return $ Just t
+        else return Nothing
+  where
+    key = authConfigAuthTokenKey config
+
+-- | Create an AuthToken with the default expiration time, automatically
+-- calculating the digest.
+authToken :: String -> String -> (String, String) -> IO AuthToken
+authToken key email name = do
+  now <- epochTime
+  let expires = now + authShelfLife
+      digest = tokenDigest key AuthToken {
+          authEmail = email
+        , authName = name
+        , authExpiry = expires
+        , authDigest = ""
+        }
+      token = AuthToken {
+          authEmail  = email
+        , authName = name
+        , authExpiry = expires
+        , authDigest = digest
+        }
+  return token
+
+-- | This generates the HMAC digest of the auth token using SHA1.
+-- Eventually, we need to rotate the key used to generate the HMAC, while still
+-- storing old keys long enough to use them for any valid login session. Without
+-- this, authentication is less secure.
+tokenDigest :: String -> AuthToken -> String
+tokenDigest key a = showDigest $ hmacSha1 (BL8.pack key) (BL8.pack token)
+  where token = show (authEmail a) ++ show (authExpiry a)
+
+authShelfLife :: EpochTime
+authShelfLife = 30 * 24 * 60 * 60 -- 30 days
diff --git a/src/Authorize.hs b/src/Authorize.hs
new file mode 100644
--- /dev/null
+++ b/src/Authorize.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Authorize (
+  AuthorizeAction
+, Email
+, Domain
+, RequestPath
+, Group
+
+, withDatabaseAuthorizeAction
+) where
+
+import           Control.Exception
+import           Data.ByteString (ByteString)
+import           Network.HTTP.Types
+import           Text.InterpolatedString.Perl6 (q)
+import           Database.PostgreSQL.Simple
+import           Data.Pool
+import           Data.Time.Clock
+import           Data.String.Conversions (cs)
+
+type AuthorizeAction = Email -> Domain -> RequestPath -> Method -> IO [Group]
+
+type Email = String
+type Domain = ByteString
+type RequestPath = ByteString
+type Group = String
+
+type ConnectionPool = Pool Connection
+
+createConnectionPool :: String -> IO ConnectionPool
+createConnectionPool database = createPool open close 1 connectionIdleTime connectionPoolSize
+  where
+    open :: IO Connection
+    open = connectPostgreSQL (cs database)
+
+    connectionPoolSize :: Int
+    connectionPoolSize = 5
+
+    connectionIdleTime :: NominalDiffTime
+    connectionIdleTime = 5
+
+destroyConnectionPool :: ConnectionPool -> IO ()
+destroyConnectionPool = destroyAllResources
+
+withConnectionPool :: String -> (ConnectionPool -> IO a) -> IO a
+withConnectionPool database = bracket (createConnectionPool database) destroyConnectionPool
+
+withDatabaseAuthorizeAction :: String -> (AuthorizeAction -> IO a) -> IO a
+withDatabaseAuthorizeAction database action = withConnectionPool database $ \pool -> do
+  let authorizeAction :: AuthorizeAction
+      authorizeAction domain email path method = withResource pool $ \conn -> authorizedGroups conn domain email path method
+  action authorizeAction
+
+authorizedGroups :: Connection -> AuthorizeAction
+authorizedGroups db email domain path method =
+  fmap fromOnly `fmap` query db [q|
+SELECT gp."group" FROM group_privilege gp
+INNER JOIN group_member gm ON gm."group" = gp."group"
+WHERE ? LIKE email
+AND ? LIKE "domain"
+AND privilege IN (
+  SELECT p.privilege FROM privilege p
+  INNER JOIN privilege_rule pr ON pr."domain" = p."domain" AND pr.privilege = p.privilege
+  WHERE ? LIKE pr."domain" AND ? LIKE "path" AND ? ILIKE "method"
+  ORDER by array_length(regexp_split_to_array("path", '/'), 1) DESC LIMIT 1
+)
+|] (email, domain, domain, path, method)
diff --git a/src/ConfigFile.hs b/src/ConfigFile.hs
new file mode 100644
--- /dev/null
+++ b/src/ConfigFile.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module ConfigFile where
+
+import           Control.Applicative
+import           Data.Char
+import           Data.Word
+import           Text.Read
+import           System.IO
+import           System.Exit
+import           Data.Aeson
+import           Data.Yaml
+import           System.Logging.LogSink.Config
+
+withConfigFile :: FilePath -> (ConfigFile -> IO a) -> IO a
+withConfigFile configFile action = do
+  c <- decodeFileEither configFile
+  case c of
+    Left err -> do
+      hPutStrLn stderr ("error parsing configuration file " ++ configFile ++ ": " ++ show err)
+      exitFailure
+    Right config -> action config
+
+data ConfigFile = ConfigFile {
+  cfLogLevel :: LogLevel
+, cfLogTarget :: LogTarget
+, cfListen :: Word16
+, cfRedirectHttpToHttps :: Maybe Bool
+, cfCookieDomain :: String
+, cfCookieName :: String
+, cfClientID :: String
+, cfClientSecretFile :: FilePath
+, cfSslKey :: FilePath
+, cfSslCerts :: FilePath
+, cfDatabase :: String
+, cfBackendAddress :: String
+, cfBackendPort :: Word16
+, cfBackendSocket :: Maybe String
+} deriving (Eq, Show)
+
+instance FromJSON ConfigFile where
+  parseJSON (Object m) = ConfigFile <$>
+        (m .: "log_level" >>= parseLogLevel)
+    <*> (m .:? "log_target" .!= "stderr" >>= parseLogTarget)
+    <*> m .:? "listen" .!= 443
+    <*> m .:? "redirect_http_to_https"
+    <*> m .: "cookie_domain"
+    <*> m .: "cookie_name"
+    <*> m .: "client_id"
+    <*> m .: "client_secret"
+    <*> m .: "ssl_key"
+    <*> m .: "ssl_certs"
+    <*> m .: "database"
+    <*> m .:? "backend_address" .!= "127.0.0.1"
+    <*> m .:? "backend_port" .!= 8080
+    <*> m .:? "backend_socket"
+  parseJSON _ = empty
+
+deriving instance Read LogLevel
+
+parseLogLevel :: String -> Parser LogLevel
+parseLogLevel s = (maybe err return . readMaybe . map toUpper) s
+  where
+    err = fail ("invalid log_level " ++ show s)
+
+parseLogTarget :: String -> Parser LogTarget
+parseLogTarget s = case s of
+  "stderr" -> return StdErr
+  "syslog" -> return SysLog
+  _ -> fail ("invalid log_target " ++ show s)
+
diff --git a/src/Cookies.hs b/src/Cookies.hs
new file mode 100644
--- /dev/null
+++ b/src/Cookies.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Cookies (
+  Name
+, Value
+, parseCookies
+, removeCookie
+, formatCookies
+, setCookie
+, invalidateCookie
+) where
+
+import           Data.String
+import           Control.Applicative
+import qualified Data.ByteString as BS
+import Data.Char hiding (isSpace)
+import Data.List (partition, intercalate)
+import Network.HTTP.Types.Header (Header, hCookie)
+import System.Posix.Types (EpochTime)
+import Data.Attoparsec.ByteString.Char8
+
+type Name = String
+type Value = String
+
+removeCookie :: String -> [(Name, Value)] -> Maybe (Value, [(Name, Value)])
+removeCookie name cookies = case partition ((== name) . fst) cookies of
+  ((_, x):_, xs) -> Just (x, xs)
+  _ -> Nothing
+
+setCookie :: String -> String -> String -> EpochTime -> String
+setCookie domain name value maxAge = mkCookie domain [
+    (name, value)
+  , ("Max-Age", show maxAge)
+  ]
+
+invalidateCookie :: String -> String -> String
+invalidateCookie domain name = mkCookie domain [
+    (name, "deleted")
+  , ("expires", "Thu, 01 Jan 1970 00:00:00 GMT")
+  ]
+
+mkCookie :: String -> [(String, String)] -> String
+mkCookie domain = intercalate "; " . map format . (++ defaults) . map (fmap Just)
+  where
+    defaults = [
+        ("Domain", Just domain)
+      , ("path", Just "/")
+      , ("HttpOnly", Nothing)
+      , ("Secure", Nothing)
+      ]
+    format (name, mValue) = maybe name (\value -> name ++ "=" ++ value) mValue
+
+
+formatCookies :: [(Name, Value)] -> BS.ByteString
+formatCookies = mconcat . intercalate ["; "] . map formatCookie
+  where
+    formatCookie (name, value) = [fromString name, "=", fromString value]
+
+parseCookies :: [Header] -> [(Name, Value)]
+parseCookies = foldr headerToCookies []
+
+headerToCookies :: Header -> [(Name, Value)] -> [(Name, Value)]
+headerToCookies (name, val) acc
+  | name == hCookie = case parseOnly cookies val of
+      Left{}  -> acc
+      Right x -> x ++ acc
+  | otherwise = acc
+  where
+   cookies :: Parser [(Name, Value)]
+   cookies = sepBy1 cookie (";" *> skipSpace)
+
+   cookie :: Parser (Name, Value)
+   cookie = (,) <$> word <*> (skipSpace *> "=" *> skipSpace *> value)
+
+   value :: Parser String
+   value = quotedstring <|> many1 (satisfy (/= ';')) <|> return ""
+
+quotedstring :: Parser String
+quotedstring = char '"' *> many (satisfy  (/= '"')) <* char '"'
+
+word :: Parser String
+word = many1 (satisfy (\x -> isAlphaNum x || x=='_' || x=='.' || x=='-' || x==':'))
+
diff --git a/src/HTTP.hs b/src/HTTP.hs
new file mode 100644
--- /dev/null
+++ b/src/HTTP.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
+module HTTP (
+  hostHeaderMissing
+, authenticationFailed
+, accessDenied
+, badRequest
+, mkResponse
+, mkTextResponse
+, mkHtmlResponse
+) where
+
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as B
+import           Network.HTTP.Types
+import           Network.HTTP.Toolkit
+import           Network.HTTP.Toolkit.Body
+import           Text.InterpolatedString.Perl6 (qc)
+
+import qualified System.Logging.Facade as Log
+
+hostHeaderMissing :: Request a -> IO (Response BodyReader)
+hostHeaderMissing r = do
+  Log.warn $ "Host header missing for request: " ++ show (requestMethod r, requestPath r, requestHeaders r)
+  mkTextResponse badRequest400 "400 Bad Request"
+
+authenticationFailed :: String -> IO (Response BodyReader)
+authenticationFailed err = do
+  Log.error err
+  mkHtmlResponse internalServerError500 [qc|
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <title>Authentication Failed</title>
+  </head>
+  <body>
+  <h1>Authentication Failed</h1>
+    <p>Authentication Failed for an unknown reason.</p>
+    <p><a href="/">Try again!</a></p>
+  </body>
+</html>
+|]
+
+accessDenied :: String -> IO (Response BodyReader)
+accessDenied email = mkHtmlResponse forbidden403 [qc|
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <title>Access Denied</title>
+  </head>
+  <body>
+  <h1>Access Denied</h1>
+    <p>You are currently logged in as <strong>{email}</strong>.</p>
+    <p><a href="/sproxy/logout">logout</a></p>
+  </body>
+</html>
+|]
+
+badRequest :: IO (Response BodyReader)
+badRequest = mkTextResponse badRequest400 "400 Bad Request"
+
+mkResponse :: Status -> [Header] -> ByteString -> IO (Response BodyReader)
+mkResponse status headers_ body = Response status headers <$> fromByteString body
+  where
+    headers = ("Content-Length", B.pack . show . B.length $ body) : headers_
+
+mkTextResponse :: Status -> ByteString -> IO (Response BodyReader)
+mkTextResponse status = mkResponse status [("Content-Type", "text/plain")]
+
+mkHtmlResponse :: Status -> ByteString -> IO (Response BodyReader)
+mkHtmlResponse status = mkResponse status [("Content-Type", "text/html")]
diff --git a/src/Logging.hs b/src/Logging.hs
new file mode 100644
--- /dev/null
+++ b/src/Logging.hs
@@ -0,0 +1,6 @@
+module Logging (setup) where
+
+import           System.Logging.LogSink.Config
+
+setup :: LogLevel -> LogTarget -> IO ()
+setup level target = setupLogging [SinkConfig level "{level} {thread-id}: {message}" target]
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Main
+(
+  main
+) where
+
+import Data.Maybe (fromJust)
+import Data.Version (showVersion)
+import Paths_sproxy (version) -- from cabal
+import System.Environment (getArgs)
+import Text.RawString.QQ (r)
+import qualified System.Console.Docopt.NoTH as O
+
+import Authorize (withDatabaseAuthorizeAction)
+import ConfigFile (withConfigFile, ConfigFile(..))
+import Proxy (run)
+
+usage :: String
+usage =  "SProxy " ++ showVersion version ++
+  " HTTP proxy for authenticating users via Google OAuth2" ++ [r|
+
+Usage:
+  sproxy [options]
+
+Options:
+  -c, --config=FILE        Configuration file [default: config/sproxy.yml]
+  -h, --help               Show this message
+
+|]
+
+main :: IO ()
+main = do
+  doco <- O.parseUsageOrExit usage
+  args <- O.parseArgsOrExit doco =<< getArgs
+  if args `O.isPresent` O.longOption "help"
+  then putStrLn $ O.usage doco
+  else do
+    let
+      configFile = fromJust . O.getArg args $ O.longOption "config"
+
+    withConfigFile configFile $ \config ->
+      withDatabaseAuthorizeAction (cfDatabase config) (run config)
+
diff --git a/src/Proxy.hs b/src/Proxy.hs
new file mode 100644
--- /dev/null
+++ b/src/Proxy.hs
@@ -0,0 +1,249 @@
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+module Proxy (
+  run
+) where
+
+import Control.Monad hiding (forM_)
+import Data.Foldable (forM_)
+import Control.Concurrent
+import Control.Exception
+import System.IO.Error
+import GHC.IO.Exception
+import Data.Monoid
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy as BL
+import Data.Default (def)
+import Data.List (intercalate)
+import Data.Maybe
+import Data.Map as Map (fromListWith, toList, insert, delete)
+import Data.String.Conversions (cs)
+import qualified Data.X509 as X509
+import Network (PortID(..), listenOn, sClose, connectTo)
+import Network.Socket (Socket, SockAddr, accept, close)
+import qualified Network.Socket.ByteString as Socket
+import Network.HTTP.Types
+import qualified Network.TLS as TLS
+import qualified Network.TLS.Extra as TLS
+import System.IO
+import System.Entropy (getEntropy)
+import qualified Data.ByteString.Base64 as Base64
+import Network.HTTP.Toolkit
+
+import qualified System.Logging.Facade as Log
+
+import Type
+import Util
+import Logging
+import Authenticate
+import Cookies
+import Authorize
+import ConfigFile
+import HTTP
+
+data Config = Config {
+  configTLSCredential :: TLS.Credential
+, configBackendAddress :: String
+, configBackendPortID :: PortID
+} deriving (Eq, Show)
+
+-- | Reads the configuration file and the ssl certificate files and starts
+-- the server
+run :: ConfigFile -> AuthorizeAction -> IO ()
+run cf authorize = do
+  Logging.setup (cfLogLevel cf) (cfLogTarget cf)
+  clientSecret <- strip <$> readFile (cfClientSecretFile cf)
+  authTokenKey <- B8.unpack . Base64.encode <$> getEntropy 32
+  credential <- either error reverseCerts <$> TLS.credentialLoadX509 (cfSslCerts cf) (cfSslKey cf)
+
+  let authConfig = AuthConfig {
+          authConfigCookieDomain = cfCookieDomain cf
+        , authConfigCookieName = cfCookieName cf
+        , authConfigClientID = cfClientID cf
+        , authConfigClientSecret = clientSecret
+        , authConfigAuthTokenKey = authTokenKey
+        }
+      config = Config {
+          configTLSCredential = credential
+        , configBackendAddress = cfBackendAddress cf
+        , configBackendPortID =
+            case cfBackendSocket cf of
+              Just path -> UnixSocket path
+              _ -> PortNumber . fromIntegral $ cfBackendPort cf
+        }
+
+  case configBackendPortID config of
+    UnixSocket path -> hPutStrLn stderr $ "Forwarding to UNIX socket " ++ path
+    PortNumber p -> hPutStrLn stderr $ "Forwarding to "
+                       ++ configBackendAddress config ++ ":"
+                       ++ show p
+    _ -> return () -- XXX can't happen
+
+  mvar <- newEmptyMVar
+
+  -- Immediately fork a new thread for accepting connections since
+  -- the main thread is special and expensive to communicate with.
+  void . forkIO $ (runProxy (PortNumber . fromIntegral $ cfListen cf)
+                            config authConfig authorize `catch` logException)
+                 `finally` putMVar mvar ()
+
+  -- Listen on port 80 just to redirect everything to HTTPS.
+  let listen80 = fromMaybe (443 == cfListen cf) (cfRedirectHttpToHttps cf)
+
+  when listen80 $
+    void . forkIO $ listen (PortNumber 80) redirectToHttps `catch` logException
+
+  takeMVar mvar
+  where
+    -- Usually combined certs are in server, intermediate order,
+    -- but the tls library expects them in the opposite order.
+    reverseCerts (X509.CertificateChain certs, key) = (X509.CertificateChain $ reverse certs, key)
+
+runProxy :: PortID -> Config -> AuthConfig -> AuthorizeAction -> IO ()
+runProxy port config authConfig authorize = listen port (serve config authConfig authorize)
+
+-- | Redirects requests to https.
+redirectToHttps :: SockAddr -> Socket -> IO ()
+redirectToHttps _ sock = do
+  conn <- makeInputStream (Socket.recv sock 4096)
+  request <- readRequest True conn
+
+  case baseUri (requestHeaders request) of
+    Just uri -> do
+      let location = uri <> requestPath request
+      Log.debug ("Redirecting HTTP request to " ++ show location)
+      simpleResponse send seeOther303 [("Location", location)] ""
+    Nothing -> hostHeaderMissing request >>= sendResponse send
+  where
+    send = Socket.sendAll sock
+
+-- | Actual server:
+-- - ssl handshake
+-- - google authentication
+-- - our authorization
+-- - redirecting requests to localhost:8080
+serve :: Config -> AuthConfig -> AuthorizeAction -> SockAddr -> Socket -> IO ()
+serve config authConfig authorize addr sock = do
+  -- TODO: Work in the intermediate certificates.
+  let params = def { TLS.serverShared = def { TLS.sharedCredentials = TLS.Credentials [configTLSCredential config] }
+                   , TLS.serverSupported = def { TLS.supportedVersions = [TLS.TLS10, TLS.TLS11, TLS.TLS12]
+                                               , TLS.supportedCiphers = TLS.ciphersuite_all } }
+  ctx <- TLS.contextNew sock params
+  TLS.handshake ctx
+  conn <- makeInputStream (TLS.recvData ctx)
+  serve_ (TLS.sendData ctx . BL.fromStrict) conn
+  TLS.bye ctx
+  where
+    serve_ :: SendData -> InputStream -> IO ()
+    serve_ send conn = go
+      where
+        go :: IO ()
+        go = do
+          continue <- handleOne
+          when continue go
+
+        handleOne :: IO Bool
+        handleOne = do
+          request@(Request _ path headers _) <- readRequest True conn
+          mResponse <- case baseUri (requestHeaders request) of
+            Nothing -> Just <$> hostHeaderMissing request
+            Just uri -> do
+              let (segments, query) = (decodePath . extractPath) path
+              let redirectPath = fromMaybe "/" $ join $ lookup "state" query
+              case segments of
+                ["sproxy", "oauth2callback"] ->
+                  case join $ lookup "code" query of
+                    Nothing -> Just <$> badRequest
+                    Just code -> Just <$> authenticate authConfig uri redirectPath code
+                ["sproxy", "logout"] ->
+                  Just <$> logout authConfig (uri <> redirectPath)
+                -- sproxy sites are private by design. It doesn't make sense to index the authentication page.
+                ["robots.txt"] -> Just <$> mkTextResponse ok200 "User-agent: *\nDisallow: /"
+                _ -> -- Check for an auth cookie.
+                  case removeCookie (authConfigCookieName authConfig) (parseCookies headers) of
+                    Nothing -> Just <$> redirectForAuth authConfig path uri
+                    Just (authCookie, cookies) -> do
+                      auth <- validAuth authConfig authCookie
+                      case auth of
+                        Nothing -> Just <$> redirectForAuth authConfig path uri
+                        Just token ->
+                          forwardRequest config send authorize cookies addr request token
+          forM_ mResponse (sendResponse send)
+          return ((not . isConnectionClose) headers)
+
+-- Check our access control list for this user's request and forward it to the backend if allowed.
+forwardRequest :: Config -> SendData -> AuthorizeAction -> [(Name, Cookies.Value)] -> SockAddr -> Request BodyReader -> AuthToken -> IO (Maybe (Response BodyReader))
+forwardRequest config send authorize cookies addr request@(Request method path headers _) token = do
+    groups <- authorize (authEmail token) (maybe (error "No Host") cs $ lookup "Host" headers) path method
+    ip <- formatSockAddr addr
+    case groups of
+        [] -> Just <$> accessDenied (authEmail token)
+        _ -> do
+            -- TODO: Reuse connections to the backend server.
+            let downStreamHeaders =
+                    toList $
+                    insert "From" (cs $ authEmail token) $
+                    insert "X-Groups" (cs $ intercalate "," groups) $
+                    insert "X-Given-Name" (cs $ fst $ authName token) $
+                    insert "X-Family-Name" (cs $ snd $ authName token) $
+                    insert "X-Forwarded-Proto" "https" $
+                    addForwardedForHeader ip $
+                    insert "Connection" "close" $
+                    setCookies $ fromListWith (\a b -> B8.concat [a, ",", b]) headers
+            Log.debug $ show downStreamHeaders
+            bracket (connectTo host portID) hClose $ \h -> do
+              sendRequest (B8.hPutStr h) request{requestHeaders = downStreamHeaders}
+              conn <- inputStreamFromHandle h
+              response <- readResponse True method conn
+              sendResponse send response{responseHeaders = removeConnectionHeader (responseHeaders response)}
+              return Nothing
+  where
+    host = configBackendAddress config
+    portID = configBackendPortID config
+    setCookies = case cookies of
+      [] -> delete hCookie
+      _  -> insert hCookie (formatCookies cookies)
+
+listen :: PortID -> (SockAddr -> Socket -> IO ()) -> IO ()
+listen port action =
+  bracket
+  ( do
+    sock <- listenOn port
+    hPutStrLn stderr $ "Listening on " ++ show port
+    return sock )
+  sClose $
+  \serverSock -> forever $ do
+  (sock, addr) <- accept serverSock
+  forkIO $ (action addr sock `finally` close sock) `catches` handlers
+  where
+    handlers = [ Handler ioH
+               , Handler toolkitH
+               , Handler tlsH
+               , Handler logException ]
+
+    ioH :: IOException -> IO ()
+    ioH e
+      | ResourceVanished == ioeGetErrorType e = clientClosedConection e
+      | otherwise = logException' e
+
+    toolkitH :: ToolkitError -> IO ()
+    toolkitH e@UnexpectedEndOfInput = clientClosedConection e
+    toolkitH e = logException' e
+
+    tlsH :: TLS.TLSException -> IO ()
+    tlsH e@(TLS.HandshakeFailed TLS.Error_EOF) = clientClosedConection e
+    tlsH e@(TLS.HandshakeFailed (TLS.Error_Protocol (_, _, _))) = clientError e
+    tlsH e@(TLS.HandshakeFailed (TLS.Error_Packet_Parsing _)) = clientError e
+    tlsH e = logException' e
+
+    logException' :: Exception e => e -> IO ()
+    logException' = logException . toException
+
+    clientClosedConection :: Exception e => e -> IO ()
+    clientClosedConection e = Log.debug ("client closed connection (" ++ displayException e ++ ")")
+
+    clientError :: Exception e => e -> IO ()
+    clientError e = Log.debug ("client error (" ++ displayException e ++ ")")
+
+logException :: SomeException -> IO ()
+logException = Log.error . displayException
+
diff --git a/src/Type.hs b/src/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Type.hs
@@ -0,0 +1,5 @@
+module Type where
+
+import           Data.ByteString (ByteString)
+
+type SendData = ByteString -> IO ()
diff --git a/src/Util.hs b/src/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Util.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Util where
+
+import           Data.Char
+import           Data.String
+import           Data.Monoid
+import           Data.Map (Map)
+import qualified Data.Map as Map
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as B
+import           Network.HTTP.Types
+import           Network.Socket
+
+formatSockAddr :: SockAddr -> IO HostName
+formatSockAddr addr = (fst <$> getNameInfo [NI_NUMERICHOST] True False addr) >>= maybe err return
+  where
+    err = error "Util.formatSockAddr: impossible internal error"
+
+addForwardedForHeader :: HostName -> Map HeaderName ByteString -> Map HeaderName ByteString
+addForwardedForHeader ip = Map.insertWith combine "X-Forwarded-For" (fromString ip)
+  where
+    combine new old = mconcat [old, ", ", new]
+
+removeConnectionHeader :: [Header] -> [Header]
+removeConnectionHeader = filter ((/= hConnection) . fst)
+
+strip :: String -> String
+strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+baseUri :: [Header] -> Maybe ByteString
+baseUri headers = ("https://" <>) <$> lookup "Host" headers
+
+isConnectionClose :: [Header] -> Bool
+isConnectionClose = any p
+  where
+    p (k, v) = k == hConnection && B.map toLower (stripBS v) == "close"
+    stripBS = B.reverse . B.dropWhile isSpace . B.reverse . B.dropWhile isSpace