{-# LANGUAGE OverloadedStrings #-} module Snap.Snaplet.CustomAuth.Heist where import Control.Lens import Control.Monad.Trans import qualified Text.XmlHtml as X import Heist import qualified Heist.Interpreted as I import qualified Heist.Compiled as C import Snap.Snaplet import Snap.Snaplet.Heist import Snap.Snaplet.CustomAuth.Handlers import Snap.Snaplet.CustomAuth.Types import Snap.Snaplet.CustomAuth.AuthManager import Data.Map.Syntax import Snap.Snaplet.CustomAuth.User (currentUser) addAuthSplices :: UserData u => Snaplet (Heist b) -> SnapletLens b (AuthManager u e b) -> Initializer b v () addAuthSplices :: Snaplet (Heist b) -> SnapletLens b (AuthManager u e b) -> Initializer b v () addAuthSplices Snaplet (Heist b) h SnapletLens b (AuthManager u e b) auth = Snaplet (Heist b) -> SpliceConfig (Handler b b) -> Initializer b v () forall b v. Snaplet (Heist b) -> SpliceConfig (Handler b b) -> Initializer b v () addConfig Snaplet (Heist b) h SpliceConfig (Handler b b) sc where sc :: SpliceConfig (Handler b b) sc = SpliceConfig (Handler b b) forall a. Monoid a => a mempty SpliceConfig (Handler b b) -> (SpliceConfig (Handler b b) -> SpliceConfig (Handler b b)) -> SpliceConfig (Handler b b) forall a b. a -> (a -> b) -> b & (Splices (Splice (Handler b b)) -> Identity (Splices (Splice (Handler b b)))) -> SpliceConfig (Handler b b) -> Identity (SpliceConfig (Handler b b)) forall (f :: * -> *) (m :: * -> *). Functor f => (Splices (Splice m) -> f (Splices (Splice m))) -> SpliceConfig m -> f (SpliceConfig m) scInterpretedSplices ((Splices (Splice (Handler b b)) -> Identity (Splices (Splice (Handler b b)))) -> SpliceConfig (Handler b b) -> Identity (SpliceConfig (Handler b b))) -> Splices (Splice (Handler b b)) -> SpliceConfig (Handler b b) -> SpliceConfig (Handler b b) forall s t a b. ASetter s t a b -> b -> s -> t .~ Splices (Splice (Handler b b)) is SpliceConfig (Handler b b) -> (SpliceConfig (Handler b b) -> SpliceConfig (Handler b b)) -> SpliceConfig (Handler b b) forall a b. a -> (a -> b) -> b & (Splices (Splice (Handler b b)) -> Identity (Splices (Splice (Handler b b)))) -> SpliceConfig (Handler b b) -> Identity (SpliceConfig (Handler b b)) forall (f :: * -> *) (m :: * -> *). Functor f => (Splices (Splice m) -> f (Splices (Splice m))) -> SpliceConfig m -> f (SpliceConfig m) scCompiledSplices ((Splices (Splice (Handler b b)) -> Identity (Splices (Splice (Handler b b)))) -> SpliceConfig (Handler b b) -> Identity (SpliceConfig (Handler b b))) -> Splices (Splice (Handler b b)) -> SpliceConfig (Handler b b) -> SpliceConfig (Handler b b) forall s t a b. ASetter s t a b -> b -> s -> t .~ Splices (Splice (Handler b b)) cs is :: Splices (Splice (Handler b b)) is = do Text "ifLoggedIn" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b)) forall k v. k -> v -> MapSyntax k v ## SnapletLens b (AuthManager u e b) -> Splice (Handler b b) forall u b e. UserData u => SnapletLens b (AuthManager u e b) -> SnapletISplice b ifLoggedIn SnapletLens b (AuthManager u e b) auth Text "ifLoggedOut" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b)) forall k v. k -> v -> MapSyntax k v ## SnapletLens b (AuthManager u e b) -> Splice (Handler b b) forall u b e. UserData u => SnapletLens b (AuthManager u e b) -> SnapletISplice b ifLoggedOut SnapletLens b (AuthManager u e b) auth Text "loggedInUser" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b)) forall k v. k -> v -> MapSyntax k v ## SnapletLens b (AuthManager u e b) -> Splice (Handler b b) forall u b e. UserData u => SnapletLens b (AuthManager u e b) -> SnapletISplice b loggedInUser SnapletLens b (AuthManager u e b) auth cs :: Splices (Splice (Handler b b)) cs = SnapletLens b (AuthManager u e b) -> Splices (Splice (Handler b b)) forall u b e. UserData u => SnapletLens b (AuthManager u e b) -> Splices (SnapletCSplice b) compiledAuthSplices SnapletLens b (AuthManager u e b) auth compiledAuthSplices :: UserData u => SnapletLens b (AuthManager u e b) -> Splices (SnapletCSplice b) compiledAuthSplices :: SnapletLens b (AuthManager u e b) -> Splices (SnapletCSplice b) compiledAuthSplices SnapletLens b (AuthManager u e b) auth = do Text "ifLoggedIn" Text -> SnapletCSplice b -> Splices (SnapletCSplice b) forall k v. k -> v -> MapSyntax k v ## SnapletLens b (AuthManager u e b) -> SnapletCSplice b forall u b e. UserData u => SnapletLens b (AuthManager u e b) -> SnapletCSplice b cIfLoggedIn SnapletLens b (AuthManager u e b) auth Text "ifLoggedOut" Text -> SnapletCSplice b -> Splices (SnapletCSplice b) forall k v. k -> v -> MapSyntax k v ## SnapletLens b (AuthManager u e b) -> SnapletCSplice b forall u b e. UserData u => SnapletLens b (AuthManager u e b) -> SnapletCSplice b cIfLoggedOut SnapletLens b (AuthManager u e b) auth Text "loggedInUser" Text -> SnapletCSplice b -> Splices (SnapletCSplice b) forall k v. k -> v -> MapSyntax k v ## SnapletLens b (AuthManager u e b) -> SnapletCSplice b forall u b e. UserData u => SnapletLens b (AuthManager u e b) -> SnapletCSplice b cLoggedInUser SnapletLens b (AuthManager u e b) auth ifLoggedIn :: UserData u => SnapletLens b (AuthManager u e b) -> SnapletISplice b ifLoggedIn :: SnapletLens b (AuthManager u e b) -> SnapletISplice b ifLoggedIn SnapletLens b (AuthManager u e b) auth = do Bool chk <- Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool) -> Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool forall a b. (a -> b) -> a -> b $ SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) Bool -> Handler b b Bool forall (m :: * -> * -> * -> *) b v' a v. MonadSnaplet m => SnapletLens b v' -> m b v' a -> m b v a withTop SnapletLens b (AuthManager u e b) auth Handler b (AuthManager u e b) Bool forall u b e. UserData u => Handler b (AuthManager u e b) Bool isLoggedIn case Bool chk of Bool True -> HeistT (Handler b b) (Handler b b) Node forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node getParamNode HeistT (Handler b b) (Handler b b) Node -> (Node -> SnapletISplice b) -> SnapletISplice b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= [Node] -> SnapletISplice b forall (m :: * -> *) a. Monad m => a -> m a return ([Node] -> SnapletISplice b) -> (Node -> [Node]) -> Node -> SnapletISplice b forall b c a. (b -> c) -> (a -> b) -> a -> c . Node -> [Node] X.childNodes Bool False -> [Node] -> SnapletISplice b forall (m :: * -> *) a. Monad m => a -> m a return [] cIfLoggedIn :: UserData u => SnapletLens b (AuthManager u e b) -> SnapletCSplice b cIfLoggedIn :: SnapletLens b (AuthManager u e b) -> SnapletCSplice b cIfLoggedIn SnapletLens b (AuthManager u e b) auth = do DList (Chunk (Handler b b)) cs <- SnapletCSplice b forall (n :: * -> *). Monad n => Splice n C.runChildren DList (Chunk (Handler b b)) -> SnapletCSplice b forall (m :: * -> *) a. Monad m => a -> m a return (DList (Chunk (Handler b b)) -> SnapletCSplice b) -> DList (Chunk (Handler b b)) -> SnapletCSplice b forall a b. (a -> b) -> a -> b $ RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b)) forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n) C.yieldRuntime (RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b))) -> RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b)) forall a b. (a -> b) -> a -> b $ do Bool chk <- Handler b b Bool -> RuntimeSplice (Handler b b) Bool forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b Bool -> RuntimeSplice (Handler b b) Bool) -> Handler b b Bool -> RuntimeSplice (Handler b b) Bool forall a b. (a -> b) -> a -> b $ SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) Bool -> Handler b b Bool forall (m :: * -> * -> * -> *) b v' a v. MonadSnaplet m => SnapletLens b v' -> m b v' a -> m b v a withTop SnapletLens b (AuthManager u e b) auth Handler b (AuthManager u e b) Bool forall u b e. UserData u => Handler b (AuthManager u e b) Bool isLoggedIn case Bool chk of Bool True -> DList (Chunk (Handler b b)) -> RuntimeSplice (Handler b b) Builder forall (n :: * -> *). Monad n => DList (Chunk n) -> RuntimeSplice n Builder C.codeGen DList (Chunk (Handler b b)) cs Bool False -> RuntimeSplice (Handler b b) Builder forall a. Monoid a => a mempty ifLoggedOut :: UserData u => SnapletLens b (AuthManager u e b) -> SnapletISplice b ifLoggedOut :: SnapletLens b (AuthManager u e b) -> SnapletISplice b ifLoggedOut SnapletLens b (AuthManager u e b) auth = do Bool chk <- Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool) -> Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool forall a b. (a -> b) -> a -> b $ SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) Bool -> Handler b b Bool forall (m :: * -> * -> * -> *) b v' a v. MonadSnaplet m => SnapletLens b v' -> m b v' a -> m b v a withTop SnapletLens b (AuthManager u e b) auth Handler b (AuthManager u e b) Bool forall u b e. UserData u => Handler b (AuthManager u e b) Bool isLoggedIn case Bool chk of Bool False -> HeistT (Handler b b) (Handler b b) Node forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node getParamNode HeistT (Handler b b) (Handler b b) Node -> (Node -> SnapletISplice b) -> SnapletISplice b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= [Node] -> SnapletISplice b forall (m :: * -> *) a. Monad m => a -> m a return ([Node] -> SnapletISplice b) -> (Node -> [Node]) -> Node -> SnapletISplice b forall b c a. (b -> c) -> (a -> b) -> a -> c . Node -> [Node] X.childNodes Bool True -> [Node] -> SnapletISplice b forall (m :: * -> *) a. Monad m => a -> m a return [] cIfLoggedOut :: UserData u => SnapletLens b (AuthManager u e b) -> SnapletCSplice b cIfLoggedOut :: SnapletLens b (AuthManager u e b) -> SnapletCSplice b cIfLoggedOut SnapletLens b (AuthManager u e b) auth = do DList (Chunk (Handler b b)) cs <- SnapletCSplice b forall (n :: * -> *). Monad n => Splice n C.runChildren DList (Chunk (Handler b b)) -> SnapletCSplice b forall (m :: * -> *) a. Monad m => a -> m a return (DList (Chunk (Handler b b)) -> SnapletCSplice b) -> DList (Chunk (Handler b b)) -> SnapletCSplice b forall a b. (a -> b) -> a -> b $ RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b)) forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n) C.yieldRuntime (RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b))) -> RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b)) forall a b. (a -> b) -> a -> b $ do Bool chk <- Handler b b Bool -> RuntimeSplice (Handler b b) Bool forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b Bool -> RuntimeSplice (Handler b b) Bool) -> Handler b b Bool -> RuntimeSplice (Handler b b) Bool forall a b. (a -> b) -> a -> b $ SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) Bool -> Handler b b Bool forall (m :: * -> * -> * -> *) b v' a v. MonadSnaplet m => SnapletLens b v' -> m b v' a -> m b v a withTop SnapletLens b (AuthManager u e b) auth Handler b (AuthManager u e b) Bool forall u b e. UserData u => Handler b (AuthManager u e b) Bool isLoggedIn case Bool chk of Bool False -> DList (Chunk (Handler b b)) -> RuntimeSplice (Handler b b) Builder forall (n :: * -> *). Monad n => DList (Chunk n) -> RuntimeSplice n Builder C.codeGen DList (Chunk (Handler b b)) cs Bool True -> RuntimeSplice (Handler b b) Builder forall a. Monoid a => a mempty loggedInUser :: UserData u => SnapletLens b (AuthManager u e b) -> SnapletISplice b loggedInUser :: SnapletLens b (AuthManager u e b) -> SnapletISplice b loggedInUser SnapletLens b (AuthManager u e b) auth = do Maybe u u <- Handler b b (Maybe u) -> HeistT (Handler b b) (Handler b b) (Maybe u) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b (Maybe u) -> HeistT (Handler b b) (Handler b b) (Maybe u)) -> Handler b b (Maybe u) -> HeistT (Handler b b) (Handler b b) (Maybe u) forall a b. (a -> b) -> a -> b $ SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) (Maybe u) -> Handler b b (Maybe u) forall (m :: * -> * -> * -> *) b v' a v. MonadSnaplet m => SnapletLens b v' -> m b v' a -> m b v a withTop SnapletLens b (AuthManager u e b) auth Handler b (AuthManager u e b) (Maybe u) forall u b e. UserData u => Handler b (AuthManager u e b) (Maybe u) currentUser SnapletISplice b -> (u -> SnapletISplice b) -> Maybe u -> SnapletISplice b forall b a. b -> (a -> b) -> Maybe a -> b maybe ([Node] -> SnapletISplice b forall (m :: * -> *) a. Monad m => a -> m a return []) (Text -> SnapletISplice b forall (m :: * -> *) (n :: * -> *). Monad m => Text -> HeistT n m [Node] I.textSplice (Text -> SnapletISplice b) -> (u -> Text) -> u -> SnapletISplice b forall b c a. (b -> c) -> (a -> b) -> a -> c . AuthUser -> Text name (AuthUser -> Text) -> (u -> AuthUser) -> u -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . u -> AuthUser forall a. UserData a => a -> AuthUser extractUser) (Maybe u -> SnapletISplice b) -> Maybe u -> SnapletISplice b forall a b. (a -> b) -> a -> b $ Maybe u u cLoggedInUser :: UserData u => SnapletLens b (AuthManager u e b) -> SnapletCSplice b cLoggedInUser :: SnapletLens b (AuthManager u e b) -> SnapletCSplice b cLoggedInUser SnapletLens b (AuthManager u e b) auth = DList (Chunk (Handler b b)) -> SnapletCSplice b forall (m :: * -> *) a. Monad m => a -> m a return (DList (Chunk (Handler b b)) -> SnapletCSplice b) -> DList (Chunk (Handler b b)) -> SnapletCSplice b forall a b. (a -> b) -> a -> b $ RuntimeSplice (Handler b b) Text -> DList (Chunk (Handler b b)) forall (n :: * -> *). Monad n => RuntimeSplice n Text -> DList (Chunk n) C.yieldRuntimeText (RuntimeSplice (Handler b b) Text -> DList (Chunk (Handler b b))) -> RuntimeSplice (Handler b b) Text -> DList (Chunk (Handler b b)) forall a b. (a -> b) -> a -> b $ do Maybe u u <- Handler b b (Maybe u) -> RuntimeSplice (Handler b b) (Maybe u) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b (Maybe u) -> RuntimeSplice (Handler b b) (Maybe u)) -> Handler b b (Maybe u) -> RuntimeSplice (Handler b b) (Maybe u) forall a b. (a -> b) -> a -> b $ SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) (Maybe u) -> Handler b b (Maybe u) forall (m :: * -> * -> * -> *) b v' a v. MonadSnaplet m => SnapletLens b v' -> m b v' a -> m b v a withTop SnapletLens b (AuthManager u e b) auth Handler b (AuthManager u e b) (Maybe u) forall u b e. UserData u => Handler b (AuthManager u e b) (Maybe u) currentUser Text -> RuntimeSplice (Handler b b) Text forall (m :: * -> *) a. Monad m => a -> m a return (Text -> RuntimeSplice (Handler b b) Text) -> Text -> RuntimeSplice (Handler b b) Text forall a b. (a -> b) -> a -> b $ Text -> (u -> Text) -> Maybe u -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" (AuthUser -> Text name (AuthUser -> Text) -> (u -> AuthUser) -> u -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . u -> AuthUser forall a. UserData a => a -> AuthUser extractUser) Maybe u u