mightybyte

{-# 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

mightybyte

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

mightybyte

{-# 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

mightybyte

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)

mightybyte

{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Snap.Snaplet.Auth.Backends.MongoDB
  ( initMongoAuth
  ) where

------------------------------------------------------------------------------
import           Control.Arrow

mightybyte

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"

mightybyte

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

mightybyte

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

mightybyte

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) ()

mightybyte

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