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