Initial commit

23 files changed, 1513 insertions, 0 deletions

diff --git a/.ghci b/.ghci
new file mode 100644
index 0000000..5fae2b2
--- /dev/null
+++ b/.ghci
@@ -0,0 +1,7 @@
+:set -fno-code
+:set -ferror-spans -freverse-errors -fprint-expanded-synonyms
+
+:def hlint const . return $ return $ ":! hlint \"src\""
+
+:set -isrc
+:load app/Main.hs
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..6d7e2df
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+dist-newstyle/
+result
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..d0a1fa1
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,373 @@
+Mozilla Public License Version 2.0
+==================================
+
+1. Definitions
+--------------
+
+1.1. "Contributor"
+    means each individual or legal entity that creates, contributes to
+    the creation of, or owns Covered Software.
+
+1.2. "Contributor Version"
+    means the combination of the Contributions of others (if any) used
+    by a Contributor and that particular Contributor's Contribution.
+
+1.3. "Contribution"
+    means Covered Software of a particular Contributor.
+
+1.4. "Covered Software"
+    means Source Code Form to which the initial Contributor has attached
+    the notice in Exhibit A, the Executable Form of such Source Code
+    Form, and Modifications of such Source Code Form, in each case
+    including portions thereof.
+
+1.5. "Incompatible With Secondary Licenses"
+    means
+
+    (a) that the initial Contributor has attached the notice described
+        in Exhibit B to the Covered Software; or
+
+    (b) that the Covered Software was made available under the terms of
+        version 1.1 or earlier of the License, but not also under the
+        terms of a Secondary License.
+
+1.6. "Executable Form"
+    means any form of the work other than Source Code Form.
+
+1.7. "Larger Work"
+    means a work that combines Covered Software with other material, in
+    a separate file or files, that is not Covered Software.
+
+1.8. "License"
+    means this document.
+
+1.9. "Licensable"
+    means having the right to grant, to the maximum extent possible,
+    whether at the time of the initial grant or subsequently, any and
+    all of the rights conveyed by this License.
+
+1.10. "Modifications"
+    means any of the following:
+
+    (a) any file in Source Code Form that results from an addition to,
+        deletion from, or modification of the contents of Covered
+        Software; or
+
+    (b) any new file in Source Code Form that contains any Covered
+        Software.
+
+1.11. "Patent Claims" of a Contributor
+    means any patent claim(s), including without limitation, method,
+    process, and apparatus claims, in any patent Licensable by such
+    Contributor that would be infringed, but for the grant of the
+    License, by the making, using, selling, offering for sale, having
+    made, import, or transfer of either its Contributions or its
+    Contributor Version.
+
+1.12. "Secondary License"
+    means either the GNU General Public License, Version 2.0, the GNU
+    Lesser General Public License, Version 2.1, the GNU Affero General
+    Public License, Version 3.0, or any later versions of those
+    licenses.
+
+1.13. "Source Code Form"
+    means the form of the work preferred for making modifications.
+
+1.14. "You" (or "Your")
+    means an individual or a legal entity exercising rights under this
+    License. For legal entities, "You" includes any entity that
+    controls, is controlled by, or is under common control with You. For
+    purposes of this definition, "control" means (a) the power, direct
+    or indirect, to cause the direction or management of such entity,
+    whether by contract or otherwise, or (b) ownership of more than
+    fifty percent (50%) of the outstanding shares or beneficial
+    ownership of such entity.
+
+2. License Grants and Conditions
+--------------------------------
+
+2.1. Grants
+
+Each Contributor hereby grants You a world-wide, royalty-free,
+non-exclusive license:
+
+(a) under intellectual property rights (other than patent or trademark)
+    Licensable by such Contributor to use, reproduce, make available,
+    modify, display, perform, distribute, and otherwise exploit its
+    Contributions, either on an unmodified basis, with Modifications, or
+    as part of a Larger Work; and
+
+(b) under Patent Claims of such Contributor to make, use, sell, offer
+    for sale, have made, import, and otherwise transfer either its
+    Contributions or its Contributor Version.
+
+2.2. Effective Date
+
+The licenses granted in Section 2.1 with respect to any Contribution
+become effective for each Contribution on the date the Contributor first
+distributes such Contribution.
+
+2.3. Limitations on Grant Scope
+
+The licenses granted in this Section 2 are the only rights granted under
+this License. No additional rights or licenses will be implied from the
+distribution or licensing of Covered Software under this License.
+Notwithstanding Section 2.1(b) above, no patent license is granted by a
+Contributor:
+
+(a) for any code that a Contributor has removed from Covered Software;
+    or
+
+(b) for infringements caused by: (i) Your and any other third party's
+    modifications of Covered Software, or (ii) the combination of its
+    Contributions with other software (except as part of its Contributor
+    Version); or
+
+(c) under Patent Claims infringed by Covered Software in the absence of
+    its Contributions.
+
+This License does not grant any rights in the trademarks, service marks,
+or logos of any Contributor (except as may be necessary to comply with
+the notice requirements in Section 3.4).
+
+2.4. Subsequent Licenses
+
+No Contributor makes additional grants as a result of Your choice to
+distribute the Covered Software under a subsequent version of this
+License (see Section 10.2) or under the terms of a Secondary License (if
+permitted under the terms of Section 3.3).
+
+2.5. Representation
+
+Each Contributor represents that the Contributor believes its
+Contributions are its original creation(s) or it has sufficient rights
+to grant the rights to its Contributions conveyed by this License.
+
+2.6. Fair Use
+
+This License is not intended to limit any rights You have under
+applicable copyright doctrines of fair use, fair dealing, or other
+equivalents.
+
+2.7. Conditions
+
+Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
+in Section 2.1.
+
+3. Responsibilities
+-------------------
+
+3.1. Distribution of Source Form
+
+All distribution of Covered Software in Source Code Form, including any
+Modifications that You create or to which You contribute, must be under
+the terms of this License. You must inform recipients that the Source
+Code Form of the Covered Software is governed by the terms of this
+License, and how they can obtain a copy of this License. You may not
+attempt to alter or restrict the recipients' rights in the Source Code
+Form.
+
+3.2. Distribution of Executable Form
+
+If You distribute Covered Software in Executable Form then:
+
+(a) such Covered Software must also be made available in Source Code
+    Form, as described in Section 3.1, and You must inform recipients of
+    the Executable Form how they can obtain a copy of such Source Code
+    Form by reasonable means in a timely manner, at a charge no more
+    than the cost of distribution to the recipient; and
+
+(b) You may distribute such Executable Form under the terms of this
+    License, or sublicense it under different terms, provided that the
+    license for the Executable Form does not attempt to limit or alter
+    the recipients' rights in the Source Code Form under this License.
+
+3.3. Distribution of a Larger Work
+
+You may create and distribute a Larger Work under terms of Your choice,
+provided that You also comply with the requirements of this License for
+the Covered Software. If the Larger Work is a combination of Covered
+Software with a work governed by one or more Secondary Licenses, and the
+Covered Software is not Incompatible With Secondary Licenses, this
+License permits You to additionally distribute such Covered Software
+under the terms of such Secondary License(s), so that the recipient of
+the Larger Work may, at their option, further distribute the Covered
+Software under the terms of either this License or such Secondary
+License(s).
+
+3.4. Notices
+
+You may not remove or alter the substance of any license notices
+(including copyright notices, patent notices, disclaimers of warranty,
+or limitations of liability) contained within the Source Code Form of
+the Covered Software, except that You may alter any license notices to
+the extent required to remedy known factual inaccuracies.
+
+3.5. Application of Additional Terms
+
+You may choose to offer, and to charge a fee for, warranty, support,
+indemnity or liability obligations to one or more recipients of Covered
+Software. However, You may do so only on Your own behalf, and not on
+behalf of any Contributor. You must make it absolutely clear that any
+such warranty, support, indemnity, or liability obligation is offered by
+You alone, and You hereby agree to indemnify every Contributor for any
+liability incurred by such Contributor as a result of warranty, support,
+indemnity or liability terms You offer. You may include additional
+disclaimers of warranty and limitations of liability specific to any
+jurisdiction.
+
+4. Inability to Comply Due to Statute or Regulation
+---------------------------------------------------
+
+If it is impossible for You to comply with any of the terms of this
+License with respect to some or all of the Covered Software due to
+statute, judicial order, or regulation then You must: (a) comply with
+the terms of this License to the maximum extent possible; and (b)
+describe the limitations and the code they affect. Such description must
+be placed in a text file included with all distributions of the Covered
+Software under this License. Except to the extent prohibited by statute
+or regulation, such description must be sufficiently detailed for a
+recipient of ordinary skill to be able to understand it.
+
+5. Termination
+--------------
+
+5.1. The rights granted under this License will terminate automatically
+if You fail to comply with any of its terms. However, if You become
+compliant, then the rights granted under this License from a particular
+Contributor are reinstated (a) provisionally, unless and until such
+Contributor explicitly and finally terminates Your grants, and (b) on an
+ongoing basis, if such Contributor fails to notify You of the
+non-compliance by some reasonable means prior to 60 days after You have
+come back into compliance. Moreover, Your grants from a particular
+Contributor are reinstated on an ongoing basis if such Contributor
+notifies You of the non-compliance by some reasonable means, this is the
+first time You have received notice of non-compliance with this License
+from such Contributor, and You become compliant prior to 30 days after
+Your receipt of the notice.
+
+5.2. If You initiate litigation against any entity by asserting a patent
+infringement claim (excluding declaratory judgment actions,
+counter-claims, and cross-claims) alleging that a Contributor Version
+directly or indirectly infringes any patent, then the rights granted to
+You by any and all Contributors for the Covered Software under Section
+2.1 of this License shall terminate.
+
+5.3. In the event of termination under Sections 5.1 or 5.2 above, all
+end user license agreements (excluding distributors and resellers) which
+have been validly granted by You or Your distributors under this License
+prior to termination shall survive termination.
+
+************************************************************************
+*                                                                      *
+*  6. Disclaimer of Warranty                                           *
+*  -------------------------                                           *
+*                                                                      *
+*  Covered Software is provided under this License on an "as is"       *
+*  basis, without warranty of any kind, either expressed, implied, or  *
+*  statutory, including, without limitation, warranties that the       *
+*  Covered Software is free of defects, merchantable, fit for a        *
+*  particular purpose or non-infringing. The entire risk as to the     *
+*  quality and performance of the Covered Software is with You.        *
+*  Should any Covered Software prove defective in any respect, You     *
+*  (not any Contributor) assume the cost of any necessary servicing,   *
+*  repair, or correction. This disclaimer of warranty constitutes an   *
+*  essential part of this License. No use of any Covered Software is   *
+*  authorized under this License except under this disclaimer.         *
+*                                                                      *
+************************************************************************
+
+************************************************************************
+*                                                                      *
+*  7. Limitation of Liability                                          *
+*  --------------------------                                          *
+*                                                                      *
+*  Under no circumstances and under no legal theory, whether tort      *
+*  (including negligence), contract, or otherwise, shall any           *
+*  Contributor, or anyone who distributes Covered Software as          *
+*  permitted above, be liable to You for any direct, indirect,         *
+*  special, incidental, or consequential damages of any character      *
+*  including, without limitation, damages for lost profits, loss of    *
+*  goodwill, work stoppage, computer failure or malfunction, or any    *
+*  and all other commercial damages or losses, even if such party      *
+*  shall have been informed of the possibility of such damages. This   *
+*  limitation of liability shall not apply to liability for death or   *
+*  personal injury resulting from such party's negligence to the       *
+*  extent applicable law prohibits such limitation. Some               *
+*  jurisdictions do not allow the exclusion or limitation of           *
+*  incidental or consequential damages, so this exclusion and          *
+*  limitation may not apply to You.                                    *
+*                                                                      *
+************************************************************************
+
+8. Litigation
+-------------
+
+Any litigation relating to this License may be brought only in the
+courts of a jurisdiction where the defendant maintains its principal
+place of business and such litigation shall be governed by laws of that
+jurisdiction, without reference to its conflict-of-law provisions.
+Nothing in this Section shall prevent a party's ability to bring
+cross-claims or counter-claims.
+
+9. Miscellaneous
+----------------
+
+This License represents the complete agreement concerning the subject
+matter hereof. If any provision of this License is held to be
+unenforceable, such provision shall be reformed only to the extent
+necessary to make it enforceable. Any law or regulation which provides
+that the language of a contract shall be construed against the drafter
+shall not be used to construe this License against a Contributor.
+
+10. Versions of the License
+---------------------------
+
+10.1. New Versions
+
+Mozilla Foundation is the license steward. Except as provided in Section
+10.3, no one other than the license steward has the right to modify or
+publish new versions of this License. Each version will be given a
+distinguishing version number.
+
+10.2. Effect of New Versions
+
+You may distribute the Covered Software under the terms of the version
+of the License under which You originally received the Covered Software,
+or under the terms of any subsequent version published by the license
+steward.
+
+10.3. Modified Versions
+
+If you create software not governed by this License, and you want to
+create a new license for such software, you may create and use a
+modified version of this License if you rename the license and remove
+any references to the name of the license steward (except to note that
+such modified license differs from this License).
+
+10.4. Distributing Source Code Form that is Incompatible With Secondary
+Licenses
+
+If You choose to distribute Source Code Form that is Incompatible With
+Secondary Licenses under the terms of this version of the License, the
+notice described in Exhibit B of this License must be attached.
+
+Exhibit A - Source Code Form License Notice
+-------------------------------------------
+
+  This Source Code Form is subject to the terms of the Mozilla Public
+  License, v. 2.0. If a copy of the MPL was not distributed with this
+  file, You can obtain one at https://mozilla.org/MPL/2.0/.
+
+If it is not possible or desirable to put the notice in a particular
+file, then You may include the notice in a location (such as a LICENSE
+file in a relevant directory) where a recipient would be likely to look
+for such a notice.
+
+You may add additional accurate notices of copyright ownership.
+
+Exhibit B - "Incompatible With Secondary Licenses" Notice
+---------------------------------------------------------
+
+  This Source Code Form is "Incompatible With Secondary Licenses", as
+  defined by the Mozilla Public License, v. 2.0.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..1ccb5e5
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,16 @@
+.PHONY: format
+format:
+	fourmolu -i app/
+	fourmolu -i src/
+
+.PHONY: lint
+lint:
+	find {app,src}/ | entr -c hlint src/ app/
+
+.PHONY: run
+run:
+	find {app,src}/ | entr -cr cabal new-run
+
+.PHONY: repl
+repl:
+	ghcid --allow-eval --lint --command "cabal repl"
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..68db103
--- /dev/null
+++ b/README.md
@@ -0,0 +1,22 @@
+# webmaild
+
+A small SMTP server with a web interface to visualize received emails.
+
+    webmaild -smtp-port 5678 -http-port 8765
+
+will start an SMTP and HTTP server locally, ready to accept emails. Go to http://localhost:8765 to view the emails received.
+
+No authentication is required, but it will happily accept any authentication method and ignore it.
+
+The default ports, if none are provided, are `5879` for SMTP and `9785` for HTTP.
+
+Note that this is based on very loose interpretations of the respective RFCs for SMTP, HTTP and emails, and is only intended to help with debugging. I tested with like, 2 emails, and it worked well enough (:
+
+## Building & Running
+
+The recommended solution is to use `nix`:
+
+- Use `nix profile install http://git.k.mulga.net/julien/webmaild/snapshot/webmaild-main.tar.gz` to install webmaild,
+- Use `nix run http://git.k.mulga.net/julien/webmaild/snapshot/webmaild-main.tar.gz` to build and run the binary directly.
+
+If you have `cabal` installed, use `cabal build` or `cabal install`.
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..e82d838
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,44 @@
+module Main (main) where
+
+import qualified Cache
+import Control.Concurrent (forkIO)
+import qualified Http
+import Intro
+import qualified Queue as Q
+import qualified Smtp
+import System.Environment (getArgs)
+
+data Opts = Opts {httpPort :: String, smtpPort :: String} deriving (Show)
+
+defaultHttpPort :: String
+defaultHttpPort = "9785"
+
+defaultSmtpPort :: String
+defaultSmtpPort = "5879"
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case (parseArgs args) of
+    Right opts -> do
+      putStrLn $ "Starting HTTP server at http://localhost:" ++ opts.httpPort
+      putStrLn $ "Starting SMTP server at smtp://localhost:" ++ opts.smtpPort
+
+      queue <- Q.newQueue
+      cache <- Cache.newInMemory
+      _ <- forkIO $ Cache.start queue cache
+      _ <- forkIO $ Http.runServer Nothing opts.httpPort cache queue
+      Smtp.runServer Nothing opts.smtpPort queue
+    Left err -> putStrLn ("Error. " ++ err)
+
+parseArgs :: [String] -> Either String Opts
+parseArgs args = parse args (Opts defaultHttpPort defaultSmtpPort)
+ where
+  parse [] opts = Right opts
+  parse (x1 : x2 : xs) opts
+    | x1 == "-http-port" = parse xs (opts{httpPort = x2})
+    | x1 == "-smtp-port" = parse xs (opts{smtpPort = x2})
+  parse (x : []) _
+    | x == "-http-port" = Left "Missing HTTP port"
+    | x == "-smtp-port" = Left "Missing SMTP port"
+  parse (x : _) _ = Left ("Unrecognized option: " ++ x)
diff --git a/flake.lock b/flake.lock
new file mode 100644
index 0000000..23f370c
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,80 @@
+{
+  "nodes": {
+    "flake-parts": {
+      "inputs": {
+        "nixpkgs-lib": "nixpkgs-lib"
+      },
+      "locked": {
+        "lastModified": 1709336216,
+        "narHash": "sha256-Dt/wOWeW6Sqm11Yh+2+t0dfEWxoMxGBvv3JpIocFl9E=",
+        "owner": "hercules-ci",
+        "repo": "flake-parts",
+        "rev": "f7b3c975cf067e56e7cda6cb098ebe3fb4d74ca2",
+        "type": "github"
+      },
+      "original": {
+        "owner": "hercules-ci",
+        "repo": "flake-parts",
+        "type": "github"
+      }
+    },
+    "haskell-flake": {
+      "locked": {
+        "lastModified": 1710675764,
+        "narHash": "sha256-ZpBoh1dVLTxC3wccOnsji7u/Ceuwh2raQn/Vq6BBYwo=",
+        "owner": "srid",
+        "repo": "haskell-flake",
+        "rev": "ef955d7d239d7f82f343b569a4cf2c7c1a4df1f4",
+        "type": "github"
+      },
+      "original": {
+        "owner": "srid",
+        "repo": "haskell-flake",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1710889954,
+        "narHash": "sha256-Pr6F5Pmd7JnNEMHHmspZ0qVqIBVxyZ13ik1pJtm2QXk=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "7872526e9c5332274ea5932a0c3270d6e4724f3b",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "nixpkgs-lib": {
+      "locked": {
+        "dir": "lib",
+        "lastModified": 1709237383,
+        "narHash": "sha256-cy6ArO4k5qTx+l5o+0mL9f5fa86tYUX3ozE1S+Txlds=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "1536926ef5621b09bba54035ae2bb6d806d72ac8",
+        "type": "github"
+      },
+      "original": {
+        "dir": "lib",
+        "owner": "NixOS",
+        "ref": "nixos-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "flake-parts": "flake-parts",
+        "haskell-flake": "haskell-flake",
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 0000000..ac71e74
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,25 @@
+{
+  inputs = {
+    nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
+    flake-parts.url = "github:hercules-ci/flake-parts";
+    haskell-flake.url = "github:srid/haskell-flake";
+  };
+  outputs = inputs@{ self, nixpkgs, flake-parts, ... }:
+    flake-parts.lib.mkFlake { inherit inputs; } {
+      systems = nixpkgs.lib.systems.flakeExposed;
+      imports = [ inputs.haskell-flake.flakeModule ];
+
+      perSystem = { self', pkgs, ... }: {
+
+        haskellProjects.default = {
+          devShell = {
+           enable = true;
+           tools = hp: { fourmolu = hp.fourmolu; ghcid = hp.ghcid; };
+           hlsCheck.enable = true;
+          };
+        };
+
+        packages.default = self'.packages.webmaild;
+      };
+    };
+}
diff --git a/fourmolu.yaml b/fourmolu.yaml
new file mode 100644
index 0000000..ce46be3
--- /dev/null
+++ b/fourmolu.yaml
@@ -0,0 +1,5 @@
+column-limit: 100
+comma-style: leading
+import-export-style: leading
+indentation: 2
+respectful: false
diff --git a/src/Cache.hs b/src/Cache.hs
new file mode 100644
index 0000000..b009770
--- /dev/null
+++ b/src/Cache.hs
@@ -0,0 +1,46 @@
+module Cache (newInMemory, start, CacheM, getInbox) where
+
+import Control.Concurrent.STM
+  ( TVar
+  , atomically
+  , newTVarIO
+  , readTVar
+  , readTVarIO
+  , writeTVar
+  )
+import Intro
+import qualified Mail as M
+import qualified Queue as Q
+
+data Cache = Cache
+  { count :: Int
+  , inbox :: [M.Mail]
+  }
+
+type CacheM = TVar Cache
+
+newInMemory :: IO CacheM
+newInMemory = newTVarIO newCache
+
+start :: Q.QueueM M.Mail -> CacheM -> IO ()
+start queue cache = go
+ where
+  go :: IO ()
+  go = do
+    mail <- Q.pull queue
+    updateCache cache (`addMail` mail)
+    go
+
+getInbox :: CacheM -> IO [M.Mail]
+getInbox c = inbox <$> readTVarIO c
+
+newCache :: Cache
+newCache = Cache 0 []
+
+addMail :: Cache -> M.Mail -> Cache
+addMail cache mail = cache{count = count cache + 1, inbox = mail : inbox cache}
+
+updateCache :: CacheM -> (Cache -> Cache) -> IO ()
+updateCache c f = atomically $ do
+  cache <- readTVar c
+  writeTVar c (f cache)
diff --git a/src/Common.hs b/src/Common.hs
new file mode 100644
index 0000000..91bf708
--- /dev/null
+++ b/src/Common.hs
@@ -0,0 +1,82 @@
+module Common
+  ( toLower
+  , trim
+  , trimWith
+  , splitOn
+  , split2
+  , replace
+  , (!!?)
+  , findVal
+  , maybeAt
+  , startsWith
+  , delete
+  )
+where
+
+import Data.Char (isSpace)
+import qualified Data.Char as C
+import Data.List (find, stripPrefix)
+import Intro
+
+trim :: String -> String
+trim = f . f
+ where
+  f = reverse . dropWhile isSpace
+
+trimWith :: (Char -> Bool) -> String -> String
+trimWith p = f . f
+ where
+  f = reverse . dropWhile p
+
+splitOn :: (a -> Bool) -> [a] -> [[a]]
+splitOn p s = case dropWhile p s of
+  [] -> []
+  s' -> w : splitOn p s''
+   where
+    (w, s'') = break p s'
+
+split2 :: (a -> Bool) -> [a] -> ([a], [a])
+split2 p s =
+  case break p s of
+    (x, _ : y) -> (x, y)
+    (x, []) -> (x, [])
+
+infix 9 !!?
+
+(!!?) :: [a] -> Int -> Maybe a
+(!!?) xs i
+  | i < 0 = Nothing
+  | otherwise = go i xs
+ where
+  go :: Int -> [a] -> Maybe a
+  go 0 (x : _) = Just x
+  go j (_ : ys) = go (j - 1) ys
+  go _ [] = Nothing
+
+maybeAt :: Int -> [a] -> Maybe a
+maybeAt = flip (!!?)
+
+toLower :: String -> String
+toLower = fmap C.toLower
+
+startsWith :: (a -> Bool) -> [a] -> Bool
+startsWith _ [] = False
+startsWith p (x : _) = p x
+
+findVal :: (a -> Bool) -> [(a, b)] -> Maybe b
+findVal p xs = snd <$> find (p . fst) xs
+
+replace :: (Eq a) => [a] -> [a] -> [a] -> [a]
+replace [] to xs = go xs
+ where
+  go [] = to
+  go (x : xs') = to ++ x : go xs'
+replace from to xs | Just xs' <- stripPrefix from xs = to ++ replace from to xs'
+replace from to (x : xs) = x : replace from to xs
+replace _ _ [] = []
+
+delete :: (a -> Bool) -> [a] -> (Maybe a, [a])
+delete p = foldr f (Nothing, [])
+ where
+  f x (Nothing, xs) | p x = (Just x, xs)
+  f x (m, xs) = (m, x : xs)
diff --git a/src/Common/Mime.hs b/src/Common/Mime.hs
new file mode 100644
index 0000000..5356312
--- /dev/null
+++ b/src/Common/Mime.hs
@@ -0,0 +1,23 @@
+module Common.Mime (getType, getSubtype, MimeType (..)) where
+
+import Common (split2, trim)
+import Intro
+
+data MimeType = Text String | Image String | Application String
+
+getType :: String -> Maybe MimeType
+getType mime = case type_ of
+  "text" -> Just (Text subtype)
+  "image" -> Just (Image subtype)
+  "application" -> Just (Application subtype)
+  _ -> Nothing
+ where
+  (type_, subtype) = split2 (== '/') $ trim mime
+
+getSubtype :: String -> String
+getSubtype = trim . snd . split2 (== '/')
+
+instance Show MimeType where
+  show (Text sub) = "text/" ++ sub
+  show (Image sub) = "image/" ++ sub
+  show (Application sub) = "application/" ++ sub
diff --git a/src/Html.hs b/src/Html.hs
new file mode 100644
index 0000000..dd60e16
--- /dev/null
+++ b/src/Html.hs
@@ -0,0 +1,88 @@
+module Html (span, html, p, hr, div_, iframe, img, main_, ul, li, table, td, th, tr, a) where
+
+import Data.List (unwords)
+import Intro
+
+type Attr = (String, String)
+
+html :: [String] -> String
+html xs =
+  concat
+    [ "<html>"
+    , "<head>"
+    , script
+        [ "function resizeIframe(x) { \
+          \  x.style.height = x.contentWindow.document.documentElement.scrollHeight + 'px'; \
+          \}"
+        ]
+    , "</head>"
+    , "<body>"
+    , style
+        [ ":root { font-size: 16px; }"
+        , "* { padding: 0; margin: 0; }"
+        , "body { display: flex; flex-direction: column; gap: 1rem; padding: 1rem; }"
+        , "hr { height: 0; border: 0; border-top: 1px solid #000; }"
+        , "table { border-collapse: collapse; width: 100%; }"
+        , "td, th { border: 1px solid #000; padding: 0.4rem; }"
+        , "iframe { width: 100%; min-height: 80vh; border: none; }"
+        , "main { display: flex; flex-direction: column; gap: 1rem; }"
+        , ".part { background-color: #eee; }"
+        , ".part-body { padding: 1rem; }"
+        ]
+    , concat xs
+    , "</body></html>"
+    ]
+
+hr :: String
+hr = "<hr>"
+
+style :: [String] -> String
+style xs = concat ["<style>", concat xs, "</style>"]
+
+script :: [String] -> String
+script xs = concat ["<script>", concat xs, "</script>"]
+
+iframe :: [Attr] -> [String] -> String
+iframe xs ys = concat ["<iframe onload='resizeIframe(this)' ", attrs xs, ">", concat ys, "</iframe>"]
+
+div_ :: [Attr] -> [String] -> String
+div_ xs ys = concat ["<div ", attrs xs, ">", concat ys, "</div>"]
+
+main_ :: [String] -> String
+main_ xs = concat ["<main>", concat xs, "</main>"]
+
+p :: [String] -> String
+p xs = concat ["<p>", concat xs, "</p>"]
+
+span :: [String] -> String
+span xs = concat ["<span>", concat xs, "</span>"]
+
+a :: [Attr] -> [String] -> String
+a xs ys = concat ["<a ", attrs xs, ">", concat ys, "</a>"]
+
+table :: [String] -> String
+table xs = concat ["<table>", concat xs, "</table>"]
+
+td :: [String] -> String
+td xs = concat ["<td>", concat xs, "</td>"]
+
+th :: [String] -> String
+th xs = concat ["<th>", concat xs, "</th>"]
+
+tr :: [String] -> String
+tr xs = concat ["<tr>", concat xs, "</tr>"]
+
+ul :: [String] -> String
+ul xs = concat ["<ul>", concat xs, "</ul>"]
+
+li :: [String] -> String
+li xs = concat ["<li>", concat xs, "</li>"]
+
+img :: [Attr] -> String
+img xs = concat ["<img ", attrs xs, ">"]
+
+attr :: Attr -> String
+attr (k, v) = concat [k, "='", v, "'"]
+
+attrs :: [Attr] -> String
+attrs xs = unwords (attr <$> xs)
diff --git a/src/Http.hs b/src/Http.hs
new file mode 100644
index 0000000..f486920
--- /dev/null
+++ b/src/Http.hs
@@ -0,0 +1,75 @@
+module Http (runServer) where
+
+import qualified Cache as C
+import Common (maybeAt, splitOn)
+import qualified Html as H
+import Intro
+import qualified Mail as M
+import Network.Socket (HostName, ServiceName, Socket, socketToHandle)
+import qualified Queue as Q
+import System.IO (Handle, IOMode (ReadWriteMode), hClose, hGetLine, hPutStrLn)
+import qualified Tcp
+import qualified Template as T
+import Text.Read (readMaybe)
+
+runServer :: Maybe HostName -> ServiceName -> C.CacheM -> Q.QueueM M.Mail -> IO ()
+runServer host port cache queue = Tcp.runServer host port (sockHandler cache queue)
+
+sockHandler :: C.CacheM -> Q.QueueM M.Mail -> Socket -> IO ()
+sockHandler cache queue s = do
+  handle <- socketToHandle s ReadWriteMode
+  requestHandler handle cache queue
+
+requestHandler :: Handle -> C.CacheM -> Q.QueueM M.Mail -> IO ()
+requestHandler h cache queue = do
+  line <- hGetLine h
+  case route line of
+    ("GET", []) -> showInbox h cache
+    ("GET", ["poll", s]) -> showPolled h queue s
+    ("GET", ["mail", n]) -> case (readMaybe n :: Maybe Int) of
+      Just n' -> showMail h cache n'
+      Nothing -> showNotFound h
+    _ -> showNotFound h
+  hClose h
+
+showNotFound :: Handle -> IO ()
+showNotFound h = do
+  replyHtml h 404 [H.p ["Page not found"]]
+
+showInbox :: Handle -> C.CacheM -> IO ()
+showInbox h cache = do
+  inbox <- C.getInbox cache
+  replyHtml h 200 (T.inbox inbox)
+
+showMail :: Handle -> C.CacheM -> Int -> IO ()
+showMail h cache idx = do
+  mail <- maybeAt idx <$> C.getInbox cache
+  case mail of
+    Just mail' -> replyHtml h 200 (T.mail mail')
+    Nothing -> showNotFound h
+
+showPolled :: Handle -> Q.QueueM M.Mail -> String -> IO ()
+showPolled h queue s = do
+  mail <- Q.pullWith (\m -> m.to == [s]) queue
+  replyHtml h 200 (T.mail mail)
+
+route :: String -> (String, [String])
+route x = case words x of
+  [m, p, "HTTP/1.1"] -> (m, splitOn (== '/') p)
+  _ -> ("GET", [])
+
+replyHtml :: Handle -> Int -> [String] -> IO ()
+replyHtml h s body = do
+  let page = H.html body
+  hPutStrLn h $ "HTTP/1.1 " ++ status s
+  hPutStrLn h "content-type: text/html"
+  hPutStrLn h $ "content-length: " ++ show (length page)
+  hPutStrLn h ""
+  hPutStrLn h page
+  hPutStrLn h ""
+
+status :: Int -> String
+status s = case s of
+  200 -> "200 OK"
+  404 -> "404 NOT FOUND"
+  _ -> "500 INTERNAL SERVER ERROR"
diff --git a/src/Intro.hs b/src/Intro.hs
new file mode 100644
index 0000000..46e35d4
--- /dev/null
+++ b/src/Intro.hs
@@ -0,0 +1,50 @@
+module Intro
+  ( ($)
+  , (&&)
+  , (+)
+  , (++)
+  , (-)
+  , (.)
+  , (/=)
+  , (<$>)
+  , (<)
+  , (=<<)
+  , (==)
+  , (>>=)
+  , (||)
+  , Bool (False, True)
+  , Char
+  , Eq
+  , IO
+  , Int
+  , Maybe (Just, Nothing)
+  , Either (Left, Right)
+  , Show
+  , String
+  , break
+  , concat
+  , const
+  , curry
+  , dropWhile
+  , filter
+  , flip
+  , foldr
+  , fst
+  , head
+  , length
+  , fmap
+  , mconcat
+  , not
+  , otherwise
+  , pure
+  , putStrLn
+  , reverse
+  , show
+  , snd
+  , words
+  , zip
+  , zipWith
+  )
+where
+
+import Prelude
diff --git a/src/Mail.hs b/src/Mail.hs
new file mode 100644
index 0000000..830f4da
--- /dev/null
+++ b/src/Mail.hs
@@ -0,0 +1,39 @@
+module Mail
+  ( Mail (..)
+  , subject
+  , Header
+  , P.Part (..)
+  , MailM
+  , newMail
+  , setData
+  )
+where
+
+import Common (toLower)
+import Control.Monad.State.Lazy (StateT)
+import Data.List (find)
+import Intro
+import Mail.Header (Header)
+import qualified Mail.Parser as P
+
+data Mail = Mail
+  { client :: String
+  , from :: String
+  , to :: [String]
+  , headers :: [Header]
+  , body :: [P.Part]
+  }
+  deriving (Show, Eq)
+
+type MailM a = StateT Mail IO a
+
+newMail :: Mail
+newMail = Mail "" "" [] [] []
+
+setData :: [String] -> Mail -> Mail
+setData xs m = m{headers = msg.headers, body = msg.body}
+ where
+  msg = P.run xs
+
+subject :: Mail -> Maybe String
+subject m = snd <$> find (\(k, _) -> toLower k == "subject") (headers m)
diff --git a/src/Mail/Header.hs b/src/Mail/Header.hs
new file mode 100644
index 0000000..e7265b2
--- /dev/null
+++ b/src/Mail/Header.hs
@@ -0,0 +1,45 @@
+module Mail.Header
+  ( ContentType (..)
+  , Header
+  , contentType
+  , contentTransferEncoding
+  )
+where
+
+import Common (findVal, split2, splitOn, toLower, trim, trimWith)
+import Intro
+
+type Header = (String, String)
+
+data ContentType = ContentType
+  { mime :: String
+  , boundary :: Maybe String
+  , charset :: Maybe String
+  }
+  deriving (Show)
+
+newContentType :: String -> ContentType
+newContentType m = ContentType{mime = m, boundary = Nothing, charset = Nothing}
+
+contentType :: [Header] -> Maybe ContentType
+contentType xs = do
+  v <- findValIns "content-type" xs
+  case (fmap trim . splitOn (== ';')) v of
+    [y] -> pure (newContentType y)
+    y : ys ->
+      let kv = fmap (split2 (== '=')) ys
+       in pure
+            $ (newContentType y)
+              { boundary = trimQuotes <$> findValIns "boundary" kv
+              , charset = findValIns "charset" kv
+              }
+    [] -> Nothing
+
+contentTransferEncoding :: [Header] -> Maybe String
+contentTransferEncoding = findValIns "content-transfer-encoding"
+
+findValIns :: String -> [Header] -> Maybe String
+findValIns k = findVal ((== k) . toLower)
+
+trimQuotes :: String -> String
+trimQuotes = trimWith (\x -> x == '"' || x == ' ')
diff --git a/src/Mail/Parser.hs b/src/Mail/Parser.hs
new file mode 100644
index 0000000..090602c
--- /dev/null
+++ b/src/Mail/Parser.hs
@@ -0,0 +1,136 @@
+module Mail.Parser (run, Message (..), Part (..)) where
+
+import Common (startsWith, trim)
+import Control.Monad.State (State, evalState, get, gets, modify)
+import Data.Char (isSpace)
+import Data.List (intercalate)
+import Intro
+import Mail.Header (Header)
+import qualified Mail.Header as H
+
+data Message = Message
+  { headers :: [Header]
+  , body :: [Part]
+  }
+  deriving (Show)
+
+data Part = Part
+  { headers :: [Header]
+  , body :: String -- TOOD: Scoped Fields extension
+  }
+  deriving (Show, Eq)
+
+data ParserState = InHeader (Maybe Header) | InBody deriving (Show, Eq)
+
+data Parser = Parser
+  { pHeaders :: [Header]
+  , pBody :: [String]
+  , pState :: ParserState
+  , pErrors :: [String]
+  }
+  deriving (Show)
+
+type MessageM = State Parser Message
+
+type PartM = State Parser Part
+
+newParser :: Parser
+newParser = Parser [] [] (InHeader Nothing) []
+
+run :: [String] -> Message
+run xs = evalState (parseMail xs) newParser
+
+parseMail :: [String] -> MessageM
+parseMail [] = gets (evalState parseMailBody)
+parseMail (x : xs) = do
+  s <- get
+  case pState s of
+    InHeader Nothing
+      | trim x == "" -> modify (setState InBody)
+      | otherwise -> case kv x of
+          Just (k, v) -> modify (setInHeader (k, v))
+          Nothing -> modify (setInHeaderStart . pushError x)
+    InHeader (Just (k, v))
+      | trim x == "" -> modify (setState InBody . pushHeader (k, v))
+      | startsWith isSpace x -> modify (setInHeader (k, v ++ x))
+      | otherwise -> case kv x of
+          Just (k', v') -> modify (setInHeader (k', v') . pushHeader (k, v))
+          Nothing -> modify (setInHeaderStart . pushHeader (k, v) . pushError x)
+    InBody -> modify (pushBody x)
+  parseMail xs
+
+parseMailBody :: MessageM
+parseMailBody = do
+  s <- get
+  pure $ case getBoundary s of
+    Just boundary ->
+      Message
+        { headers = pHeaders s
+        , body = getPart <$> bodyParts (reverse $ pBody s) boundary
+        }
+    Nothing ->
+      Message
+        { headers = pHeaders s
+        , body = [Part{headers = [], body = intercalate "\r\n" . reverse $ pBody s}]
+        }
+ where
+  getBoundary s = H.boundary =<< (H.contentType . pHeaders) s
+  getPart part = evalState (parsePart part) newParser
+
+parsePart :: [String] -> PartM
+parsePart [] = do
+  s <- get
+  pure $ Part{headers = pHeaders s, body = intercalate "\r\n" . reverse $ pBody s}
+parsePart (x : xs) = do
+  s <- get
+  case pState s of
+    InHeader Nothing
+      | trim x == "" -> modify (setState InBody)
+      | otherwise -> case kv x of
+          Just (k, v) -> modify (setInHeader (k, v))
+          Nothing -> modify (setInHeaderStart . pushError x)
+    InHeader (Just (k, v))
+      | trim x == "" -> modify (setState InBody . pushHeader (k, v))
+      | startsWith isSpace x -> modify (setInHeader (k, v ++ x))
+      | otherwise -> case kv x of
+          Just (k', v') -> modify (setInHeader (k', v') . pushHeader (k, v))
+          Nothing -> modify (setInHeaderStart . pushHeader (k, v) . pushError x)
+    InBody -> modify (pushBody x)
+  parsePart xs
+
+pushHeader :: Header -> Parser -> Parser
+pushHeader x p = p{pHeaders = (trim <$> x) : pHeaders p}
+
+pushBody :: String -> Parser -> Parser
+pushBody x p = p{pBody = trim x : pBody p}
+
+pushError :: String -> Parser -> Parser
+pushError x p = p{pErrors = x : pErrors p}
+
+setState :: ParserState -> Parser -> Parser
+setState x p = p{pState = x}
+
+setInHeaderStart :: Parser -> Parser
+setInHeaderStart p = p{pState = InHeader Nothing}
+
+setInHeader :: Header -> Parser -> Parser
+setInHeader x p = p{pState = InHeader $ Just x}
+
+kv :: String -> Maybe (String, String)
+kv x =
+  case break (== ':') x of
+    (k, _ : v) -> Just (k, v)
+    (_, []) -> Nothing
+
+bodyParts :: [String] -> String -> [[String]]
+bodyParts lines' boundary = filter (not . isEmptyPart) $ go lines' [] []
+ where
+  go :: [String] -> [String] -> [[String]] -> [[String]]
+  go [] _ parts = parts
+  go (x : xs) acc parts
+    | trim x == ("--" ++ boundary) = go xs [] (reverse acc : parts)
+    | otherwise = go xs (x : acc) parts
+
+isEmptyPart :: [String] -> Bool
+isEmptyPart [""] = True
+isEmptyPart _ = False
diff --git a/src/Queue.hs b/src/Queue.hs
new file mode 100644
index 0000000..56af251
--- /dev/null
+++ b/src/Queue.hs
@@ -0,0 +1,65 @@
+module Queue
+  ( Queue
+  , QueueM
+  , newQueue
+  , push
+  , pull
+  , pullWith
+  )
+where
+
+import Common (delete)
+import Control.Concurrent.STM
+  ( TChan
+  , TMVar
+  , TVar
+  , atomically
+  , newEmptyTMVarIO
+  , newTChan
+  , newTVar
+  , readTChan
+  , readTVar
+  , readTVarIO
+  , takeTMVar
+  , tryPutTMVar
+  , writeTChan
+  , writeTVar
+  )
+import Control.Monad (when)
+import Intro
+
+type Selector a = (a -> Bool)
+
+data Queue a = Queue
+  { inner :: TChan a
+  , selectors :: [(Selector a, TMVar a)]
+  }
+
+type QueueM a = TVar (Queue a)
+
+newQueue :: IO (QueueM a)
+newQueue = atomically $ do
+  chan <- newTChan
+  newTVar $ Queue chan []
+
+pullWith :: Selector a -> QueueM a -> IO a
+pullWith p queueM = do
+  q <- readTVarIO queueM
+  t <- newEmptyTMVarIO
+  atomically $ writeTVar queueM (q{selectors = (p, t) : q.selectors})
+  atomically $ takeTMVar t
+
+push :: QueueM a -> a -> IO ()
+push queueM x = atomically $ do
+  q <- readTVar queueM
+  case delete (\(p, _) -> p x) q.selectors of
+    (Just (_, t), xs) -> do
+      writeTChan q.inner x
+      isPut <- tryPutTMVar t x
+      when isPut $ writeTVar queueM (q{selectors = xs})
+    (Nothing, _) -> writeTChan q.inner x
+
+pull :: QueueM a -> IO a
+pull queueM = atomically $ do
+  q <- readTVar queueM
+  readTChan q.inner
diff --git a/src/Smtp.hs b/src/Smtp.hs
new file mode 100644
index 0000000..331f6d2
--- /dev/null
+++ b/src/Smtp.hs
@@ -0,0 +1,102 @@
+module Smtp (runServer) where
+
+import Common (splitOn, trim)
+import Control.Monad (unless, when)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Lazy (execStateT, modify)
+import Intro
+import qualified Mail as M
+import Network.Socket (HostName, ServiceName, Socket, socketToHandle)
+import qualified Queue as Q
+import System.IO (Handle, IOMode (ReadWriteMode), hClose, hGetLine, hPutStrLn)
+import qualified Tcp
+
+runServer :: Maybe HostName -> ServiceName -> Q.QueueM M.Mail -> IO ()
+runServer host port queue = Tcp.runServer host port (sockHandler queue)
+
+sockHandler :: Q.QueueM M.Mail -> Socket -> IO ()
+sockHandler queue s = do
+  handle <- socketToHandle s ReadWriteMode
+  hPutStrLn handle "220 service ready"
+  go handle
+ where
+  go :: Handle -> IO ()
+  go handle = do
+    mail <- execStateT (commandHandler handle) M.newMail
+    Q.push queue mail
+    go handle
+
+commandHandler :: Handle -> M.MailM ()
+commandHandler h = do
+  line <- liftIO $ hGetLine h
+  let command = words line
+  case command of
+    ["EHLO", client] -> do
+      modify (\s -> s{M.client = client})
+      replyOk h
+      commandHandler h
+    ["HELO", client] -> do
+      modify (\s -> s{M.client = client})
+      replyOk h
+      commandHandler h
+    ["AUTH", _, _] -> do
+      reply h 235 "authentication succeeded"
+      commandHandler h
+    ["MAIL", from] -> do
+      modify (\s -> s{M.from = readFrom from})
+      replyOk h
+      commandHandler h
+    ["RCPT", to] -> do
+      modify (\s -> s{M.to = readTo to : M.to s})
+      replyOk h
+      commandHandler h
+    ["DATA"] -> do
+      reply h 354 "start mail input"
+      dataHandler h
+    ["RSET"] -> do
+      modify (const M.newMail)
+      replyOk h
+    ["QUIT"] -> do
+      replyByeAndClose h
+    ["NOOP"] -> replyOk h
+    _ -> do
+      reply h 500 "unknown command"
+      liftIO $ putStrLn ("Unknown command: " ++ line)
+  pure ()
+
+dataHandler :: Handle -> M.MailM ()
+dataHandler handle = do
+  readData []
+  replyOk handle
+  replyByeAndClose handle
+ where
+  readData :: [String] -> M.MailM ()
+  readData xs = do
+    line <- liftIO $ hGetLine handle
+    let cont = trim line /= "."
+    when cont $ readData (line : xs)
+    unless cont $ modify (M.setData $ reverse xs)
+
+reply :: Handle -> Int -> String -> M.MailM ()
+reply handle status message =
+  liftIO
+    $ hPutStrLn handle
+    $ mconcat [show status, " ", message]
+
+replyOk :: Handle -> M.MailM ()
+replyOk handle = reply handle 250 "ok"
+
+replyByeAndClose :: Handle -> M.MailM ()
+replyByeAndClose handle = do
+  reply handle 221 "closing channel"
+  liftIO $ hClose handle
+
+readFrom :: String -> String
+readFrom s = filter (\c -> c /= '<' && c /= '>') $ case splitOn (== ':') s of
+  ["FROM", addr] -> addr
+  _ -> s
+
+readTo :: String -> String
+readTo s = filter (\c -> c /= '<' && c /= '>') $ case splitOn (== ':') s of
+  ["TO", addr] -> addr
+  _ -> s
diff --git a/src/Tcp.hs b/src/Tcp.hs
new file mode 100644
index 0000000..d0ee6c9
--- /dev/null
+++ b/src/Tcp.hs
@@ -0,0 +1,50 @@
+module Tcp (runServer) where
+
+import Control.Concurrent (forkFinally)
+import qualified Control.Exception as E
+import Control.Monad (forever, void)
+import Intro
+import Network.Socket
+  ( AddrInfoFlag (AI_PASSIVE)
+  , HostName
+  , ServiceName
+  , Socket
+  , SocketOption (ReuseAddr)
+  , SocketType (Stream)
+  , accept
+  , addrAddress
+  , addrFlags
+  , addrSocketType
+  , bind
+  , close
+  , defaultHints
+  , getAddrInfo
+  , gracefulClose
+  , listen
+  , openSocket
+  , setCloseOnExecIfNeeded
+  , setSocketOption
+  , withFdSocket
+  , withSocketsDo
+  )
+
+runServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
+runServer host port server = withSocketsDo $ do
+  addr <- resolve
+  E.bracket (open addr) close go
+ where
+  resolve = do
+    let hints = defaultHints{addrFlags = [AI_PASSIVE], addrSocketType = Stream}
+    head <$> getAddrInfo (Just hints) host (Just port)
+  open addr = E.bracketOnError (openSocket addr) close $ \sock -> do
+    setSocketOption sock ReuseAddr 1
+    withFdSocket sock setCloseOnExecIfNeeded
+    bind sock $ addrAddress addr
+    listen sock 1024
+    pure sock
+  go :: Socket -> IO a
+  go sock = forever
+    $ E.bracketOnError (accept sock) (close . fst)
+    $ \(conn, _peer) ->
+      void
+        $ forkFinally (server conn) (const $ gracefulClose conn 5000)
diff --git a/src/Template.hs b/src/Template.hs
new file mode 100644
index 0000000..ff13bd3
--- /dev/null
+++ b/src/Template.hs
@@ -0,0 +1,67 @@
+module Template (inbox, mail) where
+
+import Common (replace)
+import qualified Common.Mime as Mime
+import Data.List (intercalate)
+import Data.Maybe (fromMaybe)
+import qualified Html as H
+import Intro
+import qualified Mail as M
+import qualified Mail.Header as H
+
+inbox :: [M.Mail] -> [String]
+inbox xs =
+  [ H.p [show $ length xs, " messages."]
+  , H.table $ inboxHeader : zipWith (curry inboxRow) [0 ..] xs
+  ]
+
+inboxHeader :: String
+inboxHeader = H.tr [H.th ["Subject"], H.th ["From"], H.th ["To"]]
+
+inboxRow :: (Int, M.Mail) -> String
+inboxRow (i, m) =
+  H.tr
+    [ H.td [H.a [("href", "/mail/" ++ show i)] [fromMaybe "No subject" (M.subject m)]]
+    , H.td [M.from m]
+    , H.td (M.to m)
+    ]
+
+mail :: M.Mail -> [String]
+mail m =
+  [ H.a [("href", "/")] ["Inbox"]
+  , H.p ["From: ", M.from m]
+  , H.p ["To: ", intercalate ", " $ M.to m]
+  , H.table (mailHeader <$> m.headers)
+  , H.hr
+  , H.main_ (fmap (H.div_ [("class", "part")] . mailPart) m.body)
+  ]
+
+mailHeader :: M.Header -> String
+mailHeader (k, v) = H.tr [H.td [k], H.td [v]]
+
+mailPart :: M.Part -> [String]
+mailPart p =
+  [ H.table (mailHeader <$> p.headers)
+  , H.div_ [("class", "part-body")] [mailPartBody p]
+  ]
+
+mailPartBody :: M.Part -> String
+mailPartBody p = case (mimeType, encoding) of
+  (Just (Mime.Image _), Just "base64") -> H.img [("src", concat ["data:", show mimeType, ";base64,", p.body])]
+  (_, Just "quoted-printable") -> H.iframe [("srcdoc", decodeQP p.body)] []
+  _ -> H.iframe [("srcdoc", p.body)] []
+ where
+  mimeType = (H.contentType p.headers) >>= Mime.getType . H.mime
+  encoding = H.contentTransferEncoding p.headers
+
+-- "Handles" the "quoted-printable" encoding:
+-- https://datatracker.ietf.org/doc/html/rfc1521#section-5.1
+-- This is just wrong (or, wronger than the rest), but this part of the spec
+-- is crazy, so, whatever.
+decodeQP :: String -> String
+decodeQP =
+  replace "=3D" "="
+    . replace "=C2" ""
+    . replace "=A0" " "
+    . replace "=\r" ""
+    . replace "=\r\n" ""
diff --git a/webmaild.cabal b/webmaild.cabal
new file mode 100644
index 0000000..e2ee85c
--- /dev/null
+++ b/webmaild.cabal
@@ -0,0 +1,71 @@
+cabal-version:      3.0
+name:               webmaild
+version:            0.1.0.0
+license:            MPL-2.0
+license-file:       COPYING
+author:             evuez
+maintainer:         julien@mulga.net
+build-type:         Simple
+
+common warnings
+    ghc-options:
+      -Wall
+      -- -Werror
+      -- -Wall-missed-specialisations
+      -Wcpp-undef
+      -Widentities
+      -Wimplicit-prelude
+      -Wincomplete-record-updates
+      -Wincomplete-uni-patterns
+      -Wmissed-specialisations
+      -- -Wmissing-deriving-strategies
+      -Wmissing-export-lists
+      -Wmissing-exported-signatures
+      -Wmissing-home-modules
+      -- -Wmissing-import-lists
+      -Wmissing-local-signatures
+      -Wmonomorphism-restriction
+      -Wpartial-fields
+      -Wredundant-constraints
+      -Wunused-packages
+      -Wunused-type-patterns
+
+common exe
+    default-extensions:
+      NoImplicitPrelude
+      DuplicateRecordFields
+      OverloadedRecordDot
+    other-modules:
+      Cache
+      Common
+      Common.Mime
+      Html
+      Http
+      Intro
+      Mail
+      Mail.Header
+      Mail.Parser
+      Queue
+      Smtp
+      Tcp
+      Template
+    build-depends: base >=4.17.2.1, network, stm, mtl
+    hs-source-dirs: app,src
+    default-language: Haskell2010
+
+executable webmaild
+    import: warnings
+    import: exe
+    main-is: Main.hs
+    ghc-options:
+      -fno-expose-internal-symbols
+      -O2
+
+executable webmaild-dyn
+    import: warnings
+    import: exe
+    main-is: Main.hs
+    ghc-options:
+      -fno-expose-internal-symbols
+      -O2
+      -dynamic