{-# LANGUAGE OverloadedStrings #-} module Snap.Snaplet.CustomAuth.OAuth2.Splices (addOAuth2Splices) where import Control.Lens import Control.Monad.Trans import Control.Monad.State import Data.Map.Syntax import Data.Maybe import Data.Monoid import Heist import Heist.Compiled import Snap import Snap.Snaplet.Heist import Snap.Snaplet.Session import Snap.Snaplet.CustomAuth.AuthManager import Snap.Snaplet.CustomAuth.Util addOAuth2Splices :: Snaplet (Heist b) -> SnapletLens b (AuthManager u e b) -> Initializer b v () addOAuth2Splices :: Snaplet (Heist b) -> SnapletLens b (AuthManager u e b) -> Initializer b v () addOAuth2Splices 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) 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 cs :: Splices (Splice (Handler b b)) cs = do Text "ifHaveOAuth2Token" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b)) forall k v. k -> v -> MapSyntax k v ## Bool -> SnapletLens b (AuthManager u e b) -> Splice (Handler b b) forall b u e. Bool -> SnapletLens b (AuthManager u e b) -> SnapletCSplice b spliceOAuth2Token Bool True SnapletLens b (AuthManager u e b) auth Text "ifNoOAuth2Token" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b)) forall k v. k -> v -> MapSyntax k v ## Bool -> SnapletLens b (AuthManager u e b) -> Splice (Handler b b) forall b u e. Bool -> SnapletLens b (AuthManager u e b) -> SnapletCSplice b spliceOAuth2Token Bool False SnapletLens b (AuthManager u e b) auth spliceOAuth2Token :: Bool -> SnapletLens b (AuthManager u e b) -> SnapletCSplice b spliceOAuth2Token :: Bool -> SnapletLens b (AuthManager u e b) -> SnapletCSplice b spliceOAuth2Token Bool t SnapletLens b (AuthManager u e b) auth = do DList (Chunk (Handler b b)) cs <- SnapletCSplice b forall (n :: * -> *). Monad n => Splice n 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) 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 Text name <- Handler b b Text -> RuntimeSplice (Handler b b) Text forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b Text -> RuntimeSplice (Handler b b) Text) -> Handler b b Text -> RuntimeSplice (Handler b b) Text forall a b. (a -> b) -> a -> b $ (Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "_token") (Text -> Text) -> Handler b b Text -> Handler b b Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) Text -> Handler b b Text 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) Text forall b u e. Handler b (AuthManager u e b) Text getStateName SnapletLens (Snaplet b) SessionManager store <- Handler b b (SnapletLens (Snaplet b) SessionManager) -> RuntimeSplice (Handler b b) (SnapletLens (Snaplet b) SessionManager) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Handler b b (SnapletLens (Snaplet b) SessionManager) -> RuntimeSplice (Handler b b) (SnapletLens (Snaplet b) SessionManager)) -> Handler b b (SnapletLens (Snaplet b) SessionManager) -> RuntimeSplice (Handler b b) (SnapletLens (Snaplet b) SessionManager) forall a b. (a -> b) -> a -> b $ SnapletLens b (AuthManager u e b) -> Handler b (AuthManager u e b) (SnapletLens (Snaplet b) SessionManager) -> Handler b b (SnapletLens (Snaplet b) SessionManager) 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) (SnapletLens (Snaplet b) SessionManager) -> Handler b b (SnapletLens (Snaplet b) SessionManager)) -> Handler b (AuthManager u e b) (SnapletLens (Snaplet b) SessionManager) -> Handler b b (SnapletLens (Snaplet b) SessionManager) forall a b. (a -> b) -> a -> b $ (AuthManager u e b -> SnapletLens (Snaplet b) SessionManager) -> Handler b (AuthManager u e b) (SnapletLens (Snaplet b) SessionManager) forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets AuthManager u e b -> SnapletLens (Snaplet b) SessionManager forall u e b. AuthManager u e b -> SnapletLens (Snaplet b) SessionManager stateStore' 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 (Snaplet b) SessionManager -> Handler b SessionManager Bool -> Handler b b Bool forall (m :: * -> * -> * -> *) b v' a v. MonadSnaplet m => SnapletLens (Snaplet b) v' -> m b v' a -> m b v a withTop' SnapletLens (Snaplet b) SessionManager store (Handler b SessionManager Bool -> Handler b b Bool) -> Handler b SessionManager Bool -> Handler b b Bool forall a b. (a -> b) -> a -> b $ ((Maybe Text -> Bool) -> Handler b SessionManager (Maybe Text) -> Handler b SessionManager Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Maybe Text -> Bool forall a. Maybe a -> Bool isJust (Handler b SessionManager (Maybe Text) -> Handler b SessionManager Bool) -> Handler b SessionManager (Maybe Text) -> Handler b SessionManager Bool forall a b. (a -> b) -> a -> b $ Text -> Handler b SessionManager (Maybe Text) forall b. Text -> Handler b SessionManager (Maybe Text) getFromSession Text name) if Bool chk Bool -> Bool -> Bool forall a. Eq a => a -> a -> Bool == Bool t then DList (Chunk (Handler b b)) -> RuntimeSplice (Handler b b) Builder forall (n :: * -> *). Monad n => DList (Chunk n) -> RuntimeSplice n Builder codeGen DList (Chunk (Handler b b)) cs else RuntimeSplice (Handler b b) Builder forall a. Monoid a => a mempty