{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}

{-|

  Some pre-packaged splices that add convenience to a Heist-enabled
  application.

-}

module Snap.Snaplet.Auth.SpliceHelpers
  ( addAuthSplices
  , compiledAuthSplices
  , userCSplices
  , userISplices
  , ifLoggedIn
  , ifLoggedOut
  , loggedInUser
  , cIfLoggedIn
  , cIfLoggedOut
  , cLoggedInUser
  ) where

------------------------------------------------------------------------------
import           Control.Lens
import           Control.Monad.Trans
import           Data.Map.Syntax ((##), mapV)
import           Data.Maybe
import qualified Data.Text as T
import           Data.Text.Encoding
import qualified Text.XmlHtml as X
import           Heist
import qualified Heist.Interpreted as I
import qualified Heist.Compiled as C
import           Heist.Splices
import           Snap.Snaplet
import           Snap.Snaplet.Auth.AuthManager
import           Snap.Snaplet.Auth.Handlers
import           Snap.Snaplet.Auth.Types
import           Snap.Snaplet.Heist

#if !MIN_VERSION_base(4,8,0)
import           Data.Monoid
#endif

------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | Add all standard auth splices to a Heist-enabled application.
--
-- This adds the following splices:
-- \<ifLoggedIn\>
-- \<ifLoggedOut\>
-- \<loggedInUser\>
addAuthSplices
  :: HasHeist b
  => Snaplet (Heist b)
  -> SnapletLens b (AuthManager b)
      -- ^ A lens reference to 'AuthManager'
  -> Initializer b v ()
addAuthSplices :: Snaplet (Heist b)
-> SnapletLens b (AuthManager b) -> Initializer b v ()
addAuthSplices h :: Snaplet (Heist b)
h auth :: SnapletLens b (AuthManager 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
        "ifLoggedIn"   Text -> Splice (Handler b b) -> Splices (Splice (Handler b b))
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager b) -> Splice (Handler b b)
forall b. SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedIn SnapletLens b (AuthManager b)
auth
        "ifLoggedOut"  Text -> Splice (Handler b b) -> Splices (Splice (Handler b b))
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager b) -> Splice (Handler b b)
forall b. SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedOut SnapletLens b (AuthManager b)
auth
        "loggedInUser" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b))
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager b) -> Splice (Handler b b)
forall b. SnapletLens b (AuthManager b) -> SnapletISplice b
loggedInUser SnapletLens b (AuthManager b)
auth
    cs :: Splices (Splice (Handler b b))
cs = SnapletLens b (AuthManager b) -> Splices (Splice (Handler b b))
forall b.
SnapletLens b (AuthManager b) -> Splices (SnapletCSplice b)
compiledAuthSplices SnapletLens b (AuthManager b)
auth



------------------------------------------------------------------------------
-- | List containing compiled splices for ifLoggedIn, ifLoggedOut, and
-- loggedInUser.
compiledAuthSplices :: SnapletLens b (AuthManager b)
                    -> Splices (SnapletCSplice b)
compiledAuthSplices :: SnapletLens b (AuthManager b) -> Splices (SnapletCSplice b)
compiledAuthSplices auth :: SnapletLens b (AuthManager b)
auth = do
    "ifLoggedIn"   Text -> SnapletCSplice b -> Splices (SnapletCSplice b)
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager b) -> SnapletCSplice b
forall b. SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedIn SnapletLens b (AuthManager b)
auth
    "ifLoggedOut"  Text -> SnapletCSplice b -> Splices (SnapletCSplice b)
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager b) -> SnapletCSplice b
forall b. SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedOut SnapletLens b (AuthManager b)
auth
    "loggedInUser" Text -> SnapletCSplice b -> Splices (SnapletCSplice b)
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager b) -> SnapletCSplice b
forall b. SnapletLens b (AuthManager b) -> SnapletCSplice b
cLoggedInUser SnapletLens b (AuthManager b)
auth


