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