This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
module Main where | |
import Numeric | |
import Data.Bits | |
import Data.List | |
import Text.Blaze | |
import Text.Blaze.Html5 hiding (map) | |
import qualified Text.Blaze.Html5 as H | |
import qualified Text.Blaze.Html5.Attributes as A |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
bindStrict :: Monad m => Splice m | |
bindStrict = do | |
node <- getParamNode | |
cs <- runChildren | |
maybe (return ()) (add cs) | |
(X.getAttribute bindAttr node) | |
return [] | |
where | |
add cs nm = modifyTS $ bindSplice nm $ do |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
module Snap.Snaplet.Internal.Lensed where | |
import Control.Applicative | |
import Control.Monad | |
import Control.Monad.Trans | |
import Data.Lens.Lazy | |
import Data.Functor |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
class Monad m => MonadSnapletState s m | m -> s where | |
getSnapletState :: m (Snaplet s) | |
putSnapletState :: (Snaplet s) -> m () | |
modifySnapletState :: (MonadSnapletState s m) => (Snaplet s -> Snaplet s) -> m () | |
modifySnapletState f = do | |
s <- getSnapletState | |
putSnapletState (f s) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE BangPatterns #-} | |
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE RecordWildCards #-} | |
module Snap.Snaplet.Auth.Backends.MongoDB | |
( initMongoAuth | |
) where | |
------------------------------------------------------------------------------ | |
import Control.Arrow |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
routes = [ ("login", with auth loginHandler) | |
, ("register", with auth registerHandler) | |
, ("logout", with auth logout >> redirect ".") | |
] | |
passParam paramName = maybe pass return =<< getParam paramName | |
loginHandler = do | |
username <- passParam "username" | |
password <- passParam "password" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Process: ghc [64219] | |
Path: /usr/local/Cellar/ghc/7.4.2/lib/ghc-7.4.2/ghc | |
Identifier: ghc | |
Version: ??? (???) | |
Code Type: X86-64 (Native) | |
Parent Process: bash [63980] | |
Date/Time: 2012-06-12 22:28:34.143 -0400 | |
OS Version: Mac OS X 10.6.8 (10K549) | |
Report Version: 6 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
createUser :: Text -- ^ Username | |
-> ByteString -- ^ Password | |
-> Handler b (AuthManager b) (Either String AuthUser) | |
createUser "" _ = return $ Left "Username cannot be empty" | |
createUser unm pwd = withBackend $ \r -> do | |
u <- liftIO $ buildAuthUser r unm pwd | |
return $ Right u |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
loginUser | |
:: ByteString | |
-- ^ Username field | |
-> ByteString | |
-- ^ Password field | |
-> Maybe ByteString | |
-- ^ Remember field; Nothing if you want no remember function. | |
-> (AuthFailure -> Handler b (AuthManager b) ()) | |
-- ^ Upon failure | |
-> Handler b (AuthManager b) () |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
class MonadIO m => MonadPostgres m where | |
withConn :: (P.Connection -> m a) -> m a | |
getPooler :: m ((P.Connection -> m a) -> m a) | |
withPool :: (P.Connection -> m a) -> m a | |
withPool f = do | |
pooler <- getPooler | |
pooler f |