------------------------------------------------------------------------------
-- | Function to generate interpreted splices from an AuthUser.
userISplices :: Monad m => AuthUser -> Splices (I.Splice m)
userISplices :: AuthUser -> Splices (Splice m)
userISplices AuthUser{..} = do
    "userId"          Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Text -> (UserId -> Text) -> Maybe UserId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" UserId -> Text
unUid Maybe UserId
userId
    "userLogin"       Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice Text
userLogin
    "userEmail"       Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "-" Maybe Text
userEmail
    "userActive"      Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UTCTime
userSuspendedAt
    "userLoginCount"  Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
userLoginCount
    "userFailedCount" Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
userFailedLoginCount
    "userLoginAt"     Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" (String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) Maybe UTCTime
userCurrentLoginAt
    "userLastLoginAt" Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" (String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) Maybe UTCTime
userLastLoginAt
    "userSuspendedAt" Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" (String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) Maybe UTCTime
userSuspendedAt
    "userLoginIP"     Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" ByteString -> Text
decodeUtf8 Maybe ByteString
userCurrentLoginIp
    "userLastLoginIP" Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" ByteString -> Text
decodeUtf8 Maybe ByteString
userLastLoginIp
    "userIfActive"    Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Bool -> Splice m
forall (m :: * -> *). Monad m => Bool -> Splice m
ifISplice (Bool -> Splice m) -> Bool -> Splice m
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UTCTime
userSuspendedAt
    "userIfSuspended" Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
## Bool -> Splice m
forall (m :: * -> *). Monad m => Bool -> Splice m
ifISplice (Bool -> Splice m) -> Bool -> Splice m
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isJust Maybe UTCTime
userSuspendedAt


------------------------------------------------------------------------------
-- | Compiled splices for AuthUser.
userCSplices :: Monad m => Splices (RuntimeSplice m AuthUser -> C.Splice m)
userCSplices :: Splices (RuntimeSplice m AuthUser -> Splice m)
userCSplices = Splices (RuntimeSplice m AuthUser -> Splice m)
forall (n :: * -> *) k.
(Monad n, IsString k) =>
MapSyntax k (RuntimeSplice n AuthUser -> Splice n)
fields Splices (RuntimeSplice m AuthUser -> Splice m)
-> Splices (RuntimeSplice m AuthUser -> Splice m)
-> Splices (RuntimeSplice m AuthUser -> Splice m)
forall a. Monoid a => a -> a -> a
`mappend` Splices (RuntimeSplice m AuthUser -> Splice m)
forall k (m :: * -> *).
(IsString k, Monad m) =>
MapSyntaxM k (RuntimeSplice m AuthUser -> Splice m) ()
ifs
  where
    fields :: MapSyntax k (RuntimeSplice n AuthUser -> Splice n)
fields = ((AuthUser -> Text) -> RuntimeSplice n AuthUser -> Splice n)
-> MapSyntaxM k (AuthUser -> Text) ()
-> MapSyntax k (RuntimeSplice n AuthUser -> Splice n)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV ((AuthUser -> Builder) -> RuntimeSplice n AuthUser -> Splice n
forall (n :: * -> *) a.
Monad n =>
(a -> Builder) -> RuntimeSplice n a -> Splice n
C.pureSplice ((AuthUser -> Builder) -> RuntimeSplice n AuthUser -> Splice n)
-> ((AuthUser -> Text) -> AuthUser -> Builder)
-> (AuthUser -> Text)
-> RuntimeSplice n AuthUser
-> Splice n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AuthUser -> Text) -> AuthUser -> Builder
forall a. (a -> Text) -> a -> Builder
C.textSplice) (MapSyntaxM k (AuthUser -> Text) ()
 -> MapSyntax k (RuntimeSplice n AuthUser -> Splice n))
-> MapSyntaxM k (AuthUser -> Text) ()
-> MapSyntax k (RuntimeSplice n AuthUser -> Splice n)
forall a b. (a -> b) -> a -> b
$ do
        "userId"          k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## Text -> (UserId -> Text) -> Maybe UserId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" UserId -> Text
unUid (Maybe UserId -> Text)
-> (AuthUser -> Maybe UserId) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe UserId
userId
        "userLogin"       k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## AuthUser -> Text
userLogin
        "userEmail"       k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "-" (Maybe Text -> Text)
