servant-auth中如何修改默认的SetCookie配置

How to modify the default SetCookie configuration in servant-auth

成功登录后,servant-auth 在响应中设置一个 JWT-Cookie cookie。问题是,它还将 cookie 标记为 HttpOnly,这意味着我无法在我的单页应用程序中读取 JWT。我的理解是,这可以使用 SetCookie 数据类型进行配置。我已经能够使用 defaultSetCookie { setCookieHttpOnly = False } 创建自己的自定义 SetCookie。如何将其填充到 acceptLogin 函数中?

这是我的登录处理程序。

checkCreds :: CookieSettings
           -> JWTSettings
           -> LoginRequest
           -> App (Headers '[ Header "Set-Cookie" SetCookie
                            , Header "Set-Cookie" SetCookie ]
                            NoContent)
checkCreds cookieSettings jwtSettings LoginRequest{email = email, rawPassword = rawPassword} = do
   maybeUser <- logicForFetchingAndValidatingUser
   -- What do I do with this mySetCookie? 
   let mySetCookie = defaultSetCookie { setCookieHttpOnly = False }
   case maybeUser of
     Just userView -> do
      mApplyCookies <- liftIO $ acceptLogin cookieSettings jwtSettings userView
      case mApplyCookies of
        Nothing           -> throwError err401
        Just applyCookies -> return $ applyCookies NoContent
     Nothing -> throwError err401

我阅读了 acceptLogin 的源代码,发现它调用了 makeSessionCookiemakeXsrfCookie,然后使用结果创建了一个用于添加 headers 的函数。我在我的代码中做了同样的事情,沿途修改 makeSessionCookie 的结果:

checkCreds :: CookieSettings
           -> JWTSettings
           -> LoginRequest
           -> App (Headers '[ Header "Set-Cookie" SetCookie
                            , Header "Set-Cookie" SetCookie]
                            NoContent)
checkCreds cookieSettings jwtSettings LoginRequest{email = email, rawPassword = rawPassword} = do
   -- Usually you would ask a database for the user info. This is just a
   -- regular servant handler, so you can follow your normal database access
   -- patterns (including using 'enter').
   maybeUser <- logicForFetchingAndValidatingUser
   case maybeUser of
     Just userView -> do
      mSessionCookie <- liftIO $ makeSessionCookie cookieSettings jwtSettings userView
      case mSessionCookie of
        Nothing -> throwError err401
        Just sessionCookie -> do
          let modifiedSessionCookie = sessionCookie { setCookieHttpOnly = False, setCookieSecure = False }
          xsrfCookie <- liftIO $ makeXsrfCookie cookieSettings
          return $ (addHeader modifiedSessionCookie . addHeader xsrfCookie) NoContent

     Nothing -> throwError err401