From 08759871bcc3dc3b461650232747e58653535cdb Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 16 Mar 2017 20:03:34 +0100
Subject: Approot setting

---
 Foundation.hs       | 5 ++++-
 Settings.hs         | 6 ++++++
 config/settings.yml | 1 +
 3 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/Foundation.hs b/Foundation.hs
index d7425d5..27082fc 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -52,7 +52,10 @@ 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
-    approot = ApprootRequest $ \_ req -> maybe "" (TE.decodeUtf8With TEE.lenientDecode) $ Map.lookup "AppRoot" (Map.fromList $ requestHeaders req)
+    approot = ApprootRequest $ \app req ->
+        case appRoot $ appSettings app of
+            Nothing -> getApprootText guessApproot app req
+            Just root -> root
 
     -- 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 a15fb03..8a98c7a 100644
--- a/Settings.hs
+++ b/Settings.hs
@@ -35,6 +35,7 @@ data AppSettings = AppSettings
     -- ^ Directory from which to serve static files.
     , appDatabaseConf           :: PostgresConf
     -- ^ Configuration settings for accessing the database.
+    , appRoot                   :: Maybe Text
     , appHost                   :: HostPreference
     -- ^ Host/interface the server should bind to.
     , appPort                   :: Int
@@ -59,6 +60,11 @@ instance FromJSON AppSettings where
             parseUrl' = either (fail . show) return . parseBaseUrl
         appStaticDir              <- o .: "static-dir"
         appDatabaseConf           <- o .: "database"
+        appRoot'                  <- o .:? "approot"
+        let
+          appRoot
+            | appRoot' == Just "" = Nothing
+            | otherwise = appRoot'
         appHost                   <- fromString <$> o .: "host"
         appPort                   <- o .: "port"
         appIpFromHeader           <- o .: "ip-from-header"
diff --git a/config/settings.yml b/config/settings.yml
index c867908..f6332bd 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -1,4 +1,5 @@
 static-dir:     "_env:STATIC_DIR:static"
+approot:        "_env:APPROOT:"
 host:           "_env:HOST:*4" # any IPv4 host
 port:           "_env:PORT:3000"
 ip-from-header: "_env:IP_FROM_HEADER:false"
-- 
cgit v1.2.3