From 53fcf55c02f9335518c28d26429913258fc28f87 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 14 Mar 2017 01:19:36 +0100
Subject: Extract appRoot from http headers

---
 Foundation.hs       | 17 ++++++++++-------
 Settings.hs         |  4 ----
 config/settings.yml | 11 ++---------
 3 files changed, 12 insertions(+), 20 deletions(-)

diff --git a/Foundation.hs b/Foundation.hs
index 85512a3..d192c08 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -1,12 +1,20 @@
 module Foundation where
 
-import Import.NoFoundation
+import Import.NoFoundation hiding (requestHeaders)
 import Database.Persist.Sql (ConnectionPool, runSqlPool)
 import Text.Hamlet          (hamletFile)
 
 import Yesod.Core.Types     (Logger)
 import qualified Yesod.Core.Unsafe as Unsafe
 
+import qualified Data.Text.Encoding                 as TE
+import qualified Data.Text.Encoding.Error           as TEE
+
+import Data.Map.Lazy (Map)
+import qualified Data.Map.Lazy as Map
+
+import Network.Wai (requestHeaders)
+
 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application
 -- starts running, such as database connections. Every handler will have
@@ -44,12 +52,7 @@ type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
 instance Yesod App where
-    -- Controls the base of generated URLs. For more information on modifying,
-    -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
-    approot = ApprootRequest $ \app req ->
-        case appRoot $ appSettings app of
-            Nothing -> getApprootText guessApproot app req
-            Just root -> root
+    approot = ApprootRequest $ \_ req -> maybe "" (TE.decodeUtf8With TEE.lenientDecode) $ Map.lookup "AppRoot" (Map.fromList $ requestHeaders req)
 
     -- Store session data on the client in encrypted cookies,
     -- default session idle timeout is 120 minutes
diff --git a/Settings.hs b/Settings.hs
index 76aa2f3..63cbd15 100644
--- a/Settings.hs
+++ b/Settings.hs
@@ -33,9 +33,6 @@ data AppSettings = AppSettings
     -- ^ Directory from which to serve static files.
     , appDatabaseConf           :: PostgresConf
     -- ^ Configuration settings for accessing the database.
-    , appRoot                   :: Maybe Text
-    -- ^ Base for all generated URLs. If @Nothing@, determined
-    -- from the request headers.
     , appHost                   :: HostPreference
     -- ^ Host/interface the server should bind to.
     , appPort                   :: Int
@@ -57,7 +54,6 @@ instance FromJSON AppSettings where
         let defaultDev = DEV_BOOL
         appStaticDir              <- o .: "static-dir"
         appDatabaseConf           <- o .: "database"
-        appRoot                   <- o .:? "approot"
         appHost                   <- fromString <$> o .: "host"
         appPort                   <- o .: "port"
         appIpFromHeader           <- o .: "ip-from-header"
diff --git a/config/settings.yml b/config/settings.yml
index fcae60c..83d3bfc 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -1,15 +1,8 @@
-# Values formatted like "_env:ENV_VAR_NAME:default_value" can be overridden by the specified environment variable.
-# See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables
-
 static-dir:     "_env:STATIC_DIR:static"
 host:           "_env:HOST:*4" # any IPv4 host
-port:           "_env:PORT:3000" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line.
+port:           "_env:PORT:3000"
 ip-from-header: "_env:IP_FROM_HEADER:false"
 
-# Default behavior: determine the application root from the request headers.
-# Uncomment to set an explicit approot
-approot:        "_env:APPROOT:"
-
 # Optional values with the following production defaults.
 # In development, they default to the inverse.
 #
@@ -21,6 +14,6 @@ database:
   user:     "_env:PGUSER:bar"
   password: "_env:PGPASS:"
   host:     "_env:PGHOST:"
-  port:     "_env:PGPORT:"
+  port:     "_env:PGPORT:5432"
   database: "_env:PGDATABASE:bar"
   poolsize: "_env:PGPOOLSIZE:10"
-- 
cgit v1.2.3