diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,19 @@
+Copyright 2022 Rick Owens
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+# om-http
+
+A hodge podge of interesting WAI `Middleware`s used by the rest of the
+om-* package ecosystem. Nothing particularly principled.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/om-http.cabal b/om-http.cabal
new file mode 100644
--- /dev/null
+++ b/om-http.cabal
@@ -0,0 +1,55 @@
+cabal-version:       3.0
+name:                om-http
+version:             0.3.0.1
+synopsis:            Http utilities.
+description:         Random HTTP utilities.
+homepage:            https://github.com/owensmurray/om-http
+license:             MIT
+license-file:        LICENSE
+author:              Rick Owens
+maintainer:          rick@owensmurray.com
+copyright:           2022 Owens Murray
+category:            Web
+build-type:          Simple
+extra-source-files:
+  README.md
+  LICENSE
+
+common dependencies
+  build-depends:
+    , async            >= 2.2.4     && < 2.3
+    , base             >= 4.15.0.0  && < 4.16
+    , bytestring       >= 0.10.12.1 && < 0.11
+    , directory        >= 1.3.6.2   && < 1.4
+    , filepath         >= 1.4.2.1   && < 1.5
+    , http-types       >= 0.12.3    && < 0.13
+    , mime-types       >= 0.1.1.0   && < 0.2
+    , monad-logger     >= 0.3.37    && < 0.4
+    , network          >= 3.1.2.7   && < 3.2
+    , om-show          >= 0.1.2.6   && < 0.2
+    , safe-exceptions  >= 0.1.7.3   && < 0.2
+    , servant          >= 0.19      && < 0.20
+    , template-haskell >= 2.17.0.0  && < 2.18
+    , text             >= 1.2.5.0   && < 1.3
+    , time             >= 1.9.3     && < 1.10
+    , unix             >= 2.7.2.2   && < 2.8
+    , uuid             >= 1.3.15    && < 1.4
+    , wai              >= 3.2.3     && < 3.3
+    , warp             >= 3.3.23    && < 3.4
+
+common warnings
+  ghc-options:
+    -Wall
+    -Wmissing-deriving-strategies
+    -Wmissing-export-lists
+    -Wmissing-import-lists
+    -Wredundant-constraints
+
+library
+  import: warnings, dependencies
+  exposed-modules:     
+    OM.HTTP
+  hs-source-dirs: src
+  default-language: Haskell2010
+
+
diff --git a/src/OM/HTTP.hs b/src/OM/HTTP.hs
new file mode 100644
--- /dev/null
+++ b/src/OM/HTTP.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+
+{- | Miscellaneous HTTP Utilities. -}
+module OM.HTTP (
+  runTlsRedirect,
+  hstsDirective,
+  requestLogging,
+  setServer,
+  insertResponseHeaderIfMissing,
+  overwriteResponseHeader,
+  staticSite,
+  logExceptionsAndContinue,
+  sshConnect,
+  staticPage,
+  defaultIndex,
+  BearerToken(..),
+) where
+
+
+import Prelude (Either(Left, Right), Eq((/=), (==)), Foldable(elem,
+  foldr), Functor(fmap), Maybe(Just, Nothing), Monad((>>), (>>=), return),
+  MonadFail(fail), RealFrac(truncate), Semigroup((<>)), Show(show),
+  Traversable(mapM), ($), (++), (.), (<$>), (=<<), FilePath, IO, Int,
+  String, concat, drop, filter, fst, id, mapM_, otherwise, putStrLn, zip)
+
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (concurrently_)
+import Control.Exception.Safe (SomeException, bracket, finally, throwM,
+  tryAny)
+import Control.Monad (join, void)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Logger (Loc, LogLevel, LogSource, LogStr,
+  MonadLoggerIO, logError, logInfo, runLoggingT)
+import Data.ByteString (ByteString)
+import Data.List ((\\))
+import Data.Maybe (catMaybes)
+import Data.String (IsString(fromString))
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
+import Data.UUID (UUID)
+import Data.UUID.V1 (nextUUID)
+import Data.Version (Version, showVersion)
+import Language.Haskell.TH (Code(examineCode), Q, TExp, runIO)
+import Language.Haskell.TH.Syntax (addDependentFile)
+import Network.HTTP.Types (Header, Status, internalServerError500,
+  methodNotAllowed405, movedPermanently301, ok200, statusCode,
+  statusMessage)
+import Network.Mime (defaultMimeLookup)
+import Network.Socket (AddrInfo(addrAddress), Family(AF_INET),
+  SocketType(Stream), Socket, close, connect, defaultProtocol,
+  getAddrInfo, socket)
+import Network.Socket.ByteString (recv, sendAll)
+import Network.Wai (Application, Middleware, Response, ResponseReceived,
+  mapResponseHeaders, pathInfo, rawPathInfo, rawQueryString,
+  requestMethod, responseLBS, responseRaw, responseStatus)
+import Network.Wai.Handler.Warp (run)
+import OM.Show (showt)
+import Servant.API (ToHttpApiData, toUrlPiece)
+import System.Directory (getDirectoryContents)
+import System.FilePath.Posix ((</>), combine)
+import System.Posix.Files (getFileStatus, isDirectory, isRegularFile)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy.Char8 as BSL8
+import qualified Data.Text as T
+
+
+{- |
+  Runs a web server on port 80, that redirects to the given url. Does
+  request logging, and sets the HSTS Directive header, and in the unlikely
+  event of excptions it will also catch and log them.
+-}
+runTlsRedirect 
+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) {- ^ Logging backend. -}
+  -> ByteString {- ^ Server name. -}
+  -> Version {- ^ Server version. -}
+  -> ByteString {- ^ Target URL. -}
+  -> IO ()
+runTlsRedirect logging serverName serverVersion url =
+  run 80
+    . requestLogging logging
+    . setServer serverName serverVersion
+    . hstsDirective 600
+    . logExceptionsAndContinue logging
+    $ tlsRedirect url
+
+
+{- |
+  Inject the HSTS directives, see
+  https://en.wikipedia.org/wiki/HTTP_Strict_Transport_Security.
+-}
+hstsDirective :: NominalDiffTime -> Middleware
+hstsDirective age = insertResponseHeaderIfMissing header
+  where
+    header :: Header
+    header =
+      ("Strict-Transport-Security", "max-age=" <> showt (truncate age :: Int))
+
+
+{- | Insert a response header only if it has not already been inserted. -}
+insertResponseHeaderIfMissing :: Header -> Middleware
+insertResponseHeaderIfMissing (name, val) app req respond =
+    app req (respond . mapResponseHeaders doInsert)
+  where
+    doInsert :: [Header] -> [Header]
+    doInsert headers
+      | name `elem` (fst <$> headers) = headers
+      | otherwise = (name, val):headers
+
+
+{- |
+  TLS redirect. An 'Application' that redirects unsecured requests to
+  the secure HTTPS site.
+-}
+tlsRedirect :: ByteString -> Application
+tlsRedirect url _req respond = respond $
+  responseLBS
+    movedPermanently301
+    [
+      ("Location", url),
+      ("Content-Type", "text/html")
+    ]
+    (
+      "<html>\
+        \<head>\
+        \</head>\
+        \<body>\
+          \Please use our secure site,\
+          \<a href=\"" <> BSL.fromStrict url <> "\">here</a>\
+        \</body>\
+      \</html>"
+    )
+
+
+{- | Set the @Server:@ header. -}
+setServer :: ByteString -> Version -> Middleware
+setServer serviceName version =
+    overwriteResponseHeader ("Server", serverValue)
+  where
+    {- | The value of the @Server:@ header. -}
+    serverValue = serviceName <> "/" <> fromString (showVersion version)
+
+
+{- |
+  Inserts a response header, clobbering any and all existing values for
+  the given header.
+-}
+overwriteResponseHeader :: Header -> Middleware
+overwriteResponseHeader (name, value) app req respond =
+    app req (respond . mapResponseHeaders go)
+  where
+    go :: [Header] -> [Header]
+    go headers =
+      (name, value) : filter ((/= name) . fst) headers
+
+
+{- |
+  Logs an HTTP request by emitting two log messages. The first messages
+  logs that the request has begun. The second messages logs the status
+  result and timing of the request once it is finished.
+
+  > Starting request: GET /foo
+  > GET /foo --> 200 Ok (0.001s)
+
+  This can help debugging requests that hang or crash for whatever reason.
+-}
+requestLogging
+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
+  -> Middleware
+requestLogging logging app req respond =
+    (`runLoggingT` logging) $ do
+      $(logInfo) $ "Starting request: " <> reqStr
+      liftIO . app req . loggingRespond =<< liftIO getCurrentTime
+  where
+    {- | Delegate to the underlying responder, and do some logging. -}
+    loggingRespond :: UTCTime -> Response -> IO ResponseReceived
+    loggingRespond start response = (`runLoggingT` logging) $ do
+      {-
+        Execute the underlying responder first so we get an accurate
+        measurement of the request duration.
+      -}
+      ack <- liftIO $ respond response
+      now <- liftIO getCurrentTime
+      $(logInfo)
+        $ reqStr <> " --> " <> showStatus (responseStatus response)
+        <> " (" <> showt (diffUTCTime now start) <> ")"
+      return ack
+
+    {- | A Text representation of the request, suitable for logging. -}
+    reqStr :: Text
+    reqStr = decodeUtf8
+      $ requestMethod req <> " " <> rawPathInfo req <> rawQueryString req
+
+    {- |
+      @instance Show Status@ shows the Haskell structure, which is
+      not suitable for logging.
+    -}
+    showStatus :: Status -> Text
+    showStatus stat =
+      (showt . statusCode) stat <> " " <> (decodeUtf8 . statusMessage) stat
+
+
+{- |
+  Logs all exceptions, and returns a 500 Internal Server error. 
+
+  This is useful because your wai framework won't always do what you
+  expect when it encounters random exceptions. For instance, an exception
+  thrown in IO may cause functionality of higher-level middlewares to be
+  bypassed unless they know how to catch and re-throw exceptions (making
+  them more complicated). This middleware explicitly will not re-throw
+  exceptions, unless those exceptions were encountered after the headers
+  have already been sent, e.g. when using 'Network.Wai.StreamingBody'.
+  
+  What it will do is generate a unique id for the exception and print
+  that ID, so you can easily find it in the logs.
+-}
+logExceptionsAndContinue
+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) {- ^ Logging backend. -}
+  -> Middleware
+logExceptionsAndContinue logging app req respond = (`runLoggingT` logging) $
+    tryAny (liftIO (app req loggingRespond)) >>= \case
+      Right ack -> return ack
+      Left err -> do
+        uuid <- logProblem err
+        liftIO $ respond (errResponse uuid)
+
+  where
+    errResponse :: UUID -> Response
+    errResponse uuid =
+      responseLBS
+        internalServerError500
+        [("Content-Type", "text/plain")] 
+        ("Internal Server Error. Error ID: " <> showt uuid)
+
+    getUUID :: (MonadIO m) => m UUID
+    getUUID = liftIO nextUUID >>= \case
+      Nothing -> liftIO (threadDelay 1000) >> getUUID
+      Just uuid -> return uuid
+
+    loggingRespond :: Response -> IO ResponseReceived
+    loggingRespond response = (`runLoggingT` logging) $
+      tryAny (liftIO (respond response)) >>= \case
+        Right ack -> return ack
+        Left err -> do
+          void $ logProblem err
+          throwM err
+
+    logProblem :: (MonadLoggerIO m) => SomeException -> m UUID
+    logProblem err = do
+      uuid <- getUUID
+      $(logError)
+        $ "Internal Server Error [" <> showt uuid <> "]: "
+        <> showt err
+      return uuid
+
+
+{- |
+  'Middleware' that provides an HTTP @CONNECT@ passthrough to the local
+  ssh port. Useful primarily for bypassing content-inspection firewalls.
+-}
+sshConnect :: Middleware
+sshConnect app req respond =
+    case requestMethod req of
+      "CONNECT" ->
+        respond (responseRaw connProxy (responseLBS methodNotAllowed405 [] ""))
+      _ -> app req respond
+  where
+    {- |
+      Open a connection to the local ssh port and mediate the traffic between
+      that service and the client.
+    -}
+    connProxy :: IO ByteString -> (ByteString -> IO ()) -> IO ()
+    connProxy read_ write =
+      bracket
+        (socket AF_INET Stream defaultProtocol)
+        (\so ->  close so `finally` write "") 
+        (\so -> do
+          connect so =<<
+            (
+              getAddrInfo Nothing (Just "127.0.0.1") (Just "22") >>= \case
+                [] -> fail "Address not found: 127.0.0.1:22"
+                sa:_ -> return (addrAddress sa)
+            )
+          concurrently_
+            (pipeInbound so read_)
+            (pipeOutbound so write)
+        )
+
+    {- | Forward data coming from the client, going to the ssh service. -}
+    pipeInbound :: Socket -> IO ByteString -> IO ()
+    pipeInbound so read_ = do
+      bytes <- read_
+      if BS.null bytes
+        then return ()
+        else do
+          sendAll so bytes
+          pipeInbound so read_
+
+    {- | Forward data coming from the ssh service, going to the client. -}
+    pipeOutbound :: Socket -> (ByteString -> IO ()) -> IO ()
+    pipeOutbound so write = do
+      bytes <- recv so 4096
+      write bytes
+      if BS.null bytes
+        then return ()
+        else pipeOutbound so write
+
+
+{- | Serve a static page at the given 'pathInfo'. -}
+staticPage
+  :: [Text] {- ^ The path info. -}
+  -> ByteString {- ^ The content type. -}
+  -> BSL.ByteString {- ^ The response body content. -}
+  -> Middleware
+staticPage path ct bytes app req respond =
+  if pathInfo req == path
+    then respond (responseLBS ok200 [("Content-Type", ct)] bytes)
+    else app req respond
+
+
+{- | Rewrite: "\/" -> "/index.html". -}
+defaultIndex :: Middleware
+defaultIndex app request respond =
+  case pathInfo request of
+    [] -> app request {pathInfo = ["index.html"]} respond
+    _ -> app request respond
+
+
+{- |
+  A bearer token, which is an instance of the necessary type classes to
+  be useful as a servant header value.
+-}
+newtype BearerToken = BearerToken {
+    unBearerToken :: Text
+  }
+instance ToHttpApiData BearerToken where
+  toUrlPiece t = "Bearer " <> unBearerToken t
+
+
+{- |
+  The Template-Haskell splice @$$(staticSite dir)@ will build a
+  'Middleware' that serves a set of static files determined at
+  compile time, or else passes the request to the underlying
+  'Network.Wai.Application'.
+
+  All files under @dir@ will be served relative to the root path of
+  your web server, so the file @\<dir\>\/foo\/bar.html@ will be served at
+  @http://your-web-site.com/foo/bar.html@
+
+  The content-type of the files being served will be guessed using
+  'defaultMimeLookup'.
+-}
+staticSite :: FilePath -> Q (TExp Middleware)
+staticSite baseDir = join . runIO $ do
+    files <- readStaticFiles
+    mapM_ (printResource . fst) files
+    return $ mapM_ (addDependentFile . ((baseDir ++ "/") ++) . fst) files >> examineCode [||
+        let
+          {- |
+            Build a middleware that serves a single static file path, or
+            delegates to the underlying application.
+          -}
+          static :: (FilePath, String) -> Middleware
+          static (filename, content) app req respond =
+            let
+              {- | Guess the content type of the static file. -}
+              ct :: ByteString
+              ct =
+                defaultMimeLookup
+                . fromString
+                $ filename
+            in
+              if pathInfo req == T.split (== '/') (T.pack filename)
+                then
+                  respond (
+                      responseLBS
+                        ok200
+                        [("content-type", ct)]
+                        (BSL8.pack content)
+                    )
+                else app req respond
+        in
+          foldr (.) id (fmap static files) :: Middleware
+      ||]
+  where
+    printResource :: String -> IO ()
+    printResource file =
+      putStrLn ("Generating static resource for: " ++ show file)
+
+    {- | Reads the static files that make up the admin user interface. -}
+    readStaticFiles :: IO [(FilePath, String)]
+    readStaticFiles =
+      let
+        findAll :: FilePath -> IO [FilePath]
+        findAll dir = do
+            contents <-
+              (\\ [".", ".."]) <$> getDirectoryContents (baseDir </> dir)
+            dirs <- catMaybes <$> mapM justDir contents
+            files <- catMaybes <$> mapM justFile contents
+            more <- concat <$> mapM (findAll . combine dir) dirs
+            return $ (combine dir <$> files) ++ more
+          where
+            justFile :: FilePath -> IO (Maybe FilePath)
+            justFile filename = do
+              isfile <-
+                isRegularFile <$>
+                  getFileStatus (baseDir </> dir </> filename)
+              return $ if isfile then Just filename else Nothing
+
+            justDir :: FilePath -> IO (Maybe FilePath)
+            justDir filename = do
+              isdir <-
+                isDirectory <$>
+                  getFileStatus (baseDir </> dir </> filename)
+              return $ if isdir then Just filename else Nothing
+      in do
+        allFiles <- findAll "."
+        allContent
+          <- mapM (fmap BS8.unpack . BS.readFile . combine baseDir) allFiles
+        return (zip (drop 2 <$> allFiles) allContent)
+
+