Send AppRoot via HTTP header

2 files changed, 6 insertions, 1 deletions

diff --git a/bragi.nix b/bragi.nix
index cc8c5976..d00f2598 100644
--- a/bragi.nix
+++ b/bragi.nix
@@ -369,6 +369,7 @@ in rec {
         }
 
         location /bar/ {
+          proxy_set_header AppRoot "http://$server_name/bar";
           proxy_pass http://localhost:8082/;
         }
       }
diff --git a/bragi/bar.hs b/bragi/bar.hs
index 61d24119..1cf10fdf 100755
--- a/bragi/bar.hs
+++ b/bragi/bar.hs
@@ -19,6 +19,7 @@
 
 import Yesod
 import Database.Persist.Postgresql
+import Network.Wai (requestHeaders)
   
 import Control.Monad.Logger (runStderrLoggingT)
 import Control.Monad.Reader
@@ -32,6 +33,9 @@ import Data.Time.Format
 import Data.Text (Text)
 import qualified Data.Text as Text
 
+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
 
@@ -124,7 +128,7 @@ mkYesod "BarInventory" [parseRoutes|
 |]
 
 instance Yesod BarInventory where
-  approot = guessApproot
+  approot = ApprootRequest $ \_ req -> maybe "" (TE.decodeUtf8With TEE.lenientDecode) $ Map.lookup "AppRoot" (Map.fromList $ requestHeaders req)
 
 instance RenderMessage BarInventory FormMessage where
   renderMessage _ _ = defaultFormMessage