Commits

Anonymous committed afed31f

Added MongoDB auth backend and allowed sub snaplets to have mongoDB snaplet as subsnaplet

  • Participants
  • Parent commits 7d8240c

Comments (0)

Files changed (2)

src/Snap/Snaplet/Auth/Backends/MongoDB.hs

   -- ^ Lens into a 'SessionManager' auth snaplet will use
   -> Snaplet MongoDBSnaplet
   -- ^ Lens into a 'MongoDBSnaplet'
+  -> Initializer b (AuthManager b) ()
+  -- ^ Custom action to run with normal snaplet init
   -> SnapletInit b (AuthManager b)
-initMongoDBAuthManager settings session_lens mongo =
+initMongoDBAuthManager settings session_lens mongo action =
   makeSnaplet "MongoDBAuthManager"
       "A snaplet providing user authentication using a MongoDB backend"
       Nothing $ do
+        action
         key  <- liftIO $ getKey (asSiteKey settings)
         return $ AuthManager {
             backend = MongoDBAuthManager mongo

src/Snap/Snaplet/MongoDB.hs

 ------------------------------------------------------------------------------
 -- |
 class HasMongoDBState s where
-    getMongoDBState :: Handler s s MongoDBSnaplet
-    setMongoDBState :: MongoDBSnaplet -> Handler s s ()
+    getMongoDBState :: Handler b s MongoDBSnaplet
+    setMongoDBState :: MongoDBSnaplet -> Handler b s ()
 
     --modifyMongoDBState :: (MongoDBSnaplet -> MongoDBSnaplet) -> s -> s
     --modifyMongoDBState s = setMongoDBState s getMongoDBState
 
 ------------------------------------------------------------------------------
 -- |
-instance HasMongoDBState s => MonadMongoDB (Handler s s) where
+instance HasMongoDBState s => MonadMongoDB (Handler b s) where
   withDB run = do
     (MongoDBSnaplet pool db) <- getMongoDBState
     epipe <- liftIO $ runErrorT $ MPool.aResource pool