haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Everything builds

Browse Source
This commit is contained in:
Michael Snoyman 2011-12-28 10:03:14 +02:00
parent be07e4c535
commit 50ce1da37e
10 changed files with 29 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
yesod-auth/Yesod/Auth.hs
View File

@ -73,7 +73,7 @@ data Creds m = Creds
, credsExtra :: [(Text, Text)]
}
class (Yesod m, SinglePiece (AuthId m), RenderMessage m FormMessage) => YesodAuth m where
class (Yesod m, PathPiece (AuthId m), RenderMessage m FormMessage) => YesodAuth m where
type AuthId m
-- | Default destination on successful login, if no other
@ -133,7 +133,7 @@ setCreds doRedirects creds = do
Just ar -> do setMessageI Msg.InvalidLogin
redirect RedirectTemporary ar
Just aid -> do
setSession credsKey $ toSinglePiece aid
setSession credsKey $ toPathPiece aid
when doRedirects $ do
setMessageI Msg.NowLoggedIn
redirectUltDest RedirectTemporary $ loginDest y
@ -189,12 +189,12 @@ maybeAuthId = do
ms <- lookupSession credsKey
case ms of
Nothing -> return Nothing
Just s -> return $ fromSinglePiece s
Just s -> return $ fromPathPiece s
maybeAuth :: ( YesodAuth m
, b ~ YesodPersistBackend m
, Key b val ~ AuthId m
, PersistBackend b (GGHandler s m IO)
, PersistStore b (GHandler s m)
, PersistEntity val
, YesodPersist m
) => GHandler s m (Maybe (Key b val, val))
@ -209,7 +209,7 @@ requireAuthId = maybeAuthId >>= maybe redirectLogin return
requireAuth :: ( YesodAuth m
, b ~ YesodPersistBackend m
, Key b val ~ AuthId m
, PersistBackend b (GGHandler s m IO)
, PersistStore b (GHandler s m)
, PersistEntity val
, YesodPersist m
) => GHandler s m (Key b val, val)

6
yesod-auth/Yesod/Auth/Email.hs
View File

@ -60,7 +60,7 @@ data EmailCreds m = EmailCreds
, emailCredsVerkey :: Maybe VerKey
}
class (YesodAuth m, SinglePiece (AuthEmailId m)) => YesodAuthEmail m where
class (YesodAuth m, PathPiece (AuthEmailId m)) => YesodAuthEmail m where
type AuthEmailId m
addUnverified :: Email -> VerKey -> GHandler Auth m (AuthEmailId m)
@ -102,7 +102,7 @@ authEmail =
dispatch "GET" ["register"] = getRegisterR >>= sendResponse
dispatch "POST" ["register"] = postRegisterR >>= sendResponse
dispatch "GET" ["verify", eid, verkey] =
case fromSinglePiece eid of
case fromPathPiece eid of
Nothing -> notFound
Just eid' -> getVerifyR eid' verkey >>= sendResponse
dispatch "POST" ["login"] = postLoginR >>= sendResponse
@ -142,7 +142,7 @@ postRegisterR = do
return (lid, key)
render <- getUrlRender
tm <- getRouteToMaster
let verUrl = render $ tm $ verify (toSinglePiece lid) verKey
let verUrl = render $ tm $ verify (toPathPiece lid) verKey
sendVerifyEmail email verKey verUrl
defaultLayout $ do
setTitleI Msg.ConfirmationEmailSentTitle

2
yesod-auth/Yesod/Auth/Facebook.hs
View File

@ -49,7 +49,7 @@ facebookLogout = PluginR "facebook" ["logout"]
-- @Nothing@ if it's not found (probably because the user is not
-- logged in via Facebook). Note that the returned access token
-- may have expired.
getFacebookAccessToken :: MonadIO mo => GGHandler sub master mo (Maybe Facebook.AccessToken)
getFacebookAccessToken :: GHandler sub master (Maybe Facebook.AccessToken)
getFacebookAccessToken =
liftM (fmap Facebook.AccessToken) (lookupSession facebookAccessTokenKey)

16
yesod-auth/Yesod/Auth/HashDB.hs
View File

