sessionIpAddress

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

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)