From faef893e09da05879ccd553ca3bfbfb9c051109f Mon Sep 17 00:00:00 2001
From: Abhinav Sarkar <abhinav@abhinavsarkar.net>
Date: Sun, 22 Jul 2018 08:13:01 +0530
Subject: [PATCH] Adds file descriptor and info caching

---
 README.md      |  5 +++--
 hastatic.cabal |  3 ++-
 package.yaml   |  1 +
 src/Main.hs    | 26 ++++++++++++++++++++------
 4 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/README.md b/README.md
index 2079176..7b78692 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
 # hastatic
 
-[![Docker Build Status](https://img.shields.io/docker/build/abhin4v/hastatic.svg?style=flat-square)](https://hub.docker.com/r/abhin4v/hastatic/) ![Docker Pulls](https://img.shields.io/docker/pulls/abhin4v/hastatic.svg?style=flat-square) ![MicroBadger Size](https://img.shields.io/microbadger/image-size/abhin4v/hastatic.svg?style=flat-square)
+[![Docker Build Status](https://img.shields.io/docker/build/abhin4v/hastatic.svg?style=flat-square)](https://hub.docker.com/r/abhin4v/hastatic/) [![Docker Pulls](https://img.shields.io/docker/pulls/abhin4v/hastatic.svg?style=flat-square)](https://hub.docker.com/r/abhin4v/hastatic/) [![MicroBadger Size](https://img.shields.io/microbadger/image-size/abhin4v/hastatic.svg?style=flat-square)](https://hub.docker.com/r/abhin4v/hastatic/)
 
 _hastatic_ is a tiny static web server for Docker.
 
@@ -14,6 +14,7 @@ _hastatic_ is a tiny static web server for Docker.
 - Supports custom index files for URLs ending with "/".
 - Takes care to not serve hidden files.
 - Adds caching headers automatically.
+- Caches file descriptors and info for better performance.
 
 ## Usage
 
@@ -51,4 +52,4 @@ The Docker image supports these environment variable for configuration:
 
 ## Internals
 
-_hastatic_ is written in Haskell, just 60 lines of it. It uses the excellent [Warp](https://hackage.haskell.org/package/warp) server underneath with the [warp-tls](https://hackage.haskell.org/package/warp-tls) package for TLS support.
+_hastatic_ is written in Haskell, just 60 lines of it. It uses the excellent [Warp](https://hackage.haskell.org/package/warp) server underneath with the [warp-tls](https://hackage.haskell.org/package/warp-tls) package for HTTPS support.
diff --git a/hastatic.cabal b/hastatic.cabal
index 24be909..d471304 100644
--- a/hastatic.cabal
+++ b/hastatic.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: e7a5e0192bba9ed055c360b88189436d278d96883c36e66a4a17b70f134f4654
+-- hash: 5fa75b100431a32f877dee2e76911b04d100a54f9562e0eb2f0500e9f6fded00
 
 name:           hastatic
 version:        0.9.0
@@ -26,6 +26,7 @@ executable hastatic
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2
   build-depends:
       base >=4.7 && <5
+    , bytestring
     , http-types
     , text
     , wai
diff --git a/package.yaml b/package.yaml
index 89538d5..76b47f4 100644
--- a/package.yaml
+++ b/package.yaml
@@ -29,3 +29,4 @@ executables:
     - http-types
     - wai-middleware-static
     - text
+    - bytestring
diff --git a/src/Main.hs b/src/Main.hs
index 8e10583..08ab8af 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,17 +1,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
+import qualified Data.ByteString.Char8 as C8
 import Data.Maybe (fromMaybe)
 import qualified Data.List as List
 import qualified Data.Text as T
+import Data.Version (showVersion)
 import Network.Wai
 import qualified Network.Wai.Handler.WarpTLS as TLS
 import Network.Wai.Middleware.Static
 import Network.HTTP.Types (status404)
-import Network.Wai.Handler.Warp (run, defaultSettings, setPort)
+import Network.Wai.Handler.Warp ( runSettings
+                                , defaultSettings
+                                , setPort
+                                , setFdCacheDuration
+                                , setFileInfoCacheDuration
+                                , setServerName
+                                )
 import System.Exit (die)
 import System.Environment (lookupEnv)
 import Text.Read (readMaybe)
+import Paths_hastatic (version)
 
 data TLS = Okay TLS.TLSSettings | Error String | None
 
@@ -56,18 +65,23 @@ application excludedPaths = do
 
 main :: IO ()
 main = do
-  mPort       <- lookupEnv "PORT"
-  let port    = fromMaybe 3000 (readMaybe =<< mPort)
-  tlsSettings <- getTLSSettings
+  mPort        <- lookupEnv "PORT"
+  let port     = fromMaybe 3000 (readMaybe =<< mPort)
+  tlsSettings  <- getTLSSettings
+  let settings = setPort port
+                 . setFdCacheDuration 10
+                 . setFileInfoCacheDuration 10
+                 . setServerName ("hastatic-" <> C8.pack (showVersion version))
+                 $ defaultSettings
 
   case tlsSettings of
     Okay tls  -> do
       app <- application [TLS.certFile tls, TLS.keyFile tls]
       putStrLn $ "Starting HTTPS server on port: " <> show port
-      TLS.runTLS tls (setPort port defaultSettings) app
+      TLS.runTLS tls settings app
     None      -> do
       app <- application []
       putStrLn $ "Starting HTTP server on port: " <> show port
-      run port app
+      runSettings settings app
     Error msg ->
       die $ "Error starting server: " <> msg