Everything building with Hamlet 0.10, scaffolding not fixed yet
This commit is contained in:
Michael Snoyman
parent
70a7f52055
commit
f6ab5c05dc
@ -178,11 +178,12 @@ maybeAuthId = do
|
||||
Just s -> return $ fromSinglePiece s
|
||||
|
||||
maybeAuth :: ( YesodAuth m
|
||||
, Key val ~ AuthId m
|
||||
, PersistBackend (YesodDB m (GGHandler s m IO))
|
||||
, b ~ YesodPersistBackend m
|
||||
, Key b val ~ AuthId m
|
||||
, PersistBackend b (GGHandler s m IO)
|
||||
, PersistEntity val
|
||||
, YesodPersist m
|
||||
) => GHandler s m (Maybe (Key val, val))
|
||||
) => GHandler s m (Maybe (Key b val, val))
|
||||
maybeAuth = runMaybeT $ do
|
||||
aid <- MaybeT $ maybeAuthId
|
||||
a <- MaybeT $ runDB $ get aid
|
||||
@ -192,11 +193,12 @@ requireAuthId :: YesodAuth m => GHandler s m (AuthId m)
|
||||
requireAuthId = maybeAuthId >>= maybe redirectLogin return
|
||||
|
||||
requireAuth :: ( YesodAuth m
|
||||
, Key val ~ AuthId m
|
||||
, PersistBackend (YesodDB m (GGHandler s m IO))
|
||||
, b ~ YesodPersistBackend m
|
||||
, Key b val ~ AuthId m
|
||||
, PersistBackend b (GGHandler s m IO)
|
||||
, PersistEntity val
|
||||
, YesodPersist m
|
||||
) => GHandler s m (Key val, val)
|
||||
) => GHandler s m (Key b val, val)
|
||||
requireAuth = maybeAuth >>= maybe redirectLogin return
|
||||
|
||||
redirectLogin :: Yesod m => GHandler s m a
|
||||
|
||||
@ -65,7 +65,8 @@ module Yesod.Auth.HashDB
|
||||
, authHashDB
|
||||
, getAuthIdHashDB
|
||||
-- * Predefined data type
|
||||
, User(..)
|
||||
, User
|
||||
, UserG (..)
|
||||
, UserId
|
||||
, migrateUsers
|
||||
) where
|
||||
@ -127,11 +128,12 @@ setPassword pwd u = do salt <- randomSalt
|
||||
-- | Given a user ID and password in plaintext, validate them against
|
||||
-- the database values.
|
||||
validateUser :: ( YesodPersist yesod
|
||||
, PersistBackend (YesodDB yesod (GGHandler sub yesod IO))
|
||||
, b ~ YesodPersistBackend yesod
|
||||
, PersistBackend b (GGHandler sub yesod IO)
|
||||
, PersistEntity user
|
||||
, HashDBUser user
|
||||
) =>
|
||||
Unique user -- ^ User unique identifier
|
||||
Unique user b -- ^ User unique identifier
|
||||
-> Text -- ^ Password in plaint-text
|
||||
-> GHandler sub yesod Bool
|
||||
validateUser userID passwd = do
|
||||
@ -151,9 +153,10 @@ login = PluginR "hashdb" ["login"]
|
||||
-- | Handle the login form. First parameter is function which maps
|
||||
-- username (whatever it might be) to unique user ID.
|
||||
postLoginR :: ( YesodAuth y, YesodPersist y
|
||||
, b ~ YesodPersistBackend y
|
||||
, HashDBUser user, PersistEntity user
|
||||
, PersistBackend (YesodDB y (GGHandler Auth y IO)))
|
||||
=> (Text -> Maybe (Unique user))
|
||||
, PersistBackend b (GGHandler Auth y IO))
|
||||
=> (Text -> Maybe (Unique user b))
|
||||
-> GHandler Auth y ()
|
||||
postLoginR uniq = do
|
||||
(mu,mp) <- runInputPost $ (,)
|
||||
@ -173,10 +176,11 @@ postLoginR uniq = do
|
||||
-- can be used if authHashDB is the only plugin in use.
|
||||
getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
|
||||
, HashDBUser user, PersistEntity user
|
||||
, Key user ~ AuthId master
|
||||
, PersistBackend (YesodDB master (GGHandler sub master IO)))
|
||||
, Key b user ~ AuthId master
|
||||
, b ~ YesodPersistBackend master
|
||||
, PersistBackend b (GGHandler sub master IO))
|
||||
=> (AuthRoute -> Route master) -- ^ your site's Auth Route
|
||||
-> (Text -> Maybe (Unique user)) -- ^ gets user ID
|
||||
-> (Text -> Maybe (Unique user b)) -- ^ gets user ID
|
||||
-> Creds master -- ^ the creds argument
|
||||
-> GHandler sub master (Maybe (AuthId master))
|
||||
getAuthIdHashDB authR uniq creds = do
|
||||
@ -200,8 +204,9 @@ getAuthIdHashDB authR uniq creds = do
|
||||
authHashDB :: ( YesodAuth m, YesodPersist m
|
||||
, HashDBUser user
|
||||
, PersistEntity user
|
||||
, PersistBackend (YesodDB m (GGHandler Auth m IO)))
|
||||
=> (Text -> Maybe (Unique user)) -> AuthPlugin m
|
||||
, b ~ YesodPersistBackend m
|
||||
, PersistBackend b (GGHandler Auth m IO))
|
||||
=> (Text -> Maybe (Unique user b)) -> AuthPlugin m
|
||||
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
|
||||
[QQ(hamlet)|
|
||||
<div id="header">
|
||||
@ -239,7 +244,7 @@ authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Generate data base instances for a valid user
|
||||
share2 mkPersist (mkMigrate "migrateUsers")
|
||||
share2 (mkPersist sqlSettings) (mkMigrate "migrateUsers")
|
||||
[QQ(persist)|
|
||||
User
|
||||
username Text Eq
|
||||
@ -248,7 +253,7 @@ User
|
||||
UniqueUser username
|
||||
|]
|
||||
|
||||
instance HashDBUser User where
|
||||
instance HashDBUser (UserG backend) where
|
||||
userPasswordHash = Just . userPassword
|
||||
userPasswordSalt = Just . userSalt
|
||||
setUserHashAndSalt s h u = u { userSalt = s
|
||||
|
||||
@ -32,7 +32,8 @@ library
|
||||
, mime-mail >= 0.3 && < 0.4
|
||||
, blaze-html >= 0.4 && < 0.5
|
||||
, yesod-persistent >= 0.2 && < 0.3
|
||||
, hamlet >= 0.9 && < 0.10
|
||||
, hamlet >= 0.10 && < 0.11
|
||||
, shakespeare-css >= 0.10 && < 0.11
|
||||
, yesod-json >= 0.2 && < 0.3
|
||||
, containers >= 0.2 && < 0.5
|
||||
, yesod-form >= 0.3 && < 0.4
|
||||
|
||||
@ -17,7 +17,7 @@ import qualified Data.ByteString as S
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
import Data.Char (isSpace, toLower, toUpper)
|
||||
import Data.Ord (comparing)
|
||||
import Text.Shakespeare (Deref (..), Ident (..), parseHash, derefToExp)
|
||||
import Text.Shakespeare.Base (Deref (..), Ident (..), parseHash, derefToExp)
|
||||
import Text.ParserCombinators.Parsec (parse, many, eof, many1, noneOf, (<|>))
|
||||
import Control.Arrow ((***))
|
||||
import Data.Monoid (mempty, mappend)
|
||||
|
||||
@ -29,12 +29,15 @@ library
|
||||
build-depends: base >= 4 && < 4.3
|
||||
build-depends: time >= 1.1.4 && < 1.3
|
||||
, wai >= 0.4 && < 0.5
|
||||
, wai-extra >= 0.4 && < 0.5
|
||||
, wai-extra >= 0.4.1 && < 0.5
|
||||
, bytestring >= 0.9.1.4 && < 0.10
|
||||
, text >= 0.5 && < 0.12
|
||||
, template-haskell
|
||||
, path-pieces >= 0.0 && < 0.1
|
||||
, hamlet >= 0.9 && < 0.10
|
||||
, hamlet >= 0.10 && < 0.11
|
||||
, shakespeare >= 0.10 && < 0.11
|
||||
, shakespeare-js >= 0.10 && < 0.11
|
||||
, shakespeare-css >= 0.10 && < 0.11
|
||||
, blaze-builder >= 0.2.1 && < 0.4
|
||||
, transformers >= 0.2 && < 0.3
|
||||
, clientsession >= 0.6 && < 0.7
|
||||
|
||||
@ -15,7 +15,9 @@ library
|
||||
build-depends: base >= 4 && < 5
|
||||
, yesod-core >= 0.9 && < 0.10
|
||||
, time >= 1.1.4 && < 1.3
|
||||
, hamlet >= 0.9 && < 0.10
|
||||
, hamlet >= 0.10 && < 0.11
|
||||
, shakespeare-css >= 0.10 && < 0.11
|
||||
, shakespeare-js >= 0.10 && < 0.11
|
||||
, persistent >= 0.6 && < 0.7
|
||||
, yesod-persistent >= 0.2 && < 0.3
|
||||
, template-haskell
|
||||
|
||||
@ -16,7 +16,7 @@ library
|
||||
, yesod-core >= 0.9 && < 0.10
|
||||
, aeson >= 0.3.1.1 && < 0.3.2.10
|
||||
, text >= 0.8 && < 0.12
|
||||
, hamlet >= 0.9 && < 0.10
|
||||
, shakespeare-js >= 0.10 && < 0.11
|
||||
, vector
|
||||
, containers
|
||||
, blaze-textual >= 0.1 && < 0.2
|
||||
|
||||
@ -15,7 +15,7 @@ library
|
||||
build-depends: base >= 4 && < 5
|
||||
, yesod-core >= 0.9 && < 0.10
|
||||
, time >= 1.1.4 && < 1.3
|
||||
, hamlet >= 0.9 && < 0.10
|
||||
, hamlet >= 0.10 && < 0.11
|
||||
, bytestring >= 0.9 && < 0.10
|
||||
, text >= 0.9 && < 1.0
|
||||
exposed-modules: Yesod.AtomFeed
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
module Yesod.Persist
|
||||
( YesodPersist (..)
|
||||
, YesodDB
|
||||
, get404
|
||||
, getBy404
|
||||
, module Database.Persist
|
||||
@ -11,13 +12,16 @@ module Yesod.Persist
|
||||
import Database.Persist
|
||||
import Database.Persist.TH
|
||||
import Control.Monad.Trans.Class (MonadTrans (..))
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Failure (Failure)
|
||||
|
||||
import Yesod.Handler
|
||||
|
||||
class YesodPersist y where
|
||||
type YesodDB y :: (* -> *) -> * -> *
|
||||
runDB :: YesodDB y (GGHandler sub y IO) a -> GHandler sub y a
|
||||
type YesodDB sub master = YesodPersistBackend master (GGHandler sub master IO)
|
||||
|
||||
class YesodPersist master where
|
||||
type YesodPersistBackend master :: (* -> *) -> * -> *
|
||||
runDB :: MonadIO monad => YesodDB sub master a -> GGHandler sub master monad a
|
||||
|
||||
-- | Get the given entity by ID, or return a 404 not found if it doesn't exist.
|
||||
get404 :: (PersistBackend t m, PersistEntity val, Monad (t m),
|
||||
|
||||
@ -15,7 +15,7 @@ library
|
||||
build-depends: base >= 4 && < 5
|
||||
, yesod-core >= 0.9 && < 0.10
|
||||
, time >= 1.1.4 && < 1.3
|
||||
, hamlet >= 0.9 && < 0.10
|
||||
, hamlet >= 0.10 && < 0.11
|
||||
exposed-modules: Yesod.Sitemap
|
||||
ghc-options: -Wall
|
||||
|
||||
|
||||
@ -72,7 +72,9 @@ library
|
||||
, transformers >= 0.2 && < 0.3
|
||||
, wai >= 0.4 && < 0.5
|
||||
, wai-extra >= 0.4.1 && < 0.5
|
||||
, hamlet >= 0.9 && < 0.10
|
||||
, hamlet >= 0.10 && < 0.11
|
||||
, shakespeare-js >= 0.10 && < 0.11
|
||||
, shakespeare-css >= 0.10 && < 0.11
|
||||
, warp >= 0.4 && < 0.5
|
||||
, mime-mail >= 0.3 && < 0.4
|
||||
, hjsmin >= 0.0.13 && < 0.1
|
||||
|
||||
Loading…
Reference in New Issue
Block a user