Send AppRoot via HTTP header

1 files changed, 5 insertions, 1 deletions

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