Initial release (1.90.0)1.90.0

20 files changed, 1879 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..0c5653f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,7 @@
+*.sqlite3*
+*.swp
+/.cabal-sandbox/
+/cabal-dev/
+/cabal.sandbox.config
+/dist/
+sproxy.yml
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..208a845
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,43 @@
+For differences with the original Sproxy scroll down.
+
+1.90.0 (Preview Release)
+========================
+
+Sproxy2 is overhaul of original [Sproxy](https://github.com/zalora/sproxy)
+(see also [Hackage](https://hackage.haskell.org/package/sproxy)).
+Here are the key differences (with Sproxy 0.9.8):
+
+  * Sproxy2 can work with remote PostgreSQL database. Quick access to the database is essential
+    as sproxy does it on every HTTP request. Sproxy2 pulls data into local SQLite3 database.
+
+  * At this release Sproxy2 is compatible with Sproxy database with one exception:
+    SQL wildcards are not supported for HTTP methods. E. i. you have to change '%' in
+    the database to specific methods like GET, POST, etc.
+
+  * OAuth2 callback URLs changed: Sproxy2 uses `/.sproxy/oauth2/:provider`,
+    e. g. `/.sproxy/oauth2/google`. Sproxy used `/sproxy/oauth2callback` for Google
+    and `/sproxy/oauth2callback/linkedin` for LinkedIn.
+
+  * Sproxy2 does not allow login with email addresses not known to it.
+
+  * Sproxy2: OAuth2 callback state is serialized, signed and passed base64-encoded.
+    Of course it's used to verify the request is legit.
+
+  * Sproxy2: session cookie is serialized, signed and sent base64-encoded.
+
+  * Path `/.sproxy` belongs to Sproxy2 completely. Anything under this path is never passed to backends.
+
+  * Sproxy2 supports multiple backends. Routing is based on the Host HTTP header.
+
+  * Sproxy2 uses [WAI](https://hackage.haskell.org/package/wai) / [Warp](https://hackage.haskell.org/package/warp)
+    for incoming connections. As a result Sproxy2 supports HTTP2.
+
+  * Sproxy2 uses [HTTP Client](https://hackage.haskell.org/package/http-client) to talk to backends.
+    As a result Sproxy2 reuses backend connections instead of closing them after each request to the backend.
+
+  * Sproxy2 optionally supports persistent key again (removed in Sproxy 0.9.2).
+    This can be used in load-balancing multiple Sproxy2 instances.
+
+  * Configuration file has changed. It's still YAML, but some options are renamed, removed or added.
+    Have a look at well-documented [sproxy.yml.example](./sproxy.yml.example)
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..f754880
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 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
index 0000000..aa2f998
--- /dev/null
+++ b/README.md
@@ -0,0 +1,161 @@
+# Sproxy2 - HTTP proxy for authenticating users via OAuth2
+
+## Motivation
+
+This is overhaul of original [Sproxy](https://hackage.haskell.org/package/sproxy).
+See [ChangeLog.md](./ChangeLog.md) for the differences.
+
+Why use a proxy for doing OAuth2? 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.
+
+## Use cases
+
+ * Existing web applications with concept of roles. For example,
+   [Mediawiki](https://www.mediawiki.org), [Jenkins](https://jenkins.io),
+   [Icinga Web 2](https://www.icinga.org/products/icinga-web-2/). In
+   this case you configure Sproxy to allow unrestricted access
+   to the application for some groups defined by Sproxy. These
+   groups are mapped to the application roles.  There is a [plugin for
+   Jenkins](https://wiki.jenkins-ci.org/display/JENKINS/Reverse+Proxy+Auth+Plugin)
+   which can be used for this. Mediawiki and Icinga Web 2 were also
+   successfully deployed in this way, though it required changes to their
+   source code.
+
+ * New web applications designed to work specifically behind Sproxy. In this case
+   you define Sproxy rules to control access to the
+   application's API.  It would likely be [a single-page
+   application](https://en.wikipedia.org/wiki/Single-page_application).
+   Examples are [MyWatch](https://hackage.haskell.org/package/mywatch) and
+   [Juan de la Cosa](https://hackage.haskell.org/package/juandelacosa)
+
+## 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, expired), it responses with [HTTP
+status 511](https://tools.ietf.org/html/rfc6585) with the page, where the
+user can choose an [OAuth2](https://tools.ietf.org/html/rfc6749) provider to
+authenticate with.  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.
+
+
+## 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 login
+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:
+
+
+Do note that Sproxy2 fetches only `group_member`, `group_privilege` and `privilege_rule`
+tables, because only these tables are used for authorization. The other tables
+serve for data integrity.
+
+
+### Privileges example
+
+Consider this `group_privilege` and `privilege_rule` relations:
+
+group            | privilege | domain
+---------------- | --------- | -----------------
+`readers`        | `basic`   | `wiki.example.com`
+`readers`        | `read`    | `wiki.example.com`
+`editors`        | `basic`   | `wiki.example.com`
+`editors`        | `read`    | `wiki.example.com`
+`editors`        | `edit`    | `wiki.example.com`
+`administrators` | `basic`   | `wiki.example.com`
+`administrators` | `read`    | `wiki.example.com`
+`administrators` | `edit`    | `wiki.example.com`
+`administrators` | `admin`   | `wiki.example.com`
+
+privilege   | domain             | path           | method
+----------- | ------------------ | -------------- | ------
+`basic`     | `wiki.example.com` | `/%`           | `GET`
+`read`      | `wiki.example.com` | `/wiki/%`      | `GET`
+`edit`      | `wiki.example.com` | `/wiki/edit/%` | `GET`
+`edit`      | `wiki.example.com` | `/wiki/edit/%` | `POST`
+`admin`     | `wiki.example.com` | `/admin/%`     | `GET`
+`admin`     | `wiki.example.com` | `/admin/%`     | `POST`
+`admin`     | `wiki.example.com` | `/admin/%`     | `DELETE`
+
+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 `sproxy2` will read its configuration from
+`sproxy.yml`.  There is example file with documentation
+[sproxy.yml.example](sproxy.yml.example). You can specify a
+custom path with:
+
+```
+sproxy --config /path/to/sproxy.yml
+```
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/sproxy.sql b/sproxy.sql
new file mode 100644
index 0000000..cda98f4
--- /dev/null
+++ b/sproxy.sql
@@ -0,0 +1,168 @@
+/*
+
+-- as super user:
+
+-- NOT idempotent
+CREATE DATABASE sproxy;
+CREATE ROLE sproxy;            -- this is for management tools like sproxy-web
+CREATE ROLE "sproxy-readonly"; -- this is for sproxy itself (sic!)
+
+-- idempotent from here on:
+ALTER DATABASE sproxy OWNER TO sproxy;
+ALTER ROLE "sproxy-readonly" LOGIN;
+ALTER ROLE sproxy LOGIN;
+
+\c sproxy;
+
+SET ROLE sproxy;
+-- as database owner (sproxy) from here on:
+
+GRANT SELECT ON ALL TABLES IN SCHEMA public TO "sproxy-readonly";
+ALTER DEFAULT PRIVILEGES IN SCHEMA public GRANT SELECT ON TABLES TO "sproxy-readonly";
+
+*/
+
+
+BEGIN;
+
+CREATE TABLE IF NOT EXISTS "group" (
+  "group" TEXT NOT NULL PRIMARY KEY,
+  "comment" TEXT
+);
+
+-- | group        |
+-- |--------------|
+-- | data science |
+-- | devops       |
+-- | all          |
+-- | regional     |
+
+
+CREATE TABLE IF NOT EXISTS group_member (
+  "group" TEXT REFERENCES "group" ("group") ON UPDATE CASCADE ON DELETE CASCADE NOT NULL,
+  email TEXT NOT NULL,
+  "comment" TEXT,
+  PRIMARY KEY ("group", email)
+);
+
+-- | group        | email                  |
+-- |--------------+------------------------|
+-- | data science | blah@example.com        |
+-- | data science | foo@example.com         |
+-- | devops       | devops1@example.com     |
+-- | devops       | devops2@example.com     |
+-- | all          | %@example.com           |
+
+-- 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,
+  "comment" TEXT
+);
+
+-- | domain                |
+-- |-----------------------|
+-- | app1.example.com      |
+-- | app2.example.com      |
+-- | app3.example.com      |
+
+CREATE TABLE IF NOT EXISTS privilege (
+  "domain" TEXT REFERENCES domain (domain) ON UPDATE CASCADE ON DELETE CASCADE NOT NULL,
+  privilege TEXT NOT NULL,
+  "comment" TEXT,
+  PRIMARY KEY ("domain", privilege)
+);
+
+-- | domain                | privilege  |
+-- |-----------------------+------------|
+-- | app3.example.com      | view       |
+-- | app3.example.com      | export     |
+-- | app1.example.com      | list users |
+-- | app1.example.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,
+  "comment" TEXT,
+  FOREIGN KEY ("domain", privilege) REFERENCES privilege ("domain", privilege) ON UPDATE CASCADE ON DELETE CASCADE,
+  PRIMARY KEY ("domain", "path", "method")
+);
+
+-- | domain                | privilege  | path      | method |
+-- |-----------------------+------------+-----------+--------|
+-- | app3.example.com      | view       | /%        | %      |
+-- | app3.example.com      | export     | /export/% | %      |
+-- | app1.example.com      | list users | /users    | GET    |
+-- | app1.example.com      | list users | /user/%   | GET    |
+-- | app1.example.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,
+  "comment" TEXT,
+  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.example.com      | view       |
+-- | data science | app3.example.com      | export     |
+-- | all          | app1.example.com      | list users |
+-- | devops       | app1.example.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.example.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@example.com' LIKE email
+-- AND 'app3.example.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.example.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.example.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 ('example.com');
+  INSERT INTO "group" ("group") VALUES ('dev');
+  INSERT INTO group_member ("group", email) VALUES ('dev', '%');
+  INSERT INTO privilege (domain, privilege) VALUES ('example.com', 'full');
+  INSERT INTO group_privilege ("group", domain, privilege) VALUES ('dev', 'example.com', 'full');
+  INSERT INTO privilege_rule (domain, privilege, path, method) VALUES ('example.com', 'full', '%', '%');
+*/
+
+END;
+
diff --git a/sproxy.yml.example b/sproxy.yml.example
new file mode 100644
index 0000000..d539956
--- /dev/null
+++ b/sproxy.yml.example
@@ -0,0 +1,139 @@
+--- # Sproxy configuration. Don't remove this line. This is YAML: https://en.wikipedia.org/wiki/YAML
+
+# The port Sproxy listens on (HTTPS).
+# Optional. Default is 443.
+# 
+# listen: 443
+
+# Listen on port 80 and redirect HTTP requests to HTTPS.
+# Optional. Default is true when listen == 443, otherwise false.
+#
+# listen80: true
+
+# Whether HTTP2 is enabled. Optional. Default is "true"
+#
+# http2: true
+
+# The system user Sproxy switches to if launched as root (after opening the ports).
+# Optional. Default is sproxy.
+#
+# user: sproxy
+
+# Home directory for various files including SQLite3 authorization database.
+# Optional. Default is current directory.
+#
+# home: "."
+
+# PostgreSQL database connection string.
+# Optional. If specified, sproxy will periodically pull the data from this
+# database into internal SQLite3 database. Define password in a file
+# referenced by the PGPASSFILE environment variable. Or use the "pgpassfile" option.
+# Example:
+# database: "user=sproxy-readonly dbname=sproxy port=6001"
+#
+# database:
+
+# PostgreSQL password file.
+# Optional. If specified, sproxy will set PGPASSFILE environment variable pointing to this file
+# Example:
+# pgpassfile: /run/keys/sproxy.pgpass
+#
+# pgpassfile:
+
+# Logging level: debug, info, warn, error.
+# Optional. Default is debug.
+# 
+# log_level: debug
+
+# A file with arbitrary content used to sign sproxy cookie and other things (secret!).
+# Optional. If not specified, a random key is generated on startup, and
+# as a consequence, restaring sproxy will invalidate existing user sessions.
+# This option could be useful for load-balancing with multiple sproxy instances,
+# when all instances must understand cookies created by each other.
+# This should not be very large, a few random bytes are fine.
+# 
+# key: /run/keys/sproxy.secret
+
+# File with SSL certificate. Required.
+# It can be a bundle with the server certificate coming first:
+# cat me-cert.pem CA-cert.pem > cert.pem
+# Once again: most wanted certs go first ;-)
+# Or you can opt in using of `ssl_cert_chain`
+ssl_cert: /path/cert.pem
+
+# File with SSL key (secret!). Required.
+ssl_key: /path/key.pem
+
+# Chain SSL certificate files.
+# Optional. Default is an empty list
+# Example:
+# ssl_cert_chain:
+#   - /path/foo.pem
+#   - /path/bar.pem
+# 
+# ssl_cert_chain: []
+
+
+# Credentials for supported OAuth2 providers.
+# Currently supported: "google", "linkedin"
+# At least one provider is required.
+# Attributes:
+#   client_id     - OAuth2 client ID (string)
+#   client_secret - OAuth2 client secret. Regardless of its name, this is a file.
+#                   The secret is read from the file which you should keep secret.
+#                   Only the first line of this file is read.
+#
+# Example:
+# oauth2:
+#   google:
+#     client_id: "XXXXXXXXXXXX-YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY.apps.googleusercontent.com"
+#     client_secret: "/run/keys/XXXXXXXXXXXX-YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY.apps.googleusercontent.com"
+#
+#   linkedin:
+#     client_id: "xxxxxxxxxxxxxx"
+#     client_secret: "/run/keys/xxxxxxxxxxxxxx"
+#
+#
+# oauth2:
+#   google:
+#     client_id:
+#     client_secret:
+
+
+# Backend servers. At least one is required.
+# NOTE: backends at TCP port are not secure, even on localhost,
+# because any local user can connect to the backend bypassing sproxy
+# authentication and authorization.
+#
+# It is recommended to communicate with backends via unix sockets only.
+# Unix sockets should be secured with proper unix file permissions.
+#
+# Backend attributes:
+#   name      - the host name as in the Host HTTP header.
+#               May include wildcards * and ?. The first matching
+#               backend will be used. Examples: "*.example.com", "wiki.corp.com".
+#               Optional. Default is "*". Note, that the name must include
+#               port number if non-standard.
+#   address   - backend IP address. Optional. Default is 127.0.0.1.
+#   port      - backend TCP port. Required unless unix socket is defined.
+#   socket    - unix socket. Highly recommended for security reasons.
+#               If defined, IP address and TCP port are ignored.
+#
+#   cookie_name    - sproxy cookie name. Optional. Default is "sproxy".
+#   cookie_domain  - sproxy cookie domain. Optional. Default is the request host name as per RFC2109.
+#   cookie_max_age - sproxy cookie shelflife in seconds. Optional. Default is 604800 (7 days).
+#   conn_count     - number of connections to keep alive. Optional. Default is 32.
+#                    This is specific to Haskell HTTP Client library, and is per host name,
+#                    not per backend. HTTP Client's default is 10.
+#
+# backends:
+#   - name: wiki.example.com
+#     port: 9090
+#     cookie_name: sproxy_example
+#     cookie_max_age: 86400
+#
+backends:
+  - port: 8080
+
+... # End of configuration. Don't remove this line. This is YAML: https://en.wikipedia.org/wiki/YAML
+
diff --git a/sproxy2.cabal b/sproxy2.cabal
new file mode 100644
index 0000000..f0817c0
--- /dev/null
+++ b/sproxy2.cabal
@@ -0,0 +1,72 @@
+name: sproxy2
+version: 1.90.0
+synopsis: Secure HTTP proxy for authenticating users via OAuth2
+description:
+  Sproxy is secure by default. No requests makes it to the backend
+  server if they haven't been explicitly whitelisted.  Sproxy is
+  independent. Any web application written in any language can
+  use it.
+license: MIT
+license-file: LICENSE
+author: Igor Pashev <pashev.igor@gmail.com>
+maintainer: Igor Pashev <pashev.igor@gmail.com>
+copyright: 2016, Zalora South East Asia Pte. Ltd
+category: Databases, Web
+build-type: Simple
+extra-source-files: README.md ChangeLog.md sproxy.yml.example sproxy.sql
+cabal-version: >= 1.20
+
+source-repository head
+  type: git
+  location: https://github.com/ip1981/sproxy2.git
+
+executable sproxy2
+    default-language: Haskell2010
+    ghc-options: -Wall -static -threaded
+    hs-source-dirs: src
+    main-is: Main.hs
+    other-modules:
+      Sproxy.Application
+      Sproxy.Application.Cookie
+      Sproxy.Application.OAuth2
+      Sproxy.Application.OAuth2.Common
+      Sproxy.Application.OAuth2.Google
+      Sproxy.Application.OAuth2.LinkedIn
+      Sproxy.Application.State
+      Sproxy.Config
+      Sproxy.Logging
+      Sproxy.Server
+      Sproxy.Server.DB
+    build-depends:
+        base >= 4.8 && < 50
+      , aeson
+      , base64-bytestring
+      , blaze-builder
+      , bytestring
+      , cereal
+      , conduit
+      , containers
+      , cookie >= 0.4.2
+      , docopt
+      , entropy
+      , Glob
+      , http-client >= 0.5.3
+      , http-conduit
+      , http-types
+      , interpolatedstring-perl6
+      , network
+      , postgresql-simple
+      , resource-pool
+      , SHA
+      , sqlite-simple
+      , text
+      , time
+      , unix
+      , unordered-containers
+      , wai
+      , wai-conduit
+      , warp
+      , warp-tls >= 3.2
+      , word8
+      , yaml >= 0.8.4
+
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..7101af0
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Main (
+  main
+) where
+
+import Data.Maybe (fromJust)
+import Data.Version (showVersion)
+import Paths_sproxy2 (version) -- from cabal
+import System.Environment (getArgs)
+import Text.InterpolatedString.Perl6 (qc)
+import qualified System.Console.Docopt.NoTH as O
+
+import Sproxy.Server (server)
+
+usage :: String
+usage =  "sproxy2 " ++ showVersion version ++
+  " - HTTP proxy for authenticating users via OAuth2" ++ [qc|
+
+Usage:
+  sproxy2 [options]
+
+Options:
+  -c, --config=FILE        Configuration file [default: 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"
+    server configFile
+
diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs
new file mode 100644
index 0000000..2391220
--- /dev/null
+++ b/src/Sproxy/Application.hs
@@ -0,0 +1,372 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Sproxy.Application (
+  sproxy
+, redirect
+) where
+
+import Blaze.ByteString.Builder (toByteString)
+import Blaze.ByteString.Builder.ByteString (fromByteString)
+import Control.Exception (SomeException, catch)
+import Data.ByteString (ByteString)
+import Data.ByteString as BS (break, intercalate)
+import Data.Char (toLower)
+import Data.ByteString.Char8 (pack, unpack)
+import Data.ByteString.Lazy (fromStrict)
+import Data.Conduit (Flush(Chunk), mapOutput)
+import Data.HashMap.Strict as HM (HashMap, foldrWithKey, lookup)
+import Data.List (find, partition)
+import Data.Map as Map (delete, fromListWith, insert, insertWith, toList)
+import Data.Maybe (fromJust, fromMaybe)
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Data.Word (Word16)
+import Data.Word8 (_colon)
+import Foreign.C.Types (CTime(..))
+import Network.HTTP.Client.Conduit (bodyReaderSource)
+import Network.HTTP.Conduit (requestBodySourceChunkedIO, requestBodySourceIO)
+import Network.HTTP.Types (RequestHeaders, ResponseHeaders, hConnection,
+  hContentLength, hContentType, hCookie, hLocation, methodGet)
+import Network.HTTP.Types.Status ( Status(..), badRequest400, forbidden403, found302,
+  internalServerError500, methodNotAllowed405, movedPermanently301,
+  networkAuthenticationRequired511, notFound404, ok200, seeOther303, temporaryRedirect307 )
+import Network.Socket (NameInfoFlag(NI_NUMERICHOST), getNameInfo)
+import Network.Wai.Conduit (sourceRequestBody, responseSource)
+import System.FilePath.Glob (Pattern, match)
+import System.Posix.Time (epochTime)
+import Text.InterpolatedString.Perl6 (qc)
+import Web.Cookie (Cookies, parseCookies, renderCookies)
+import qualified Network.HTTP.Client as BE
+import qualified Network.Wai as W
+import qualified Web.Cookie as WC
+
+import Sproxy.Application.Cookie (AuthCookie(..), AuthUser(..), cookieDecode, cookieEncode)
+import Sproxy.Application.OAuth2.Common (OAuth2Client(..))
+import Sproxy.Config(BackendConf(..))
+import Sproxy.Server.DB (Database, userExists, userGroups)
+import qualified Sproxy.Application.State as State
+import qualified Sproxy.Logging as Log
+
+
+redirect :: Word16 -> W.Application
+redirect p req resp =
+  case W.requestHeaderHost req of
+    Nothing -> badRequest "missing host" req resp
+    Just host -> do
+      Log.info $ "redirecting to " ++ show location ++ ": " ++ showReq req
+      resp $ W.responseBuilder status [(hLocation, location)] mempty
+      where
+        status = if W.requestMethod req == methodGet then movedPermanently301 else temporaryRedirect307
+        (domain, _) = BS.break (== _colon) host
+        newhost = if p == 443 then domain else domain <> ":" <> pack (show p)
+        location = "https://" <> newhost <> W.rawPathInfo req <> W.rawQueryString req
+
+
+sproxy :: ByteString -> Database -> HashMap Text OAuth2Client -> [(Pattern, BackendConf, BE.Manager)] -> W.Application
+sproxy key db oa2 backends = logException $ \req resp -> do
+  Log.debug $ "sproxy <<< " ++ showReq req
+  case W.requestHeaderHost req of
+    Nothing -> badRequest "missing host" req resp
+    Just host ->
+      case find (\(p, _, _) -> match p (unpack host)) backends of
+        Nothing -> notFound "backend" req resp
+        Just (_, be, mgr) -> do
+          let cookieName = pack $ beCookieName be
+              cookieDomain = pack <$> beCookieDomain be
+          case W.pathInfo req of
+            ["robots.txt"] -> get robots req resp
+            (".sproxy":proxy) ->
+              case proxy of
+                ["logout"] ->
+                  case extractCookie key Nothing cookieName req of
+                    Nothing -> notFound "logout without the cookie" req resp
+                    Just _  -> get (logout cookieName cookieDomain) req resp
+                ["oauth2", provider] ->
+                    case HM.lookup provider oa2 of
+                      Nothing -> notFound "OAuth2 provider" req resp
+                      Just oa2c -> get (oauth2callback key db (provider, oa2c) be) req resp
+                _ -> notFound "proxy" req resp
+            _ -> do
+              now <- Just <$> epochTime
+              case extractCookie key now cookieName req of
+                Nothing -> authenticationRequired key oa2 req resp
+                Just cs@(authCookie, _) ->
+                  authorize db cs req >>= \case
+                    Nothing   -> forbidden authCookie req resp
+                    Just req' -> forward mgr req' resp
+
+
+robots :: W.Application
+robots _ resp = resp $
+  W.responseLBS ok200 [(hContentType, "text/plain; charset=utf-8")]
+  "User-agent: *\nDisallow: /"
+
+
+oauth2callback :: ByteString -> Database -> (Text, OAuth2Client) -> BackendConf -> W.Application
+oauth2callback key db (provider, oa2c) be req resp =
+  case param "code" of
+    Nothing   -> badRequest "missing auth code" req resp
+    Just code -> 
+      case param "state" of
+        Nothing    -> badRequest "missing auth state" req resp
+        Just state ->
+          case State.decode key state of
+            Left msg   -> badRequest ("invalid state: " ++ msg) req resp
+            Right path -> do
+              au <- oauth2Authenticate oa2c code (redirectURL req provider)
+              let email = map toLower $ auEmail au
+              Log.info $ "login `" ++ email ++ "' by " ++ show provider
+              exists <- userExists db email
+              if exists then authenticate key be au{auEmail = email} path req resp
+                        else userNotFound email req resp
+  where
+    param p = do
+      (_, v) <- find ((==) p . fst) $ W.queryString req
+      v
+
+
+-- XXX: RFC6265: the user agent MUST NOT attach more than one Cookie header field
+extractCookie :: ByteString -> Maybe CTime -> ByteString -> W.Request -> Maybe (AuthCookie, Cookies)
+extractCookie key now name req = do
+  (_, cookies)   <- find ((==) hCookie . fst) $ W.requestHeaders req
+  (auth, others) <- discriminate cookies
+  case cookieDecode key auth of
+    Left _ -> Nothing
+    Right cookie -> if maybe True (acExpiry cookie >) now
+      then Just (cookie, others) else Nothing
+  where discriminate cs =
+          case partition ((==) name . fst) $ parseCookies cs of
+            ((_, x):_, xs) -> Just (x, xs)
+            _              -> Nothing
+
+
+authenticate :: ByteString -> BackendConf -> AuthUser -> ByteString -> W.Application
+authenticate key be user path req resp = do
+  now <- epochTime
+  let host = fromJust $ W.requestHeaderHost req
+      domain = pack <$> beCookieDomain be
+      expiry = now + CTime (beCookieMaxAge be)
+      authCookie = AuthCookie { acUser = user, acExpiry = expiry }
+      cookie = WC.def {
+        WC.setCookieName = pack $ beCookieName be
+      , WC.setCookieHttpOnly = True
+      , WC.setCookiePath = Just "/"
+      , WC.setCookieSameSite = Nothing
+      , WC.setCookieSecure = True
+      , WC.setCookieValue = cookieEncode key authCookie
+      , WC.setCookieDomain = domain
+      , WC.setCookieExpires = Just . posixSecondsToUTCTime . realToFrac $ expiry
+      }
+  resp $ W.responseLBS seeOther303 [
+           (hLocation, "https://" <> host <> path)
+         , ("Set-Cookie", toByteString $ WC.renderSetCookie cookie)
+         ] ""
+
+
+authorize :: Database -> (AuthCookie, Cookies) -> W.Request -> IO (Maybe W.Request)
+authorize db (authCookie, otherCookies) req = do
+  grps <- userGroups db email domain path method
+  if null grps then return Nothing
+  else do
+    ip <- pack . fromJust . fst <$> getNameInfo [NI_NUMERICHOST] True False (W.remoteHost req)
+    return . Just $ req {
+    W.requestHeaders = toList $
+      insert "From" (pack email) $
+      insert "X-Groups" (BS.intercalate "," grps) $
+      insert "X-Given-Name" given $
+      insert "X-Family-Name" family $
+      insert "X-Forwarded-Proto" "https" $
+      insertWith (flip combine) "X-Forwarded-For" ip $
+      setCookies otherCookies $
+      fromListWith combine $ W.requestHeaders req
+  }
+  where
+    user = acUser authCookie
+    email = auEmail user
+    given = pack $ auGivenName user
+    family = pack $ auFamilyName user
+    domain = decodeUtf8 . fromJust $ W.requestHeaderHost req
+    path = decodeUtf8 $ W.rawPathInfo req
+    method = decodeUtf8 $ W.requestMethod req
+    combine a b = a <> "," <> b
+    setCookies [] = delete hCookie
+    setCookies cs = insert hCookie (toByteString . renderCookies $ cs)
+
+
+forward :: BE.Manager -> W.Application
+forward mgr req resp = do
+  let beReq = BE.defaultRequest
+        { BE.method = W.requestMethod req
+        , BE.path = W.rawPathInfo req
+        , BE.queryString = W.rawQueryString req
+        , BE.requestHeaders = modifyRequestHeaders $ W.requestHeaders req
+        , BE.redirectCount = 0
+        , BE.decompress = const False
+        , BE.requestBody = case W.requestBodyLength req of
+            W.ChunkedBody   -> requestBodySourceChunkedIO (sourceRequestBody req)
+            W.KnownLength l -> requestBodySourceIO (fromIntegral l) (sourceRequestBody req)
+        }
+      msg = unpack (BE.method beReq <> " " <> BE.path beReq <> BE.queryString beReq)
+  Log.debug $ "BACKEND <<< " ++ msg ++ " " ++ show (BE.requestHeaders beReq)
+  BE.withResponse beReq mgr $ \res -> do
+        let status = BE.responseStatus res
+            headers = modifyResponseHeaders $ BE.responseHeaders res
+            body = mapOutput (Chunk . fromByteString) . bodyReaderSource $ BE.responseBody res
+            logging = if statusCode status `elem` [ 400, 500 ] then
+                      Log.warn else Log.debug
+        logging $ "BACKEND >>> " ++ show (statusCode status) ++ " on " ++ msg ++ "\n"
+        resp $ responseSource status headers body
+
+
+modifyRequestHeaders :: RequestHeaders -> RequestHeaders
+modifyRequestHeaders = filter (\(n, _) -> n `notElem` ban)
+  where
+    ban =
+      [
+        hConnection
+      , hContentLength -- XXX to avoid duplicate header
+      ]
+
+modifyResponseHeaders :: ResponseHeaders -> ResponseHeaders
+modifyResponseHeaders = filter (\(n, _) -> n `notElem` ban)
+  where
+    ban =
+      [
+        hConnection
+      ]
+
+authenticationRequired :: ByteString -> HashMap Text OAuth2Client -> W.Application
+authenticationRequired key oa2 req resp = do
+  Log.info $ "511 Unauthenticated: " ++ showReq req
+  resp $ W.responseLBS networkAuthenticationRequired511 [(hContentType, "text/html; charset=utf-8")] page
+  where
+    path = W.rawPathInfo req -- FIXME: make it more robust for non-GET or XMLHTTPRequest?
+    state = State.encode key path
+    authLink :: Text -> OAuth2Client -> ByteString -> ByteString
+    authLink provider oa2c html = 
+      let u = oauth2AuthorizeURL oa2c state (redirectURL req provider)
+          d = pack $ oauth2Description oa2c
+      in [qc|{html}<p><a href="{u}">Authenticate with {d}</a></p>|]
+    authHtml = foldrWithKey authLink "" oa2
+    page = fromStrict [qc|
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <title>Authentication required</title>
+  </head>
+  <body style="text-align:center;">
+  <h1>Authentication required</h1>
+  {authHtml}
+  </body>
+</html>
+|]
+
+
+forbidden :: AuthCookie -> W.Application
+forbidden ac req resp = do
+  Log.info $ "403 Forbidden (" ++ email ++ "): " ++ showReq req
+  resp $ W.responseLBS forbidden403 [(hContentType, "text/html; charset=utf-8")] page
+  where
+    email = auEmail . acUser $ ac
+    page = fromStrict [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>
+|]
+
+
+userNotFound :: String -> W.Application
+userNotFound email _ resp = do
+  Log.info $ "404 User not found (" ++ email ++ ")"
+  resp $ W.responseLBS notFound404 [(hContentType, "text/html; charset=utf-8")] page
+  where
+    page = fromStrict [qc|
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <title>Access Denied</title>
+  </head>
+  <body>
+  <h1>Access Denied</h1>
+    <p>You are not allowed to login as <strong>{email}</strong></p>
+    <p><a href="/">Main page</a></p>
+  </body>
+</html>
+|]
+
+
+logout :: ByteString -> Maybe ByteString -> W.Application
+logout name domain req resp = do
+  let host = fromJust $ W.requestHeaderHost req
+      cookie = WC.def {
+        WC.setCookieName = name
+      , WC.setCookieHttpOnly = True
+      , WC.setCookiePath = Just "/"
+      , WC.setCookieSameSite = Just WC.sameSiteStrict
+      , WC.setCookieSecure = True
+      , WC.setCookieValue = "goodbye"
+      , WC.setCookieDomain = domain
+      , WC.setCookieExpires = Just . posixSecondsToUTCTime . realToFrac $ CTime 0
+      }
+  resp $ W.responseLBS found302 [
+           (hLocation, "https://" <> host)
+         , ("Set-Cookie", toByteString $ WC.renderSetCookie cookie)
+         ] ""
+
+
+badRequest ::String -> W.Application
+badRequest msg req resp = do
+  Log.warn $ "400 Bad Request (" ++ msg ++ "): " ++ showReq req
+  resp $ W.responseLBS badRequest400 [] "Bad Request"
+
+
+notFound ::String -> W.Application
+notFound msg req resp = do
+  Log.warn $ "404 Not Found (" ++ msg ++ "): " ++ showReq req
+  resp $ W.responseLBS notFound404 [] "Not Found"
+
+
+logException :: W.Middleware
+logException app req resp = catch (app req resp) $ \e -> do
+  Log.error $ "500 Internal Error: " ++ show (e :: SomeException) ++ " on " ++ showReq req
+  resp $ W.responseLBS internalServerError500 [] "Internal Error"
+
+
+get :: W.Middleware
+get app req resp
+  | W.requestMethod req == methodGet = app req resp
+  | otherwise = do
+    Log.warn $ "405 Method Not Allowed: " ++ showReq req
+    resp $ W.responseLBS methodNotAllowed405 [("Allow", "GET")] "Method Not Allowed"
+
+
+redirectURL :: W.Request -> Text -> ByteString
+redirectURL req provider =
+  "https://" <> fromJust (W.requestHeaderHost req)
+             <> "/.sproxy/oauth2/" <> encodeUtf8 provider
+
+
+-- XXX: make sure not to reveal the cookie, which can be valid (!)
+showReq :: W.Request -> String
+showReq req = 
+    unpack ( W.requestMethod req <> " "
+           <> fromMaybe "<no host>" (W.requestHeaderHost req)
+           <> W.rawPathInfo req <> W.rawQueryString req <> " " )
+    ++ show (fromMaybe "-" $ W.requestHeaderReferer req) ++ " "
+    ++ show (fromMaybe "-" $ W.requestHeaderUserAgent req)
+    ++ " from " ++ show (W.remoteHost req)
+
diff --git a/src/Sproxy/Application/Cookie.hs b/src/Sproxy/Application/Cookie.hs
new file mode 100644
index 0000000..07cc162
--- /dev/null
+++ b/src/Sproxy/Application/Cookie.hs
@@ -0,0 +1,44 @@
+module Sproxy.Application.Cookie (
+  AuthCookie(..)
+, AuthUser(..)
+, cookieDecode
+, cookieEncode
+) where
+
+import Data.ByteString (ByteString)
+import Foreign.C.Types (CTime(..))
+import qualified Data.Serialize as DS
+
+import qualified Sproxy.Application.State as State
+
+data AuthUser = AuthUser {
+  auEmail      :: String
+, auGivenName  :: String
+, auFamilyName :: String
+}
+
+data AuthCookie = AuthCookie {
+  acUser   :: AuthUser
+, acExpiry :: CTime
+}
+
+instance DS.Serialize AuthCookie where
+  put c = DS.put (auEmail u, auGivenName u, auFamilyName u, x)
+          where u = acUser c
+                x = (\(CTime i) -> i) $ acExpiry c
+  get = do
+    (e, n, f, x) <- DS.get
+    return AuthCookie {
+        acUser = AuthUser { auEmail = e, auGivenName = n, auFamilyName = f }
+      , acExpiry = CTime x
+      }
+
+
+cookieDecode :: ByteString -> ByteString -> Either String AuthCookie
+cookieDecode key d = State.decode key d >>= DS.decode
+
+
+cookieEncode :: ByteString -> AuthCookie -> ByteString
+cookieEncode key = State.encode key . DS.encode
+
+
diff --git a/src/Sproxy/Application/OAuth2.hs b/src/Sproxy/Application/OAuth2.hs
new file mode 100644
index 0000000..0f7d6e8
--- /dev/null
+++ b/src/Sproxy/Application/OAuth2.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Sproxy.Application.OAuth2 (
+  providers
+) where
+
+import Data.HashMap.Strict (HashMap, fromList)
+import Data.Text (Text)
+
+import Sproxy.Application.OAuth2.Common (OAuth2Provider)
+import qualified Sproxy.Application.OAuth2.Google as Google
+import qualified Sproxy.Application.OAuth2.LinkedIn as LinkedIn
+
+providers :: HashMap Text OAuth2Provider
+providers = fromList [
+    ("google"   , Google.provider)
+  , ("linkedin" , LinkedIn.provider)
+  ]
+
diff --git a/src/Sproxy/Application/OAuth2/Common.hs b/src/Sproxy/Application/OAuth2/Common.hs
new file mode 100644
index 0000000..07fb759
--- /dev/null
+++ b/src/Sproxy/Application/OAuth2/Common.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Sproxy.Application.OAuth2.Common (
+  AccessTokenBody(..)
+, OAuth2Client(..)
+, OAuth2Provider
+) where
+
+import Control.Applicative (empty)
+import Data.Aeson (FromJSON, parseJSON, Value(Object), (.:))
+import Data.ByteString(ByteString)
+
+import Sproxy.Application.Cookie (AuthUser)
+
+data OAuth2Client = OAuth2Client {
+  oauth2Description :: String
+, oauth2AuthorizeURL
+    :: ByteString -- state
+    -> ByteString -- redirect url
+    -> ByteString
+, oauth2Authenticate
+    :: ByteString -- code
+    -> ByteString -- redirect url
+    -> IO AuthUser
+}
+
+type OAuth2Provider = (ByteString, ByteString) -> OAuth2Client
+
+-- | RFC6749. We ignore optional token_type ("Bearer" from Google, omitted by LinkedIn)
+--   and expires_in because we don't use them, *and* expires_in creates troubles:
+--   it's an integer from Google and string from LinkedIn (sic!)
+data AccessTokenBody = AccessTokenBody {
+  accessToken :: String
+} deriving (Eq, Show)
+
+instance FromJSON AccessTokenBody where
+  parseJSON (Object v) = AccessTokenBody
+    <$> v .:  "access_token"
+  parseJSON _ = empty
+
diff --git a/src/Sproxy/Application/OAuth2/Google.hs b/src/Sproxy/Application/OAuth2/Google.hs
new file mode 100644
index 0000000..6b68f44
--- /dev/null
+++ b/src/Sproxy/Application/OAuth2/Google.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Sproxy.Application.OAuth2.Google (
+  provider
+) where
+
+import Control.Applicative (empty)
+import Control.Exception (Exception, throwIO)
+import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:))
+import Data.ByteString.Lazy (ByteString)
+import Data.Monoid ((<>))
+import Data.Typeable (Typeable)
+import Network.HTTP.Types (hContentType)
+import Network.HTTP.Types.URI (urlEncode)
+import qualified Network.HTTP.Conduit as H
+
+import Sproxy.Application.Cookie (AuthUser(..))
+import Sproxy.Application.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider)
+
+
+provider :: OAuth2Provider
+provider (client_id, client_secret) =
+  OAuth2Client {
+    oauth2Description = "Google"
+  , oauth2AuthorizeURL = \state redirect_uri ->
+         "https://accounts.google.com/o/oauth2/v2/auth"
+      <> "?scope=" <> urlEncode True "https://www.googleapis.com/auth/userinfo.email https://www.googleapis.com/auth/userinfo.profile"
+      <> "&client_id=" <> urlEncode True client_id
+      <> "&prompt=select_account"
+      <> "&redirect_uri=" <> urlEncode True redirect_uri
+      <> "&response_type=code"
+      <> "&state=" <> urlEncode True state
+
+  , oauth2Authenticate = \code redirect_uri -> do
+      let treq = H.setQueryString [
+                ("client_id"     , Just client_id)
+              , ("client_secret" , Just client_secret)
+              , ("code"          , Just code)
+              , ("grant_type"    , Just "authorization_code")
+              , ("redirect_uri"  , Just redirect_uri)
+              ] $ (H.parseRequest_ "POST https://www.googleapis.com/oauth2/v4/token") {
+                H.requestHeaders = [
+                  (hContentType, "application/x-www-form-urlencoded")
+                ]
+              }
+      mgr   <- H.newManager H.tlsManagerSettings
+      tresp <- H.httpLbs treq mgr
+      case decode $ H.responseBody tresp of
+        Nothing -> throwIO $ GoogleException tresp
+        Just atResp -> do
+          ureq  <- H.parseRequest $ "https://www.googleapis.com/oauth2/v1/userinfo?access_token=" ++ accessToken atResp
+          uresp <- H.httpLbs ureq mgr
+          case decode $ H.responseBody uresp of
+            Nothing -> throwIO $ GoogleException uresp
+            Just u -> return AuthUser { auEmail = email u, auGivenName = givenName u, auFamilyName = familyName u }
+  }
+
+
+data GoogleException = GoogleException (H.Response ByteString)
+  deriving (Show, Typeable)
+
+
+instance Exception GoogleException
+
+
+data GoogleUserInfo = GoogleUserInfo {
+  email :: String
+, givenName :: String
+, familyName :: String
+} deriving (Eq, Show)
+
+instance FromJSON GoogleUserInfo where
+  parseJSON (Object v) = GoogleUserInfo
+    <$> v .: "email"
+    <*> v .: "given_name"
+    <*> v .: "family_name"
+  parseJSON _ = empty
+
diff --git a/src/Sproxy/Application/OAuth2/LinkedIn.hs b/src/Sproxy/Application/OAuth2/LinkedIn.hs
new file mode 100644
index 0000000..b60afde
--- /dev/null
+++ b/src/Sproxy/Application/OAuth2/LinkedIn.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Sproxy.Application.OAuth2.LinkedIn (
+  provider
+) where
+
+import Control.Applicative (empty)
+import Control.Exception (Exception, throwIO)
+import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:))
+import Data.ByteString.Char8 (pack)
+import Data.ByteString.Lazy (ByteString)
+import Data.Monoid ((<>))
+import Data.Typeable (Typeable)
+import Network.HTTP.Types (hContentType)
+import Network.HTTP.Types.URI (urlEncode)
+import qualified Network.HTTP.Conduit as H
+
+import Sproxy.Application.Cookie (AuthUser(..))
+import Sproxy.Application.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider)
+
+
+provider :: OAuth2Provider
+provider (client_id, client_secret) =
+  OAuth2Client {
+    oauth2Description = "LinkedIn"
+  , oauth2AuthorizeURL = \state redirect_uri ->
+         "https://www.linkedin.com/oauth/v2/authorization"
+      <> "?scope=r_basicprofile%20r_emailaddress"
+      <> "&client_id=" <> urlEncode True client_id
+      <> "&redirect_uri=" <> urlEncode True redirect_uri
+      <> "&response_type=code"
+      <> "&state=" <> urlEncode True state
+
+  , oauth2Authenticate = \code redirect_uri -> do
+      let treq = H.setQueryString [
+                ("client_id"     , Just client_id)
+              , ("client_secret" , Just client_secret)
+              , ("code"          , Just code)
+              , ("grant_type"    , Just "authorization_code")
+              , ("redirect_uri"  , Just redirect_uri)
+              ] $ (H.parseRequest_ "POST https://www.linkedin.com/oauth/v2/accessToken") {
+                H.requestHeaders = [
+                  (hContentType, "application/x-www-form-urlencoded")
+                ]
+              }
+      mgr   <- H.newManager H.tlsManagerSettings
+      tresp <- H.httpLbs treq mgr
+      case decode $ H.responseBody tresp of
+        Nothing -> throwIO $ LinkedInException tresp
+        Just atResp -> do
+          let ureq = (H.parseRequest_ "https://api.linkedin.com/v1/people/\
+                \~:(email-address,first-name,last-name)?format=json") {
+                  H.requestHeaders = [ ("Authorization", "Bearer " <> pack (accessToken atResp)) ]
+                }
+          uresp <- H.httpLbs ureq mgr
+          case decode $ H.responseBody uresp of
+            Nothing -> throwIO $ LinkedInException uresp
+            Just u -> return AuthUser { auEmail = emailAddress u
+                                      , auGivenName = firstName u
+                                      , auFamilyName = lastName u }
+  }
+
+
+data LinkedInException = LinkedInException (H.Response ByteString)
+  deriving (Show, Typeable)
+
+
+instance Exception LinkedInException
+
+
+data LinkedInUserInfo = LinkedInUserInfo {
+  emailAddress :: String
+, firstName :: String
+, lastName :: String
+} deriving (Eq, Show)
+
+instance FromJSON LinkedInUserInfo where
+  parseJSON (Object v) = LinkedInUserInfo
+    <$> v .: "emailAddress"
+    <*> v .: "firstName"
+    <*> v .: "lastName"
+  parseJSON _ = empty
+
diff --git a/src/Sproxy/Application/State.hs b/src/Sproxy/Application/State.hs
new file mode 100644
index 0000000..29d9252
--- /dev/null
+++ b/src/Sproxy/Application/State.hs
@@ -0,0 +1,30 @@
+module Sproxy.Application.State (
+  decode
+, encode
+) where
+
+import Data.ByteString (ByteString)
+import Data.ByteString.Lazy (fromStrict, toStrict)
+import Data.Digest.Pure.SHA (hmacSha1, bytestringDigest)
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.Serialize as DS
+
+
+-- FIXME: Compress / decompress ?
+
+
+encode :: ByteString -> ByteString -> ByteString
+encode key payload = Base64.encode . DS.encode $ (payload, digest key payload)
+
+
+decode :: ByteString -> ByteString -> Either String ByteString
+decode key d = do
+  (payload, dgst) <- DS.decode =<< Base64.decode d
+  if dgst /= digest key payload
+  then Left "junk"
+  else Right payload
+  
+
+digest :: ByteString -> ByteString -> ByteString
+digest key payload = toStrict . bytestringDigest $ hmacSha1 (fromStrict key) (fromStrict payload)
+
diff --git a/src/Sproxy/Config.hs b/src/Sproxy/Config.hs
new file mode 100644
index 0000000..30a8bae
--- /dev/null
+++ b/src/Sproxy/Config.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Sproxy.Config (
+  BackendConf(..)
+, ConfigFile(..)
+, OAuth2Conf(..)
+) where
+
+import Control.Applicative (empty)
+import Data.Aeson (FromJSON, parseJSON)
+import Data.HashMap.Strict (HashMap)
+import Data.Int (Int64)
+import Data.Text (Text)
+import Data.Word (Word16)
+import Data.Yaml (Value(Object), (.:), (.:?), (.!=))
+
+import Sproxy.Logging (LogLevel(Debug))
+
+data ConfigFile = ConfigFile {
+  cfListen       :: Word16
+, cfUser         :: String
+, cfHome         :: FilePath
+, cfLogLevel     :: LogLevel
+, cfSslCert      :: FilePath
+, cfSslKey       :: FilePath
+, cfSslCertChain :: [FilePath]
+, cfKey          :: Maybe FilePath
+, cfListen80     :: Maybe Bool
+, cfBackends     :: [BackendConf]
+, cfOAuth2       :: HashMap Text OAuth2Conf
+, cfDatabase     :: Maybe String
+, cfPgPassFile   :: Maybe FilePath
+, cfHTTP2        :: Bool
+} deriving (Show)
+
+instance FromJSON ConfigFile where
+  parseJSON (Object m) = ConfigFile <$>
+        m .:? "listen"         .!= 443
+    <*> m .:? "user"           .!= "sproxy"
+    <*> m .:? "home"           .!= "."
+    <*> m .:? "log_level"      .!= Debug
+    <*> m .:  "ssl_cert"
+    <*> m .:  "ssl_key"
+    <*> m .:? "ssl_cert_chain" .!= []
+    <*> m .:? "key"
+    <*> m .:? "listen80"
+    <*> m .:  "backends"
+    <*> m .:  "oauth2"
+    <*> m .:? "database"
+    <*> m .:? "pgpassfile"
+    <*> m .:? "http2"          .!= True
+  parseJSON _ = empty
+
+
+data BackendConf = BackendConf {
+  beName         :: String
+, beAddress      :: String
+, bePort         :: Maybe Word16
+, beSocket       :: Maybe FilePath
+, beCookieName   :: String
+, beCookieDomain :: Maybe String
+, beCookieMaxAge :: Int64
+, beConnCount    :: Int
+} deriving (Show)
+
+instance FromJSON BackendConf where
+  parseJSON (Object m) = BackendConf <$>
+        m .:? "name"           .!= "*"
+    <*> m .:? "address"        .!= "127.0.0.1"
+    <*> m .:? "port"
+    <*> m .:? "socket"
+    <*> m .:? "cookie_name"    .!= "sproxy"
+    <*> m .:? "cookie_domain"
+    <*> m .:? "cookie_max_age" .!= (7 * 24 * 60 * 60)
+    <*> m .:? "conn_count"     .!= 32
+  parseJSON _ = empty
+
+
+data OAuth2Conf = OAuth2Conf {
+  oa2ClientId     :: String
+, oa2ClientSecret :: FilePath
+} deriving (Show)
+
+instance FromJSON OAuth2Conf where
+  parseJSON (Object m) = OAuth2Conf <$>
+        m .: "client_id"
+    <*> m .: "client_secret"
+  parseJSON _ = empty
+
diff --git a/src/Sproxy/Logging.hs b/src/Sproxy/Logging.hs
new file mode 100644
index 0000000..651a73a
--- /dev/null
+++ b/src/Sproxy/Logging.hs
@@ -0,0 +1,99 @@
+module Sproxy.Logging (
+  LogLevel(..)
+, debug
+, error
+, info
+, level
+, start
+, warn
+) where
+
+import Prelude hiding (error)
+
+import Control.Applicative (empty)
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
+import Control.Monad (forever, when)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Char (toLower)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import System.IO (hPrint, stderr)
+import System.IO.Unsafe (unsafePerformIO)
+import Text.Read (readMaybe)
+import qualified Data.Aeson as JSON
+import qualified Data.Text as T
+
+start :: LogLevel -> IO ()
+start None = return ()
+start lvl = do
+  writeIORef logLevel lvl
+  ch <- readIORef chanRef
+  _ <- forkIO . forever $ readChan ch >>= hPrint stderr
+  return ()
+
+info :: String -> IO ()
+info = send . Message Info
+
+warn:: String -> IO ()
+warn = send . Message Warning
+
+error:: String -> IO ()
+error = send . Message Error
+
+debug :: String -> IO ()
+debug = send . Message Debug
+
+
+send :: Message -> IO ()
+send msg@(Message l _) = do
+  lvl <- level
+  when (l <= lvl) $ do
+    ch <- readIORef chanRef
+    writeChan ch msg
+
+{-# NOINLINE chanRef #-}
+chanRef :: IORef (Chan Message)
+chanRef = unsafePerformIO (newChan >>= newIORef)
+
+{-# NOINLINE logLevel #-}
+logLevel :: IORef LogLevel
+logLevel = unsafePerformIO (newIORef None)
+
+level :: IO LogLevel
+level = readIORef logLevel
+
+
+data LogLevel = None | Error | Warning | Info | Debug
+  deriving (Enum, Ord, Eq)
+
+instance Show LogLevel where
+  show None    = "NONE"
+  show Error   = "ERROR"
+  show Warning = "WARN"
+  show Info    = "INFO"
+  show Debug   = "DEBUG"
+
+instance Read LogLevel where
+  readsPrec _ s
+        | l == "none"  = [ (None,    "") ]
+        | l == "error" = [ (Error,   "") ]
+        | l == "warn"  = [ (Warning, "") ]
+        | l == "info"  = [ (Info,    "") ]
+        | l == "debug" = [ (Debug,   "") ]
+        | otherwise = [ ]
+        where l = map toLower s
+
+instance ToJSON LogLevel where
+  toJSON = JSON.String . T.pack . show
+
+instance FromJSON LogLevel where
+  parseJSON (JSON.String s) =
+    maybe (fail $ "unknown log level: " ++ show s) return (readMaybe . T.unpack $ s)
+  parseJSON _ = empty
+
+
+data Message = Message LogLevel String
+
+instance Show Message where
+  show (Message lvl str) = show lvl ++ ": " ++ str
+
diff --git a/src/Sproxy/Server.hs b/src/Sproxy/Server.hs
new file mode 100644
index 0000000..bd2af17
--- /dev/null
+++ b/src/Sproxy/Server.hs
@@ -0,0 +1,190 @@
+module Sproxy.Server (
+  server
+) where
+
+import Control.Concurrent (forkIO)
+import Control.Exception (bracketOnError)
+import Control.Monad (void, when)
+import Data.ByteString as BS (hGetLine, readFile)
+import Data.ByteString.Char8 (pack)
+import Data.HashMap.Strict as HM (fromList, lookup, toList)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Word (Word16)
+import Data.Yaml (decodeFileEither)
+import Network.HTTP.Client (Manager, ManagerSettings(..), defaultManagerSettings, newManager, socketConnection)
+import Network.HTTP.Client.Internal (Connection)
+import Network.Socket ( Family(AF_INET, AF_UNIX), SockAddr(SockAddrInet, SockAddrUnix),
+  SocketOption(ReuseAddr), SocketType(Stream), bind, close, connect, inet_addr,
+  listen, maxListenQueue, setSocketOption, socket )
+import Network.Wai.Handler.WarpTLS (tlsSettingsChain, runTLSSocket)
+import Network.Wai.Handler.Warp (defaultSettings, setHTTP2Disabled, runSettingsSocket)
+import System.Entropy (getEntropy)
+import System.Environment (setEnv)
+import System.Exit (exitFailure)
+import System.FilePath.Glob (compile)
+import System.IO (IOMode(ReadMode), hIsEOF, hPutStrLn, stderr, withFile)
+import System.Posix.User ( GroupEntry(..), UserEntry(..),
+  getAllGroupEntries, getRealUserID,
+  getUserEntryForName, setGroupID, setGroups, setUserID )
+
+import Sproxy.Application (sproxy, redirect)
+import Sproxy.Application.OAuth2.Common (OAuth2Client)
+import Sproxy.Config (BackendConf(..), ConfigFile(..), OAuth2Conf(..))
+import qualified Sproxy.Application.OAuth2 as OAuth2
+import qualified Sproxy.Logging as Log
+import qualified Sproxy.Server.DB as DB
+
+
+server :: FilePath -> IO ()
+server configFile = do
+  cf <- readConfigFile configFile
+  Log.start $ cfLogLevel cf
+  Log.debug $ show cf
+
+  sock <- socket AF_INET Stream 0
+  setSocketOption sock ReuseAddr 1
+  bind sock $ SockAddrInet (fromIntegral $ cfListen cf) 0
+
+  maybe80 <- if fromMaybe (443 == cfListen cf) (cfListen80 cf)
+    then do
+      sock80 <- socket AF_INET Stream 0
+      setSocketOption sock80 ReuseAddr 1
+      bind sock80 $ SockAddrInet 80 0
+      return (Just sock80)
+    else
+      return Nothing
+
+  uid <- getRealUserID
+  when (0 == uid) $ do
+    let user = cfUser cf
+    Log.info $ "switching to user " ++ show user
+    u <- getUserEntryForName user
+    groupIDs <- map groupID . filter (elem user . groupMembers)
+             <$> getAllGroupEntries
+    setGroups groupIDs
+    setGroupID $ userGroupID u
+    setUserID $ userID u
+
+  case cfPgPassFile cf of
+    Nothing -> return ()
+    Just f  -> do
+      Log.info $ "pgpassfile: " ++ show f
+      setEnv "PGPASSFILE" f
+
+  db <- DB.start (cfHome cf) (newDataSource cf)
+
+  key <- maybe
+           (Log.info "using new random key" >> getEntropy 32)
+           (\f -> Log.info ("reading key from " ++ f) >> BS.readFile f)
+           (cfKey cf)
+
+  case maybe80 of
+    Nothing     -> return ()
+    Just sock80 -> do
+      Log.info "listening on port 80 (HTTP redirect)"
+      listen sock80 maxListenQueue
+      void . forkIO $ runSettingsSocket defaultSettings sock80 (redirect $ cfListen cf)
+
+  oauth2clients <- HM.fromList <$> mapM newOAuth2Client (HM.toList (cfOAuth2 cf))
+
+  backends <-
+    mapM (\be -> do
+      m <- newBackendManager be
+      return (compile $ beName be, be, m)
+    ) $ cfBackends cf
+
+  let
+    settings =
+      (if cfHTTP2 cf then id else setHTTP2Disabled)
+      defaultSettings
+
+  -- XXX 2048 is from bindPortTCP from streaming-commons used internally by runTLS.
+  -- XXX Since we don't call runTLS, we listen socket here with the same options.
+  Log.info $ "listening on port " ++ show (cfListen cf) ++ " (HTTPS)"
+  listen sock (max 2048 maxListenQueue)
+  runTLSSocket
+    (tlsSettingsChain (cfSslCert cf) (cfSslCertChain cf) (cfSslKey cf))
+    settings
+    sock
+    (sproxy key db oauth2clients backends)
+
+
+newDataSource :: ConfigFile -> Maybe DB.DataSource
+newDataSource cf =
+  case cfDatabase cf of
+    Just str -> Just $ DB.PostgreSQL str
+    Nothing -> Nothing
+
+
+newOAuth2Client :: (Text, OAuth2Conf) -> IO (Text, OAuth2Client)
+newOAuth2Client (name, cfg) =
+  case HM.lookup name OAuth2.providers of
+    Nothing -> do Log.error $ "OAuth2 provider " ++ show name ++ " is not supported"
+                  exitFailure
+    Just provider -> do
+      Log.info $ "oauth2: adding " ++ show name
+      client_secret <- withFile secret_file ReadMode $ \h -> do
+        empty <- hIsEOF h
+        if empty then do
+          Log.error $ "oauth2: empty secret file for "
+                    ++ show name ++ ": " ++ show secret_file
+          return $ pack ""
+        else BS.hGetLine h
+      return (name, provider (pack client_id, client_secret))
+  where client_id = oa2ClientId cfg
+        secret_file = oa2ClientSecret cfg
+
+
+newBackendManager :: BackendConf -> IO Manager
+newBackendManager be = do
+  openConn <-
+    case (beSocket be, bePort be) of
+      (Just f, Nothing) -> do
+        Log.info $ "backend `" ++ beName be ++ "' on UNIX socket " ++ f
+        return $ openUnixSocketConnection f
+
+      (Nothing, Just n) -> do
+        Log.info $ "backend `" ++ beName be ++ "' on " ++ beAddress be ++ ":" ++ show n
+        return $ openTCPConnection (beAddress be) n
+
+      _ -> do
+            Log.error "either backend port number or UNIX socket path is required."
+            exitFailure
+
+  newManager defaultManagerSettings {
+    managerRawConnection = return $ \_ _ _ -> openConn
+  , managerConnCount = beConnCount be
+  }
+
+
+openUnixSocketConnection :: FilePath -> IO Connection
+openUnixSocketConnection f =
+  bracketOnError
+   (socket AF_UNIX Stream 0)
+   close
+   (\s -> do
+      connect s (SockAddrUnix f)
+      socketConnection s 8192)
+
+
+openTCPConnection :: String -> Word16 -> IO Connection
+openTCPConnection addr port =
+  bracketOnError
+   (socket AF_INET Stream 0)
+   close
+   (\s -> do
+      a <- inet_addr addr
+      connect s (SockAddrInet (fromIntegral port) a)
+      socketConnection s 8192)
+
+
+readConfigFile :: FilePath -> IO ConfigFile
+readConfigFile f = do
+  r <- decodeFileEither f
+  case r of
+    Left e -> do
+      hPutStrLn stderr $ "FATAL: " ++ f ++ ": " ++ show e
+      exitFailure
+    Right cf -> return cf
+
diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs
new file mode 100644
index 0000000..b760afc
--- /dev/null
+++ b/src/Sproxy/Server/DB.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Sproxy.Server.DB (
+  Database
+, DataSource(..)
+, userExists
+, userGroups
+, start
+) where
+
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Exception (SomeException, bracket, catch, finally)
+import Control.Monad (forever, void)
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 (pack)
+import Data.Pool (Pool, createPool, withResource)
+import Data.Text (Text, toLower, unpack)
+import Data.Text.Encoding (encodeUtf8)
+import Database.SQLite.Simple (NamedParam((:=)))
+import Text.InterpolatedString.Perl6 (q, qc)
+import qualified Database.PostgreSQL.Simple as PG
+import qualified Database.SQLite.Simple as SQLite
+
+import qualified Sproxy.Logging as Log
+
+
+type Database = Pool SQLite.Connection
+
+data DataSource = PostgreSQL String -- | File FilePath
+
+{- TODO:
+ - Hash remote tables and update the local only when the remote change
+ - Switch to REGEX
+ - Generalize sync procedures for different tables
+ -}
+
+start :: FilePath -> Maybe DataSource -> IO Database
+start home ds = do
+  Log.info $ "home directory: " ++ show home
+  db <- createPool    
+    (do c   <- SQLite.open $ home ++ "/sproxy.sqlite3"
+        lvl <- Log.level
+        SQLite.setTrace c (if lvl == Log.Debug then Just $ Log.debug . unpack else Nothing)
+        return c)
+    SQLite.close
+    1    -- stripes
+    3600 -- keep alive (seconds). FIXME: no much sense as it's a local file
+    128  -- max connections. FIXME: make configurable?
+
+  withResource db $ \c -> SQLite.execute_ c "PRAGMA journal_mode=WAL"
+  populate db ds
+  return db
+
+
+userExists :: Database -> String -> IO Bool
+userExists db email = do
+  r <- withResource db $ \c -> fmap SQLite.fromOnly <$> SQLite.queryNamed c
+    "SELECT EXISTS (SELECT 1 FROM group_member WHERE :email LIKE email LIMIT 1)"
+    [ ":email"  := email ]
+  return $ head r
+
+
+userGroups :: Database -> String -> Text -> Text -> Text -> IO [ByteString]
+userGroups db email domain path method =
+  withResource db $ \c -> fmap (encodeUtf8 . SQLite.fromOnly) <$> SQLite.queryNamed c [q|
+      SELECT gm."group" FROM group_privilege gp JOIN group_member gm ON gm."group"  = gp."group"
+      WHERE :email LIKE gm.email
+      AND :domain LIKE gp.domain
+      AND gp.privilege IN (
+        SELECT privilege FROM privilege_rule
+        WHERE :domain LIKE domain
+        AND :path LIKE path
+        AND method = :method
+        ORDER BY length(path) - length(replace(path, '/', '')) DESC LIMIT 1
+      )
+  |] [ ":email"  := email -- XXX always in lower case
+     , ":domain" := toLower domain
+     , ":path"   := path
+     , ":method" := method -- XXX case-sensitive by RFC2616
+     ]
+
+
+populate :: Database -> Maybe DataSource -> IO ()
+
+populate db Nothing = do
+  Log.warn "db: no data source defined"
+  withResource db $ \c -> SQLite.withTransaction c $ do
+    createGroupMember c
+    createGroupPrivilege c
+    createPrivilegeRule c
+
+-- XXX We keep only required minimum of the data, without any integrity check.
+-- XXX Integrity check should be done somewhere else, e. g. in the master PostgreSQL database,
+-- XXX or during importing the config file.
+populate db (Just (PostgreSQL connstr)) =
+  void . forkIO . forever . flip finally (7 `minutes` threadDelay)
+  . logException $ do
+    Log.info $ "db: synchronizing with " ++ show connstr
+    withResource db $ \c -> SQLite.withTransaction c $
+      bracket (PG.connectPostgreSQL $ pack connstr) PG.close $
+        \pg -> PG.withTransaction pg $ do
+
+          Log.info "db: syncing group_member"
+          dropGroupMember c
+          createGroupMember c
+          PG.forEach_ pg
+            [q|SELECT "group", lower(email) FROM group_member|] $ \r ->
+              SQLite.execute c
+                [q|INSERT INTO group_member("group", email) VALUES (?, ?)|]
+                  (r :: (Text, Text))
+          count c "group_member"
+
+          Log.info "db: syncing group_privilege"
+          dropGroupPrivilege c
+          createGroupPrivilege c
+          PG.forEach_ pg
+            [q|SELECT "group", lower(domain), privilege FROM group_privilege|] $ \r ->
+              SQLite.execute c
+                [q|INSERT INTO group_privilege("group", domain, privilege) VALUES (?, ?, ?)|]
+                  (r :: (Text, Text, Text))
+          count c "group_privilege"
+
+          Log.info "db: syncing privilege_rule"
+          dropPrivilegeRule c
+          createPrivilegeRule c
+          PG.forEach_ pg
+            [q|SELECT lower(domain), privilege, path, method FROM privilege_rule|] $ \r ->
+              SQLite.execute c
+                [q|INSERT INTO privilege_rule(domain, privilege, path, method) VALUES (?, ?, ?, ?)|]
+                  (r :: (Text, Text, Text, Text))
+          count c "privilege_rule"
+
+
+dropGroupMember :: SQLite.Connection -> IO ()
+dropGroupMember c = SQLite.execute_ c "DROP TABLE IF EXISTS group_member"
+
+createGroupMember :: SQLite.Connection -> IO ()
+createGroupMember c = SQLite.execute_ c [q|
+  CREATE TABLE IF NOT EXISTS group_member (
+    "group" TEXT,
+    email TEXT,
+    PRIMARY KEY ("group", email)
+  )
+|]
+
+
+dropGroupPrivilege :: SQLite.Connection -> IO ()
+dropGroupPrivilege c = SQLite.execute_ c "DROP TABLE IF EXISTS group_privilege"
+
+createGroupPrivilege :: SQLite.Connection -> IO ()
+createGroupPrivilege c = SQLite.execute_ c [q|
+  CREATE TABLE IF NOT EXISTS group_privilege (
+    "group" TEXT,
+    domain TEXT,
+    privilege TEXT,
+    PRIMARY KEY ("group", domain, privilege)
+  )
+|]
+
+
+dropPrivilegeRule :: SQLite.Connection -> IO ()
+dropPrivilegeRule c = SQLite.execute_ c "DROP TABLE IF EXISTS privilege_rule"
+
+createPrivilegeRule :: SQLite.Connection -> IO ()
+createPrivilegeRule c = SQLite.execute_ c [q|
+  CREATE TABLE IF NOT EXISTS privilege_rule (
+    domain TEXT,
+    privilege TEXT,
+    path TEXT,
+    method TEXT,
+    PRIMARY KEY (domain, path, method)
+  )
+|]
+
+
+count :: SQLite.Connection -> String -> IO ()
+count c table = do
+  r <- fmap SQLite.fromOnly <$> SQLite.query_ c [qc|SELECT COUNT(*) FROM {table}|]
+  Log.info $ "db: " ++ table ++ " rows: " ++ show (head r :: Integer)
+
+
+logException :: IO () -> IO ()
+logException a = catch a $ \e ->
+  Log.error $ "db: " ++ show (e :: SomeException)
+
+
+minutes :: Int -> (Int -> IO ()) -> IO ()
+minutes us f = f $ us * 60 * 1000000
+