Fixed some various FIXMEs
This commit is contained in:
parent
fd0ce32687
commit
6db0589936
@ -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)]
|
||||||
|
|||||||
@ -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:
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user