-> (AuthUser -> Maybe Text) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe Text
userEmail
        "userActive"      k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## String -> Text
T.pack (String -> Text) -> (AuthUser -> String) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> (AuthUser -> Bool) -> AuthUser -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UTCTime -> Bool)
-> (AuthUser -> Maybe UTCTime) -> AuthUser -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe UTCTime
userSuspendedAt
        "userLoginCount"  k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## String -> Text
T.pack (String -> Text) -> (AuthUser -> String) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (AuthUser -> Int) -> AuthUser -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Int
userLoginCount
        "userFailedCount" k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## String -> Text
T.pack (String -> Text) -> (AuthUser -> String) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (AuthUser -> Int) -> AuthUser -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Int
userFailedLoginCount
        "userLoginAt"     k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" (String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) (Maybe UTCTime -> Text)
-> (AuthUser -> Maybe UTCTime) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe UTCTime
userCurrentLoginAt
        "userLastLoginAt" k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" (String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) (Maybe UTCTime -> Text)
-> (AuthUser -> Maybe UTCTime) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe UTCTime
userLastLoginAt
        "userSuspendedAt" k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" (String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) (Maybe UTCTime -> Text)
-> (AuthUser -> Maybe UTCTime) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe UTCTime
userSuspendedAt
        "userLoginIP"     k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" ByteString -> Text
decodeUtf8 (Maybe ByteString -> Text)
-> (AuthUser -> Maybe ByteString) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe ByteString
userCurrentLoginIp
        "userLastLoginIP" k -> (AuthUser -> Text) -> MapSyntaxM k (AuthUser -> Text) ()
forall k v. k -> v -> MapSyntax k v
## Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "-" ByteString -> Text
decodeUtf8 (Maybe ByteString -> Text)
-> (AuthUser -> Maybe ByteString) -> AuthUser -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe ByteString
userLastLoginIp
    ifs :: MapSyntaxM k (RuntimeSplice m AuthUser -> Splice m) ()
ifs = do
        "userIfActive"    k
-> (RuntimeSplice m AuthUser -> Splice m)
-> MapSyntaxM k (RuntimeSplice m AuthUser -> Splice m) ()
forall k v. k -> v -> MapSyntax k v
## (AuthUser -> Bool) -> RuntimeSplice m AuthUser -> Splice m
forall (m :: * -> *) t.
Monad m =>
(t -> Bool) -> RuntimeSplice m t -> Splice m
ifCSplice (Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UTCTime -> Bool)
-> (AuthUser -> Maybe UTCTime) -> AuthUser -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe UTCTime
userSuspendedAt)
        "userIfSuspended" k
-> (RuntimeSplice m AuthUser -> Splice m)
-> MapSyntaxM k (RuntimeSplice m AuthUser -> Splice m) ()
forall k v. k -> v -> MapSyntax k v
## (AuthUser -> Bool) -> RuntimeSplice m AuthUser -> Splice m
forall (m :: * -> *) t.
Monad m =>
(t -> Bool) -> RuntimeSplice m t -> Splice m
ifCSplice (Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isJust (Maybe UTCTime -> Bool)
-> (AuthUser -> Maybe UTCTime) -> AuthUser -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Maybe UTCTime
userSuspendedAt)


------------------------------------------------------------------------------
-- | A splice that can be used to check for existence of a user. If a user is
-- present, this will run the contents of the node.
--
-- > <ifLoggedIn> Show this when there is a logged in user </ifLoggedIn>
ifLoggedIn :: SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedIn :: SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedIn auth :: SnapletLens b (AuthManager 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 b)
-> Handler b (AuthManager 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 b)
auth Handler b (AuthManager b) Bool
forall b. Handler b (AuthManager b) Bool
isLoggedIn
    case Bool
chk of
      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
>>= Template -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> SnapletISplice b)
-> (Node -> Template) -> Node -> SnapletISplice b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Template
X.childNodes
      False -> Template -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return []


