Fixed some various FIXMEs

This commit is contained in:
Michael Snoyman 2010-05-05 05:12:56 +03:00
parent fd0ce32687
commit 6db0589936
5 changed files with 21 additions and 19 deletions

View File

@ -109,7 +109,7 @@ toWaiApp a = do
$ jsonp $ jsonp
$ methodOverride $ methodOverride
$ cleanPath $ cleanPath
$ \thePath -> clientsession [sessionName] key' mins $ \thePath -> clientsession [sessionName] key' mins -- FIXME middleware is not helping us here, drop it
$ toWaiApp' a thePath $ toWaiApp' a thePath
parseSession :: B.ByteString -> [(String, String)] parseSession :: B.ByteString -> [(String, String)]

View File

@ -9,6 +9,7 @@ module Yesod.Hamlet
Hamlet Hamlet
, hamlet , hamlet
, HtmlContent (..) , HtmlContent (..)
, htmlContentToText
-- * Convert to something displayable -- * Convert to something displayable
, hamletToContent , hamletToContent
, hamletToRepHtml , hamletToRepHtml
@ -27,6 +28,12 @@ import Data.Convertible.Text
import Data.Object -- FIXME should we kill this? import Data.Object -- FIXME should we kill this?
import Control.Arrow ((***)) import Control.Arrow ((***))
import Web.Routes.Quasi (Routes) import Web.Routes.Quasi (Routes)
import Data.Text (Text)
import Web.Encodings (encodeHtml)
htmlContentToText :: HtmlContent -> Text
htmlContentToText (Encoded t) = t
htmlContentToText (Unencoded t) = encodeHtml t
-- | Content for a web page. By providing this datatype, we can easily create -- | Content for a web page. By providing this datatype, we can easily create
-- generic site templates, which would have the type signature: -- generic site templates, which would have the type signature:

View File

@ -46,7 +46,6 @@ import Data.Typeable (Typeable)
import Control.Exception (Exception) import Control.Exception (Exception)
-- FIXME check referer header to determine destination -- FIXME check referer header to determine destination
-- FIXME switch to session
getAuth :: a -> Auth getAuth :: a -> Auth
getAuth = const Auth getAuth = const Auth
@ -131,7 +130,7 @@ getOpenIdComplete = do
let onFailure err = redirectString RedirectTemporary $ errurl err let onFailure err = redirectString RedirectTemporary $ errurl err
let onSuccess (OpenId.Identifier ident) = do let onSuccess (OpenId.Identifier ident) = do
y <- getYesodMaster y <- getYesodMaster
header authCookieName ident setSession identKey ident
redirectToDest RedirectTemporary $ renderm $ defaultDest y redirectToDest RedirectTemporary $ renderm $ defaultDest y
attempt onFailure onSuccess res attempt onFailure onSuccess res
@ -156,8 +155,8 @@ handleRpxnowR = do
(d:_) -> d (d:_) -> d
ident <- liftIO $ Rpxnow.authenticate apiKey token ident <- liftIO $ Rpxnow.authenticate apiKey token
onRpxnowLogin ident onRpxnowLogin ident
header authCookieName $ Rpxnow.identifier ident setSession identKey $ Rpxnow.identifier ident
header authDisplayName $ getDisplayName ident setSession displayNameKey $ getDisplayName ident
redirectToDest RedirectTemporary dest redirectToDest RedirectTemporary dest
data MissingToken = MissingToken data MissingToken = MissingToken
@ -194,7 +193,7 @@ getCheck = do
getLogout :: YesodAuth master => GHandler Auth master () getLogout :: YesodAuth master => GHandler Auth master ()
getLogout = do getLogout = do
y <- getYesodMaster y <- getYesodMaster
deleteCookie authCookieName clearSession identKey
render <- getUrlRenderMaster render <- getUrlRenderMaster
redirectToDest RedirectTemporary $ render $ defaultDest y redirectToDest RedirectTemporary $ render $ defaultDest y
@ -202,13 +201,13 @@ getLogout = do
maybeIdentifier :: RequestReader m => m (Maybe String) maybeIdentifier :: RequestReader m => m (Maybe String)
maybeIdentifier = do maybeIdentifier = do
s <- session s <- session
return $ listToMaybe $ s authCookieName return $ listToMaybe $ s identKey
-- | Gets the display name for a user if available. -- | Gets the display name for a user if available.
displayName :: RequestReader m => m (Maybe String) displayName :: RequestReader m => m (Maybe String)
displayName = do displayName = do
s <- session s <- session
return $ listToMaybe $ s authDisplayName return $ listToMaybe $ s displayNameKey
-- | Gets the identifier for a user. If user is not logged in, redirects them -- | Gets the identifier for a user. If user is not logged in, redirects them
-- to the login page. -- to the login page.
@ -251,12 +250,13 @@ redirectToDest rt def = do
return x return x
redirectString rt dest redirectString rt dest
authCookieName :: String -- FIXME don't use cookies!!! identKey :: String
authCookieName = "IDENTIFIER" identKey = "IDENTIFIER"
authDisplayName :: String displayNameKey :: String
authDisplayName = "DISPLAY_NAME" displayNameKey = "DISPLAY_NAME"
-- FIXME export DEST stuff as its own module
destCookieTimeout :: Int destCookieTimeout :: Int
destCookieTimeout = 120 destCookieTimeout = 120

View File

@ -6,7 +6,6 @@ module Yesod.Json
Json Json
, jsonToContent , jsonToContent
, jsonToRepJson , jsonToRepJson
, htmlContentToText -- FIXME put elsewhere?
-- * Generate Json output -- * Generate Json output
, jsonScalar , jsonScalar
, jsonList , jsonList
@ -21,7 +20,7 @@ module Yesod.Json
import Text.Hamlet.Monad import Text.Hamlet.Monad
import Control.Applicative import Control.Applicative
import Data.Text (Text, pack) import Data.Text (pack)
import Web.Encodings import Web.Encodings
import Yesod.Hamlet import Yesod.Hamlet
import Control.Monad (when) import Control.Monad (when)
@ -56,10 +55,6 @@ jsonToContent = hamletToContent . unJson
jsonToRepJson :: Json (Routes master) () -> GHandler sub master RepJson jsonToRepJson :: Json (Routes master) () -> GHandler sub master RepJson
jsonToRepJson = fmap RepJson . jsonToContent jsonToRepJson = fmap RepJson . jsonToContent
htmlContentToText :: HtmlContent -> Text
htmlContentToText (Encoded t) = t
htmlContentToText (Unencoded t) = encodeHtml t
-- | Outputs a single scalar. This function essentially: -- | Outputs a single scalar. This function essentially:
-- --
-- * Performs HTML entity escaping as necesary. -- * Performs HTML entity escaping as necesary.

View File

@ -72,7 +72,7 @@ type RequestBodyContents =
data Request = Request data Request = Request
{ reqGetParams :: [(ParamName, ParamValue)] { reqGetParams :: [(ParamName, ParamValue)]
, reqCookies :: [(ParamName, ParamValue)] , reqCookies :: [(ParamName, ParamValue)]
-- | Session data stored in a cookie via the clientsession package. FIXME explain how to extend. -- | Session data stored in a cookie via the clientsession package.
, reqSession :: [(ParamName, ParamValue)] , reqSession :: [(ParamName, ParamValue)]
-- | The POST parameters and submitted files. This is stored in an IO -- | The POST parameters and submitted files. This is stored in an IO
-- thunk, which essentially means it will be computed once at most, but -- thunk, which essentially means it will be computed once at most, but