@ -137,7 +137,8 @@ setPassword pwd u = do salt <- randomSalt
-- the database values.
validateUser :: ( YesodPersist yesod
, b ~ YesodPersistBackend yesod
, PersistBackend b (GGHandler sub yesod IO)
, PersistStore b (GHandler sub yesod)
, PersistUnique b (GHandler sub yesod)
, PersistEntity user
, HashDBUser user
) =>
@ -163,7 +164,8 @@ login = PluginR "hashdb" ["login"]
postLoginR :: ( YesodAuth y, YesodPersist y
, b ~ YesodPersistBackend y
, HashDBUser user, PersistEntity user
, PersistBackend b (GGHandler Auth y IO))
, PersistStore b (GHandler Auth y)
, PersistUnique b (GHandler Auth y))
=> (Text -> Maybe (Unique user b))
-> GHandler Auth y ()
postLoginR uniq = do
@ -186,7 +188,8 @@ getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
, HashDBUser user, PersistEntity user
, Key b user ~ AuthId master
, b ~ YesodPersistBackend master
, PersistBackend b (GGHandler sub master IO))
, PersistUnique b (GHandler sub master)
, PersistStore b (GHandler sub master))
=> (AuthRoute -> Route master) -- ^ your site's Auth Route
-> (Text -> Maybe (Unique user b)) -- ^ gets user ID
-> Creds master -- ^ the creds argument
@ -213,7 +216,8 @@ authHashDB :: ( YesodAuth m, YesodPersist m
, HashDBUser user
, PersistEntity user
, b ~ YesodPersistBackend m
, PersistBackend b (GGHandler Auth m IO))
, PersistStore b (GHandler Auth m)
, PersistUnique b (GHandler Auth m))
=> (Text -> Maybe (Unique user b)) -> AuthPlugin m
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
[QQ(hamlet)|
@ -252,8 +256,8 @@ authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
----------------------------------------------------------------
-- | Generate data base instances for a valid user
share2 (mkPersist sqlSettings) (mkMigrate "migrateUsers")
[QQ(persist)|
share2 (mkPersist sqlMkSettings) (mkMigrate "migrateUsers")
[QQ(persistUpperCase)|
User
username Text Eq
password Text

2
yesod-default/Yesod/Default/Main.hs
View File

@ -7,7 +7,7 @@ module Yesod.Default.Main
, defaultDevelAppWith
) where
import Yesod.Core hiding (AppConfig (..))
import Yesod.Core
import Yesod.Default.Config
import Yesod.Logger (Logger, makeDefaultLogger, logString, flushLogger)
import Network.Wai (Application)

2
yesod-newsfeed/Yesod/AtomFeed.hs
View File

@ -34,7 +34,7 @@ newtype RepAtom = RepAtom Content
instance HasReps RepAtom where
chooseRep (RepAtom c) _ = return (typeAtom, c)
atomFeed :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepAtom
atomFeed :: Feed (Route master) -> GHandler sub master RepAtom
atomFeed = liftM RepAtom . hamletToContent . template
template :: Feed url -> HtmlUrl url

4
yesod-newsfeed/Yesod/Feed.hs
View File

@ -25,7 +25,7 @@ import Yesod.FeedTypes
import Yesod.AtomFeed
import Yesod.RssFeed
import Yesod.Content (HasReps (chooseRep), typeAtom, typeRss)
import Yesod.Handler (Route, GGHandler)
import Yesod.Handler (Route, GHandler)
data RepAtomRss = RepAtomRss RepAtom RepRss
instance HasReps RepAtomRss where
@ -33,7 +33,7 @@ instance HasReps RepAtomRss where
[ (typeAtom, a)
, (typeRss, r)
]
newsFeed :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepAtomRss
newsFeed :: Feed (Route master) -> GHandler sub master RepAtomRss
newsFeed f = do
a <- atomFeed f
r <- rssFeed f

2
yesod-newsfeed/Yesod/RssFeed.hs
View File

@ -31,7 +31,7 @@ instance HasReps RepRss where
chooseRep (RepRss c) _ = return (typeRss, c)
-- | Generate the feed
rssFeed :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepRss
rssFeed :: Feed (Route master) -> GHandler sub master RepRss
rssFeed = liftM RepRss . hamletToContent . template
template :: Feed url -> HtmlUrl url

8
yesod-static/Yesod/Static.hs
View File

@ -68,9 +68,9 @@ import qualified Data.ByteString as S
import Network.HTTP.Types (status301)
import System.PosixCompat.Files (getFileStatus, modificationTime)
import System.Posix.Types (EpochTime)
import qualified Data.Enumerator as E
import qualified Data.Enumerator.List as EL
import qualified Data.Enumerator.Binary as EB
import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Network.Wai.Application.Static
( StaticSettings (..)
@ -282,7 +282,7 @@ mkStaticFilesList fp fs routeConName makeHash = do
-- descriptors
base64md5File :: Prelude.FilePath -> IO String
base64md5File file = do
bss <- E.run_ $ EB.enumFile file E.$$ EL.consume
bss <- C.runResourceT $ CB.sourceFile file C.$$ CL.consume
return $ base64md5 $ L.fromChunks bss
-- FIXME I'd like something streaming instead
{-

1
yesod-static/yesod-static.cabal
View File

@ -40,6 +40,7 @@ library
, file-embed >= 0.0.4.1 && < 0.5
, http-types >= 0.6.5 && < 0.7
, unix-compat >= 0.2
, conduit >= 0.0
exposed-modules: Yesod.Static
ghc-options: -Wall