From 05b4d3e9ce3cec9eb8595ae6328a79cf36602c80 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 25 Oct 2010 12:49:26 +0200
Subject: [PATCH] sessionIpAddress

---
 Yesod/Dispatch.hs | 2 +-
 Yesod/Yesod.hs    | 5 +++++
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
index 73aaece9..5ffe1ab9 100644
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -225,7 +225,7 @@ toWaiApp' y segments env = do
     now <- getCurrentTime
     let getExpires m = fromIntegral (m * 60) `addUTCTime` now
     let exp' = getExpires $ clientSessionDuration y
-    let host = W.remoteHost env
+    let host = if sessionIpAddress y then W.remoteHost env else ""
     let session' = fromMaybe [] $ do
             raw <- lookup "Cookie" $ W.requestHeaders env
             val <- lookup (B.pack sessionName) $ parseCookies raw
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 32b72431..121177e7 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -209,6 +209,11 @@ class Eq (Route a) => Yesod a where
                      -> GHandler sub a (Maybe (Either String (Route a, [(String, String)])))
     addStaticContent _ _ _ = return Nothing
 
+    -- | Whether or not to tie a session to a specific IP address. Defaults to
+    -- 'True'.
+    sessionIpAddress :: a -> Bool
+    sessionIpAddress _ = True
+
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
     deriving (Eq, Show, Read)