From 48eedfeb6d480965068398839c55f37b410ed2f0 Mon Sep 17 00:00:00 2001
From: He Zhenxing <hezhenxing@gmail.com>
Date: Tue, 10 Mar 2026 21:38:30 +0800
Subject: [PATCH] Add cookieSecure option to Session class for LAN usage

- Add 'secure' field to Cookie data type
- Add 'cookieSecure' method to Session class (defaults to True)
- Update Cookie.render to conditionally include secure flag
- Fixes #185: Allows sessions to work when accessing via IP address
---
 src/Web/Hyperbole/Data/Cookie.hs    |  7 +++++--
 src/Web/Hyperbole/Effect/Session.hs | 10 ++++++++--
 test/Test/SessionSpec.hs            | 21 ++++++++++++++++++---
 3 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/src/Web/Hyperbole/Data/Cookie.hs b/src/Web/Hyperbole/Data/Cookie.hs
index 53606ea0..54becc25 100644
--- a/src/Web/Hyperbole/Data/Cookie.hs
+++ b/src/Web/Hyperbole/Data/Cookie.hs
@@ -19,6 +19,7 @@ data Cookie = Cookie
   { key :: Key
   , path :: Maybe Path
   , value :: Maybe CookieValue
+  , secure :: Bool
   }
   deriving (Show, Eq)
 
@@ -60,7 +61,9 @@ toList (Cookies m) = M.elems m
 render :: Path -> Cookie -> ByteString
 render requestPath cookie =
   let p = fromMaybe requestPath cookie.path
-   in cs cookie.key <> "=" <> value cookie.value <> "; SameSite=None; secure; path=" <> cs (uriToText (pathUri p))
+      secureFlag = if cookie.secure then "; secure" else ""
+      sameSite = if cookie.secure then "; SameSite=None" else "; SameSite=Lax"
+   in cs cookie.key <> "=" <> value cookie.value <> sameSite <> secureFlag <> "; path=" <> cs (uriToText (pathUri p))
  where
   value Nothing = "; expires=Thu, 01 Jan 1970 00:00:00 GMT"
   value (Just (CookieValue val)) = urlEncode True $ cs val
@@ -75,4 +78,4 @@ parse kvs = do
 parseValue :: ByteString -> ByteString -> Either String Cookie
 parseValue k val = do
   let cval = CookieValue $ cs $ urlDecode True val
-  pure $ Cookie (cs k) Nothing (Just $ cval)
+  pure $ Cookie (cs k) Nothing (Just $ cval) True
diff --git a/src/Web/Hyperbole/Effect/Session.hs b/src/Web/Hyperbole/Effect/Session.hs
index c648e2da..0441f9d2 100644
--- a/src/Web/Hyperbole/Effect/Session.hs
+++ b/src/Web/Hyperbole/Effect/Session.hs
@@ -42,6 +42,12 @@ class Session a where
   cookiePath = Nothing
 
 
+  -- | By default cookies are secure (HTTPS only). Set to False for local development or LAN usage
+  cookieSecure :: Bool
+  default cookieSecure :: Bool
+  cookieSecure = True
+
+
   -- | Encode type to a a cookie value
   toCookie :: a -> CookieValue
   default toCookie :: (ToEncoded a) => a -> CookieValue
@@ -113,7 +119,7 @@ modifySession_ f = do
 -- | Remove a single 'Session' from the browser cookies
 deleteSession :: forall a es. (Session a, Hyperbole :> es) => Eff es ()
 deleteSession = do
-  let cookie = Cookie (sessionKey @a) (cookiePath @a) Nothing
+  let cookie = Cookie (sessionKey @a) (cookiePath @a) Nothing (cookieSecure @a)
   modifyCookies $ Cookie.insert cookie
 
 
@@ -158,7 +164,7 @@ requestSessionCookies = do
 
 sessionCookie :: forall a. (Session a) => a -> Cookie
 sessionCookie a =
-  Cookie (sessionKey @a) (cookiePath @a) (Just $ toCookie a)
+  Cookie (sessionKey @a) (cookiePath @a) (Just $ toCookie a) (cookieSecure @a)
 
 
 -- | generic datatype name
diff --git a/test/Test/SessionSpec.hs b/test/Test/SessionSpec.hs
index 98702b39..275cb05f 100644
--- a/test/Test/SessionSpec.hs
+++ b/test/Test/SessionSpec.hs
@@ -21,6 +21,12 @@ instance Session Woot where
   cookiePath = Just $ Path ["somepage"]
 
 
+data InsecureSession = InsecureSession Text
+  deriving (Generic, Show, ToEncoded, FromEncoded)
+instance Session InsecureSession where
+  cookieSecure = False
+
+
 spec :: Spec
 spec = do
   describe "Session" $ do
@@ -31,16 +37,20 @@ spec = do
   describe "sessionCookie" $ do
     it "should create cookie" $ do
       let woot = Woot "hello"
-      sessionCookie woot `shouldBe` Cookie (sessionKey @Woot) (cookiePath @Woot) (Just (toCookie woot))
+      sessionCookie woot `shouldBe` Cookie (sessionKey @Woot) (cookiePath @Woot) (Just (toCookie woot)) (cookieSecure @Woot)
 
   describe "render" $ do
     it "should parse cookies" $ do
-      Cookie.parse [("Woot", "Woot")] `shouldBe` Right (Cookie.fromList [Cookie "Woot" Nothing (Just (CookieValue "Woot"))])
+      Cookie.parse [("Woot", "Woot")] `shouldBe` Right (Cookie.fromList [Cookie "Woot" Nothing (Just (CookieValue "Woot")) True])
 
     it "should render cookie with root path" $ do
-      let cookie = Cookie "Woot" Nothing (Just (CookieValue "Woot"))
+      let cookie = Cookie "Woot" Nothing (Just (CookieValue "Woot")) True
       Cookie.render [] cookie `shouldBe` "Woot=Woot; SameSite=None; secure; path=/"
 
+    it "should render non-secure cookie" $ do
+      let cookie = Cookie "Woot" Nothing (Just (CookieValue "Woot")) False
+      Cookie.render [] cookie `shouldBe` "Woot=Woot; SameSite=Lax; path=/"
+
     it "should render complex cookie with included path" $ do
       let woot = Woot "hello world"
       let cookie = sessionCookie woot
@@ -58,6 +68,11 @@ spec = do
       Just val <- pure $ Cookie.lookup (sessionKey @Preferences) cooks
       parseCookie val `shouldBe` Right prefs
 
+    it "should create non-secure cookie when cookieSecure is False" $ do
+      let insecure = InsecureSession "test"
+      let cookie = sessionCookie insecure
+      cookie.secure `shouldBe` False
+
 
 data Preferences = Preferences
   { message :: Text