Fixed some various FIXMEs
This commit is contained in:
parent
fd0ce32687
commit
6db0589936
@ -109,7 +109,7 @@ toWaiApp a = do
|
||||
$ jsonp
|
||||
$ methodOverride
|
||||
$ cleanPath
|
||||
$ \thePath -> clientsession [sessionName] key' mins
|
||||
$ \thePath -> clientsession [sessionName] key' mins -- FIXME middleware is not helping us here, drop it
|
||||
$ toWaiApp' a thePath
|
||||
|
||||
parseSession :: B.ByteString -> [(String, String)]
|
||||
|
||||
@ -9,6 +9,7 @@ module Yesod.Hamlet
|
||||
Hamlet
|
||||
, hamlet
|
||||
, HtmlContent (..)
|
||||
, htmlContentToText
|
||||
-- * Convert to something displayable
|
||||
, hamletToContent
|
||||
, hamletToRepHtml
|
||||
@ -27,6 +28,12 @@ import Data.Convertible.Text
|
||||
import Data.Object -- FIXME should we kill this?
|
||||
import Control.Arrow ((***))
|
||||
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
|
||||
-- generic site templates, which would have the type signature:
|
||||
|
||||
@ -46,7 +46,6 @@ import Data.Typeable (Typeable)
|
||||
import Control.Exception (Exception)
|
||||
|
||||
-- FIXME check referer header to determine destination
|
||||
-- FIXME switch to session
|
||||
|
||||
getAuth :: a -> Auth
|
||||
getAuth = const Auth
|
||||
@ -131,7 +130,7 @@ getOpenIdComplete = do
|
||||
let onFailure err = redirectString RedirectTemporary $ errurl err
|
||||
let onSuccess (OpenId.Identifier ident) = do
|
||||
y <- getYesodMaster
|
||||
header authCookieName ident
|
||||
setSession identKey ident
|
||||
redirectToDest RedirectTemporary $ renderm $ defaultDest y
|
||||
attempt onFailure onSuccess res
|
||||
|
||||
@ -156,8 +155,8 @@ handleRpxnowR = do
|
||||
(d:_) -> d
|
||||
ident <- liftIO $ Rpxnow.authenticate apiKey token
|
||||
onRpxnowLogin ident
|
||||
header authCookieName $ Rpxnow.identifier ident
|
||||
header authDisplayName $ getDisplayName ident
|
||||
setSession identKey $ Rpxnow.identifier ident
|
||||
setSession displayNameKey $ getDisplayName ident
|
||||
redirectToDest RedirectTemporary dest
|
||||
|
||||
data MissingToken = MissingToken
|
||||
@ -194,7 +193,7 @@ getCheck = do
|
||||
getLogout :: YesodAuth master => GHandler Auth master ()
|
||||
getLogout = do
|
||||
y <- getYesodMaster
|
||||
deleteCookie authCookieName
|
||||
clearSession identKey
|
||||
render <- getUrlRenderMaster
|
||||
redirectToDest RedirectTemporary $ render $ defaultDest y
|
||||
|
||||
@ -202,13 +201,13 @@ getLogout = do
|
||||
maybeIdentifier :: RequestReader m => m (Maybe String)
|
||||
maybeIdentifier = do
|
||||
s <- session
|
||||
return $ listToMaybe $ s authCookieName
|
||||
return $ listToMaybe $ s identKey
|
||||
|
||||
-- | Gets the display name for a user if available.
|
||||
displayName :: RequestReader m => m (Maybe String)
|
||||
displayName = do
|
||||
s <- session
|
||||
return $ listToMaybe $ s authDisplayName
|
||||
return $ listToMaybe $ s displayNameKey
|
||||
|
||||
-- | Gets the identifier for a user. If user is not logged in, redirects them
|
||||
-- to the login page.
|
||||
@ -251,12 +250,13 @@ redirectToDest rt def = do
|
||||
return x
|
||||
redirectString rt dest
|
||||
|
||||
authCookieName :: String -- FIXME don't use cookies!!!
|
||||
authCookieName = "IDENTIFIER"
|
||||
identKey :: String
|
||||
identKey = "IDENTIFIER"
|
||||
|
||||
authDisplayName :: String
|
||||
authDisplayName = "DISPLAY_NAME"
|
||||
displayNameKey :: String
|
||||
displayNameKey = "DISPLAY_NAME"
|
||||
|
||||
-- FIXME export DEST stuff as its own module
|
||||
destCookieTimeout :: Int
|
||||
destCookieTimeout = 120
|
||||
|
||||
|
||||
@ -6,7 +6,6 @@ module Yesod.Json
|
||||
Json
|
||||
, jsonToContent
|
||||
, jsonToRepJson
|
||||
, htmlContentToText -- FIXME put elsewhere?
|
||||
-- * Generate Json output
|
||||
, jsonScalar
|
||||
, jsonList
|
||||
@ -21,7 +20,7 @@ module Yesod.Json
|
||||
|
||||
import Text.Hamlet.Monad
|
||||
import Control.Applicative
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text (pack)
|
||||
import Web.Encodings
|
||||
import Yesod.Hamlet
|
||||
import Control.Monad (when)
|
||||
@ -56,10 +55,6 @@ jsonToContent = hamletToContent . unJson
|
||||
jsonToRepJson :: Json (Routes master) () -> GHandler sub master RepJson
|
||||
jsonToRepJson = fmap RepJson . jsonToContent
|
||||
|
||||
htmlContentToText :: HtmlContent -> Text
|
||||
htmlContentToText (Encoded t) = t
|
||||
htmlContentToText (Unencoded t) = encodeHtml t
|
||||
|
||||
-- | Outputs a single scalar. This function essentially:
|
||||
--
|
||||
-- * Performs HTML entity escaping as necesary.
|
||||
|
||||
@ -72,7 +72,7 @@ type RequestBodyContents =
|
||||
data Request = Request
|
||||
{ reqGetParams :: [(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)]
|
||||
-- | The POST parameters and submitted files. This is stored in an IO
|
||||
-- thunk, which essentially means it will be computed once at most, but
|
||||
|
||||
Loading…
Reference in New Issue
Block a user