------------------------------------------------------------------------------
-- | A splice that can be used to check for existence of a user. If a user is
-- present, this will run the contents of the node.
--
-- > <ifLoggedIn> Show this when there is a logged in user </ifLoggedIn>
cIfLoggedIn :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedIn :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedIn auth :: SnapletLens b (AuthManager 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 b)
-> Handler b (AuthManager 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 b)
auth Handler b (AuthManager b) Bool
forall b. Handler b (AuthManager b) Bool
isLoggedIn
        case Bool
chk of
          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
          False -> RuntimeSplice (Handler b b) Builder
forall a. Monoid a => a
mempty


------------------------------------------------------------------------------
-- | A splice that can be used to check for absence of a user. If a user is
-- not present, this will run the contents of the node.
--
-- > <ifLoggedOut> Show this when there is a logged in user </ifLoggedOut>
ifLoggedOut :: SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedOut :: SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedOut auth :: SnapletLens b (AuthManager 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 b)
-> Handler b (AuthManager 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 b)
auth Handler b (AuthManager b) Bool
forall b. Handler b (AuthManager b) Bool
isLoggedIn
    case Bool
chk of
      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
>>= Template -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return (Template -> SnapletISplice b)
-> (Node -> Template) -> Node -> SnapletISplice b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Template
X.childNodes
      True -> Template -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return []


------------------------------------------------------------------------------
-- | A splice that can be used to check for absence of a user. If a user is
-- not present, this will run the contents of the node.
--
-- > <ifLoggedOut> Show this when there is a logged in user </ifLoggedOut>
cIfLoggedOut :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedOut :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedOut auth :: SnapletLens b (AuthManager 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 b)
-> Handler b (AuthManager 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 b)
auth Handler b (AuthManager b) Bool
forall b. Handler b (AuthManager b) Bool
isLoggedIn
        case Bool
chk of
          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
          True -> RuntimeSplice (Handler b b) Builder
forall a. Monoid a => a
mempty


-------------------------------------------------------------------------------
-- | A splice that will simply print the current user's login, if
-- there is one.
loggedInUser :: SnapletLens b (AuthManager b) -> SnapletISplice b
loggedInUser :: SnapletLens b (AuthManager b) -> SnapletISplice b
loggedInUser auth :: SnapletLens b (AuthManager b)
auth = do
    Maybe AuthUser
u <- Handler b b (Maybe AuthUser)
-> HeistT (Handler b b) (Handler b b) (Maybe AuthUser)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b (Maybe AuthUser)
 -> HeistT (Handler b b) (Handler b b) (Maybe AuthUser))
-> Handler b b (Maybe AuthUser)
-> HeistT (Handler b b) (Handler b b) (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager b)
-> Handler b (AuthManager b) (Maybe AuthUser)
-> Handler b b (Maybe AuthUser)
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager b)
auth Handler b (AuthManager b) (Maybe AuthUser)
forall b. Handler b (AuthManager b) (Maybe AuthUser)
currentUser
    SnapletISplice b
-> (AuthUser -> SnapletISplice b)
-> Maybe AuthUser
-> SnapletISplice b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Template -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Text -> SnapletISplice b
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> SnapletISplice b)
-> (AuthUser -> Text) -> AuthUser -> SnapletISplice b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Text
userLogin) Maybe AuthUser
u


-------------------------------------------------------------------------------
-- | A splice that will simply print the current user's login, if
-- there is one.
cLoggedInUser :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cLoggedInUser :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cLoggedInUser auth :: SnapletLens b (AuthManager 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 AuthUser
u <- Handler b b (Maybe AuthUser)
-> RuntimeSplice (Handler b b) (Maybe AuthUser)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b (Maybe AuthUser)
 -> RuntimeSplice (Handler b b) (Maybe AuthUser))
-> Handler b b (Maybe AuthUser)
-> RuntimeSplice (Handler b b) (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager b)
-> Handler b (AuthManager b) (Maybe AuthUser)
-> Handler b b (Maybe AuthUser)
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager b)
auth Handler b (AuthManager b) (Maybe AuthUser)
forall b. Handler b (AuthManager b) (Maybe AuthUser)
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 -> (AuthUser -> Text) -> Maybe AuthUser -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" AuthUser -> Text
userLogin Maybe AuthUser
u