From 01e4ce0fa7c369996ec4ef3a033d16d6fa0eb715 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 31 Mar 2016 18:45:36 +0200
Subject: Use https link and secure cookie when activated

---
 src/server/Cookie.hs | 25 ++++++++++++++-----------
 1 file changed, 14 insertions(+), 11 deletions(-)

(limited to 'src/server/Cookie.hs')

diff --git a/src/server/Cookie.hs b/src/server/Cookie.hs
index 7ff5493..1495fc1 100644
--- a/src/server/Cookie.hs
+++ b/src/server/Cookie.hs
@@ -15,6 +15,9 @@ import qualified Data.Text as TS
 import qualified Data.Text.Encoding as TS
 import qualified Data.Text.Lazy.Encoding as TL
 
+import Conf (Conf)
+import qualified Conf
+
 import qualified Data.Map as Map
 
 import qualified Data.ByteString.Lazy as BSL
@@ -26,28 +29,28 @@ import Blaze.ByteString.Builder ( toLazyByteString )
 import Web.Scotty.Trans
 import Web.Cookie
 
-makeSimpleCookie :: TS.Text -> TS.Text -> SetCookie
-makeSimpleCookie n v =
+makeSimpleCookie :: Conf -> TS.Text -> TS.Text -> SetCookie
+makeSimpleCookie conf name value =
   def
-    { setCookieName  = TS.encodeUtf8 n
-    , setCookieValue = TS.encodeUtf8 v
+    { setCookieName  = TS.encodeUtf8 name
+    , setCookieValue = TS.encodeUtf8 value
     , setCookiePath = Just $ TS.encodeUtf8 "/"
-    , setCookieSecure = True
+    , setCookieSecure = Conf.https conf
     }
 
 setCookie :: (Monad m, ScottyError e) => SetCookie -> ActionT e m ()
-setCookie c = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie c)
+setCookie name = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie name)
 
-setSimpleCookie :: (Monad m, ScottyError e) => TS.Text -> TS.Text -> ActionT e m ()
-setSimpleCookie n v = setCookie $ makeSimpleCookie n v
+setSimpleCookie :: (Monad m, ScottyError e) => Conf -> TS.Text -> TS.Text -> ActionT e m ()
+setSimpleCookie conf name value = setCookie $ makeSimpleCookie conf name value
 
 getCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m (Maybe TS.Text)
-getCookie c = liftM (Map.lookup c) getCookies
+getCookie name = liftM (Map.lookup name) getCookies
 
 getCookies :: (Monad m, ScottyError e) => ActionT e m (Map.Map TS.Text TS.Text)
 getCookies =
   liftM (Map.fromList . maybe [] parse) $ header "Cookie"
   where parse = parseCookiesText . BSL.toStrict . TL.encodeUtf8
 
-deleteCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m ()
-deleteCookie c = setCookie $ (makeSimpleCookie c "") { setCookieExpires = Just $ posixSecondsToUTCTime 0 }
+deleteCookie :: (Monad m, ScottyError e) => Conf -> TS.Text -> ActionT e m ()
+deleteCookie conf name = setCookie $ (makeSimpleCookie conf name "") { setCookieExpires = Just $ posixSecondsToUTCTime 0 }
-- 
cgit v1.2.3