{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-missing-deriving-strategies #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module BtcLsp.Yesod.Foundation where

import qualified BtcLsp.Class.Env as Class
import BtcLsp.Yesod.Data.BootstrapColor
import qualified BtcLsp.Yesod.Data.Language
import BtcLsp.Yesod.Import.NoFoundation
import BtcLsp.Yesod.TH (mkMessageNoFallback)
import Control.Monad.Logger (LogSource)
import qualified Data.CaseInsensitive as CI
import qualified Data.Kind as Kind
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.Text.Encoding as TE
import Database.Persist.Sql (ConnectionPool, runSqlPool)
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
import Yesod.Auth.Dummy
import qualified Yesod.Auth.Message as Auth
import Yesod.Core.Types (Logger)
import qualified Yesod.Core.Unsafe as Unsafe
import Yesod.Default.Util (addStaticContentExternal)

-- | NOTE : this type aliases are there only because of
-- poor support of advanced Haskell in yesodroutes and i18n
-- files through Yesod TH.
--
-- !!! DO NOT USE DIRECTLY IN SOURCE CODE !!!
type Uuid'SwapIntoLnTable = Uuid 'SwapIntoLnTable

type Money'Lsp'OnChain'Gain = Money 'Lsp 'OnChain 'Gain

type Money'Usr'OnChain'Fund = Money 'Usr 'OnChain 'Fund

-- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data App = forall m.
  (Class.Env m) =>
  App
  { App -> AppSettings
appSettings :: AppSettings,
    -- | Settings for static file serving.
    App -> Static
appStatic :: Static,
    -- | Database connection pool.
    App -> ConnectionPool
appConnPool :: ~ConnectionPool,
    App -> Manager
appHttpManager :: Manager,
    App -> Logger
appLogger :: Logger,
    ()
appMRunner :: UnliftIO m
  }

mkMessageNoFallback "App" "messages" $ "en" :| ["ru"]

data MenuItem = MenuItem
  { MenuItem -> AppMessage
menuItemLabel :: AppMessage,
    MenuItem -> Route App
menuItemRoute :: Route App,
    MenuItem -> Bool
menuItemAccessCallback :: Bool,
    MenuItem -> Bool
menuItemActiveCallback :: Bool,
    MenuItem -> Bool
menuItemNoReferrer :: Bool
  }

data MenuTypes
  = NavbarLeft MenuItem
  | NavbarRight MenuItem

-- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/routing-and-handlers
--
-- Note that this is really half the story; in Application.hs, mkYesodDispatch
-- generates the rest of the code. Please see the following documentation
-- for an explanation for this split:
-- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules
--
-- This function also generates the following type synonyms:
-- type Handler = HandlerFor App
-- type Widget = WidgetFor App ()
mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")

-- | A convenient synonym for creating forms.
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)

-- | A convenient synonym for database access functions.
type DB a =
  forall (m :: Kind.Type -> Kind.Type).
  (MonadUnliftIO m) =>
  ReaderT SqlBackend m a

-- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here.
instance Yesod App where
  -- Controls the base of generated URLs. For more information on modifying,
  -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
  approot :: Approot App
  approot :: Approot App
approot = (App -> Request -> Text) -> Approot App
forall master. (master -> Request -> Text) -> Approot master
ApprootRequest ((App -> Request -> Text) -> Approot App)
-> (App -> Request -> Text) -> Approot App
forall a b. (a -> b) -> a -> b
$ \App
app Request
req ->
    case AppSettings -> Maybe Text
appRoot (AppSettings -> Maybe Text) -> AppSettings -> Maybe Text
forall a b. (a -> b) -> a -> b
$ App -> AppSettings
appSettings App
app of
      Maybe Text
Nothing -> Approot App -> App -> Request -> Text
forall site. Approot site -> site -> Request -> Text
getApprootText Approot App
forall site. Approot site
guessApproot App
app Request
req
      Just Text
root -> Text
root

  -- Store session data on the client in encrypted cookies,
  -- default session idle timeout is 120 minutes
  makeSessionBackend :: App -> IO (Maybe SessionBackend)
  makeSessionBackend :: App -> IO (Maybe SessionBackend)
makeSessionBackend App
_ =
    SessionBackend -> Maybe SessionBackend
forall a. a -> Maybe a
Just
      (SessionBackend -> Maybe SessionBackend)
-> IO SessionBackend -> IO (Maybe SessionBackend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> IO SessionBackend
defaultClientSessionBackend
        Int
120 -- timeout in minutes
        String
"config/client_session_key.aes"

  -- Yesod Middleware allows you to run code before and after each handler function.
  -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
  -- Some users may also want to add the defaultCsrfMiddleware, which:
  --   a) Sets a cookie with a CSRF token in it.
  --   b) Validates that incoming write requests include that token in either a header or POST parameter.
  -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
  -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
  -- yesodMiddleware ::
  --   ( ToTypedContent res
  --   ) =>
  --   Handler res ->
  --   Handler res
  -- yesodMiddleware =
  --   defaultYesodMiddleware

  defaultLayout :: Widget -> Handler Html
  defaultLayout :: Widget -> HandlerFor App Markup
defaultLayout =
    Maybe PanelConfig -> Widget -> HandlerFor App Markup
newLayout Maybe PanelConfig
forall a. Maybe a
Nothing

  -- The page to be redirected to when authentication is required.
  authRoute ::
    App ->
    Maybe (Route App)
  authRoute :: App -> Maybe (Route App)
authRoute App
_ = Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just (Route App -> Maybe (Route App)) -> Route App -> Maybe (Route App)
forall a b. (a -> b) -> a -> b
$ Route Auth -> Route App
AuthR Route Auth
LoginR

  isAuthorized ::
    -- The route the user is visiting.
    Route App ->
    -- Whether or not this is a "write" request.
    Bool ->
    Handler AuthResult
  -- Routes not requiring authentication.
  isAuthorized :: Route App -> Bool -> HandlerFor App AuthResult
isAuthorized (AuthR Route Auth
_) Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (m :: * -> *) a. Monad m => a -> m a
return AuthResult
Authorized
  isAuthorized Route App
R:RouteApp
HomeR Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (m :: * -> *) a. Monad m => a -> m a
return AuthResult
Authorized
  isAuthorized Route App
R:RouteApp
FaviconR Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (m :: * -> *) a. Monad m => a -> m a
return AuthResult
Authorized
  isAuthorized Route App
R:RouteApp
RobotsR Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (m :: * -> *) a. Monad m => a -> m a
return AuthResult
Authorized
  isAuthorized (StaticR Route Static
_) Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (m :: * -> *) a. Monad m => a -> m a
return AuthResult
Authorized
  isAuthorized (LanguageR Code
_) Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (m :: * -> *) a. Monad m => a -> m a
return AuthResult
Authorized
  isAuthorized OpenChanR {} Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult
Authorized
  isAuthorized SwapIntoLnCreateR {} Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult
Authorized
  isAuthorized SwapIntoLnSelectR {} Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult
Authorized
  isAuthorized Route App
R:RouteApp
AboutR Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult
Authorized
  isAuthorized SwapUpdatesR {} Bool
_ = AuthResult -> HandlerFor App AuthResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult
Authorized

  -- This function creates static content files in the static folder
  -- and names them based on a hash of their content. This allows
  -- expiration dates to be set far in the future without worry of
  -- users receiving stale content.
  addStaticContent ::
    -- The file extension
    Text ->
    -- The MIME content type
    Text ->
    -- The contents of the file
    LByteString ->
    Handler (Maybe (Either Text (Route App, [(Text, Text)])))
  addStaticContent :: Text
-> Text
-> ByteString
-> HandlerFor App (Maybe (Either Text (Route App, [(Text, Text)])))
addStaticContent Text
ext Text
mime ByteString
content = do
    App
master <- HandlerFor App App
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    let staticDir :: String
staticDir = AppSettings -> String
appStaticDir (AppSettings -> String) -> AppSettings -> String
forall a b. (a -> b) -> a -> b
$ App -> AppSettings
appSettings App
master
    (ByteString -> Either String ByteString)
-> (ByteString -> String)
-> String
-> ([Text] -> Route App)
-> Text
-> Text
-> ByteString
-> HandlerFor App (Maybe (Either Text (Route App, [(Text, Text)])))
forall a master.
(ByteString -> Either a ByteString)
-> (ByteString -> String)
-> String
-> ([Text] -> Route master)
-> Text
-> Text
-> ByteString
-> HandlerFor
     master (Maybe (Either Text (Route master, [(Text, Text)])))
addStaticContentExternal
      ByteString -> Either String ByteString
minifym
      ByteString -> String
genFileName
      String
staticDir
      (Route Static -> Route App
StaticR (Route Static -> Route App)
-> ([Text] -> Route Static) -> [Text] -> Route App
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Text] -> [(Text, Text)] -> Route Static)
-> [(Text, Text)] -> [Text] -> Route Static
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Text] -> [(Text, Text)] -> Route Static
StaticRoute [])
      Text
ext
      Text
mime
      ByteString
content
    where
      -- Generate a unique filename based on the content itself
      genFileName :: ByteString -> String
genFileName ByteString
lbs = String
"autogen-" String -> ShowS
forall a. Monoid a => a -> a -> a
++ ByteString -> String
base64md5 ByteString
lbs

  -- What messages should be logged. The following includes all messages when
  -- in development, and warnings and errors in production.
  shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
  shouldLogIO :: App -> Text -> LogLevel -> IO Bool
shouldLogIO App
app Text
_source LogLevel
level =
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
      AppSettings -> Bool
appShouldLogAll (App -> AppSettings
appSettings App
app)
        Bool -> Bool -> Bool
|| LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Eq a => a -> a -> Bool
== LogLevel
LevelWarn
        Bool -> Bool -> Bool
|| LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Eq a => a -> a -> Bool
== LogLevel
LevelError

  makeLogger :: App -> IO Logger
  makeLogger :: App -> IO Logger
makeLogger = Logger -> IO Logger
forall (m :: * -> *) a. Monad m => a -> m a
return (Logger -> IO Logger) -> (App -> Logger) -> App -> IO Logger
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. App -> Logger
appLogger

-- Define breadcrumbs.
instance YesodBreadcrumbs App where
  -- Takes the route that the user is currently on, and returns a tuple
  -- of the 'Text' that you want the label to display, and a previous
  -- breadcrumb route.
  breadcrumb ::
    -- The route the user is visiting currently.
    Route App ->
    Handler (Text, Maybe (Route App))
  breadcrumb :: Route App -> HandlerFor App (Text, Maybe (Route App))
breadcrumb Route App
r = do
    AppMessage -> Text
render <- HandlerFor App (AppMessage -> Text)
forall (m :: * -> *) message.
(MonadHandler m, RenderMessage (HandlerSite m) message) =>
m (message -> Text)
getMessageRender
    (Text, Maybe (Route App))
-> HandlerFor App (Text, Maybe (Route App))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppMessage -> Text
render (AppMessage -> Text) -> AppMessage -> Text
forall a b. (a -> b) -> a -> b
$ Route App -> AppMessage
getMsg Route App
r, Route App -> Maybe (Route App)
getParent Route App
r)
    where
      getMsg :: Route App -> AppMessage
      getMsg :: Route App -> AppMessage
getMsg = \case
        StaticR Route Static
_ -> AppMessage
MsgNothing
        Route App
R:RouteApp
FaviconR -> AppMessage
MsgNothing
        Route App
R:RouteApp
RobotsR -> AppMessage
MsgNothing
        LanguageR {} -> AppMessage
MsgNothing
        AuthR {} -> AppMessage
MsgNothing
        Route App
R:RouteApp
HomeR -> AppMessage
MsgHomeRLinkShort
        Route App
R:RouteApp
OpenChanR -> AppMessage
MsgOpenChanRLinkShort
        Route App
R:RouteApp
SwapIntoLnCreateR -> AppMessage
MsgSwapIntoLnCreateRLinkShort
        SwapIntoLnSelectR Uuid'SwapIntoLnTable
x -> Uuid'SwapIntoLnTable -> AppMessage
MsgSwapIntoLnSelectRLinkShort Uuid'SwapIntoLnTable
x
        Route App
R:RouteApp
AboutR -> AppMessage
MsgAboutRLinkShort
        SwapUpdatesR Uuid'SwapIntoLnTable
_ SwapHash
_ -> AppMessage
MsgNothing
      getParent :: Route App -> Maybe (Route App)
      getParent :: Route App -> Maybe (Route App)
getParent = \case
        StaticR {} -> Maybe (Route App)
forall a. Maybe a
Nothing
        Route App
R:RouteApp
FaviconR -> Maybe (Route App)
forall a. Maybe a
Nothing
        Route App
R:RouteApp
RobotsR -> Maybe (Route App)
forall a. Maybe a
Nothing
        LanguageR {} -> Maybe (Route App)
forall a. Maybe a
Nothing
        Route App
R:RouteApp
HomeR -> Maybe (Route App)
forall a. Maybe a
Nothing
        AuthR {} -> Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
HomeR
        Route App
R:RouteApp
OpenChanR -> Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
HomeR
        Route App
R:RouteApp
SwapIntoLnCreateR -> Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
HomeR
        SwapIntoLnSelectR {} -> Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
SwapIntoLnCreateR
        Route App
R:RouteApp
AboutR -> Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
HomeR
        SwapUpdatesR Uuid'SwapIntoLnTable
_ SwapHash
_ -> Maybe (Route App)
forall a. Maybe a
Nothing

-- How to run database actions.
instance YesodPersist App where
  type YesodPersistBackend App = SqlBackend
  runDB :: SqlPersistT Handler a -> Handler a
  runDB :: forall a. SqlPersistT (HandlerFor App) a -> Handler a
runDB SqlPersistT (HandlerFor App) a
action = do
    App
master <- HandlerFor App App
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    SqlPersistT (HandlerFor App) a -> ConnectionPool -> Handler a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool SqlPersistT (HandlerFor App) a
action (ConnectionPool -> Handler a) -> ConnectionPool -> Handler a
forall a b. (a -> b) -> a -> b
$ App -> ConnectionPool
appConnPool App
master

instance YesodPersistRunner App where
  getDBRunner :: Handler (DBRunner App, Handler ())
  getDBRunner :: HandlerFor App (DBRunner App, HandlerFor App ())
getDBRunner = (App -> ConnectionPool)
-> HandlerFor App (DBRunner App, HandlerFor App ())
forall backend site.
(IsSqlBackend backend, YesodPersistBackend site ~ backend) =>
(site -> Pool backend)
-> HandlerFor site (DBRunner site, HandlerFor site ())
defaultGetDBRunner App -> ConnectionPool
appConnPool

instance YesodAuth App where
  type AuthId App = UserId

  -- Where to send a user after successful login
  loginDest :: App -> Route App
  loginDest :: App -> Route App
loginDest App
_ = Route App
HomeR

  -- Where to send a user after logout
  logoutDest :: App -> Route App
  logoutDest :: App -> Route App
logoutDest App
_ = Route App
HomeR

  -- Override the above two destinations when a Referer: header is present
  redirectToReferer :: App -> Bool
  redirectToReferer :: App -> Bool
redirectToReferer App
_ = Bool
True

  authenticate ::
    ( MonadHandler m,
      HandlerSite m ~ App
    ) =>
    Creds App ->
    m (AuthenticationResult App)
  authenticate :: forall (m :: * -> *).
(MonadHandler m, HandlerSite m ~ App) =>
Creds App -> m (AuthenticationResult App)
authenticate Creds App
_ =
    HandlerFor (HandlerSite m) (AuthenticationResult App)
-> m (AuthenticationResult App)
forall (m :: * -> *) a.
MonadHandler m =>
HandlerFor (HandlerSite m) a -> m a
liftHandler (HandlerFor (HandlerSite m) (AuthenticationResult App)
 -> m (AuthenticationResult App))
-> HandlerFor (HandlerSite m) (AuthenticationResult App)
-> m (AuthenticationResult App)
forall a b. (a -> b) -> a -> b
$
      AuthenticationResult App
-> HandlerFor App (AuthenticationResult App)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticationResult App
 -> HandlerFor App (AuthenticationResult App))
-> AuthenticationResult App
-> HandlerFor App (AuthenticationResult App)
forall a b. (a -> b) -> a -> b
$ AuthMessage -> AuthenticationResult App
forall master. AuthMessage -> AuthenticationResult master
UserError AuthMessage
Auth.AuthError

  -- You can add other plugins like Google Email, email or OAuth here
  authPlugins :: App -> [AuthPlugin App]
  authPlugins :: App -> [AuthPlugin App]
authPlugins App
app =
    [AuthPlugin App]
extraAuthPlugins
    where
      -- Enable authDummy login if enabled.
      extraAuthPlugins :: [AuthPlugin App]
extraAuthPlugins = [AuthPlugin App
forall m. YesodAuth m => AuthPlugin m
authDummy | AppSettings -> Bool
appAuthDummyLogin (AppSettings -> Bool) -> AppSettings -> Bool
forall a b. (a -> b) -> a -> b
$ App -> AppSettings
appSettings App
app]

-- | Access function to determine if a user is logged in.
isAuthenticated :: Handler AuthResult
isAuthenticated :: HandlerFor App AuthResult
isAuthenticated = do
  Maybe (Key User)
muid <- HandlerFor App (Maybe (Key User))
forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, master ~ HandlerSite m) =>
m (Maybe (AuthId master))
maybeAuthId
  AuthResult -> HandlerFor App AuthResult
forall (m :: * -> *) a. Monad m => a -> m a
return (AuthResult -> HandlerFor App AuthResult)
-> AuthResult -> HandlerFor App AuthResult
forall a b. (a -> b) -> a -> b
$ case Maybe (Key User)
muid of
    Maybe (Key User)
Nothing -> Text -> AuthResult
Unauthorized Text
"You must login to access this page"
    Just Key User
_ -> AuthResult
Authorized

instance YesodAuthPersist App

-- This instance is required to use forms. You can modify renderMessage to
-- achieve customized and internationalized form validation messages.
instance RenderMessage App FormMessage where
  renderMessage :: App -> [Lang] -> FormMessage -> Text
  renderMessage :: App -> [Text] -> FormMessage -> Text
renderMessage App
_ [Text]
_ = FormMessage -> Text
defaultFormMessage

-- Useful when writing code that is re-usable outside of the Handler context.
-- An example is background jobs that send email.
-- This can also be useful for writing code that works across multiple Yesod applications.
instance HasHttpManager App where
  getHttpManager :: App -> Manager
  getHttpManager :: App -> Manager
getHttpManager = App -> Manager
appHttpManager

unsafeHandler :: App -> Handler a -> IO a
unsafeHandler :: forall a. App -> Handler a -> IO a
unsafeHandler = (App -> Logger) -> App -> HandlerFor App a -> IO a
forall site (m :: * -> *) a.
(Yesod site, MonadIO m) =>
(site -> Logger) -> site -> HandlerFor site a -> m a
Unsafe.fakeHandlerGetLogger App -> Logger
appLogger

data PanelConfig = PanelConfig
  { PanelConfig -> BootstrapColor
panelConfigColor :: BootstrapColor,
    PanelConfig -> AppMessage
panelConfigMsgShort :: AppMessage,
    PanelConfig -> AppMessage
panelConfigMsgLong :: AppMessage
  }

newLayout :: Maybe PanelConfig -> Widget -> Handler Html
newLayout :: Maybe PanelConfig -> Widget -> HandlerFor App Markup
newLayout Maybe PanelConfig
mpcfg Widget
widget = do
  App
master <- HandlerFor App App
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
  Maybe Markup
mmsg <- HandlerFor App (Maybe Markup)
forall (m :: * -> *). MonadHandler m => m (Maybe Markup)
getMessage
  Maybe (Route App)
mcurrentRoute <- HandlerFor App (Maybe (Route App))
forall (m :: * -> *).
MonadHandler m =>
m (Maybe (Route (HandlerSite m)))
getCurrentRoute

  -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
  (Text
title, [(Route App, Text)]
parents) <- HandlerFor App (Text, [(Route App, Text)])
forall site.
(YesodBreadcrumbs site, Show (Route site), Eq (Route site)) =>
HandlerFor site (Text, [(Route site, Text)])
breadcrumbs

  -- Define the menu items of the header.
  let menuItems :: [MenuTypes]
menuItems =
        [ MenuItem -> MenuTypes
NavbarLeft (MenuItem -> MenuTypes) -> MenuItem -> MenuTypes
forall a b. (a -> b) -> a -> b
$
            MenuItem :: AppMessage -> Route App -> Bool -> Bool -> Bool -> MenuItem
MenuItem
              { menuItemLabel :: AppMessage
menuItemLabel = AppMessage
MsgHomeRLinkShort,
                menuItemRoute :: Route App
menuItemRoute = Route App
HomeR,
                menuItemAccessCallback :: Bool
menuItemAccessCallback = Bool
True,
                menuItemActiveCallback :: Bool
menuItemActiveCallback = Maybe (Route App)
mcurrentRoute Maybe (Route App) -> Maybe (Route App) -> Bool
forall a. Eq a => a -> a -> Bool
== Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
HomeR,
                menuItemNoReferrer :: Bool
menuItemNoReferrer = Bool
False
              },
          MenuItem -> MenuTypes
NavbarLeft (MenuItem -> MenuTypes) -> MenuItem -> MenuTypes
forall a b. (a -> b) -> a -> b
$
            MenuItem :: AppMessage -> Route App -> Bool -> Bool -> Bool -> MenuItem
MenuItem
              { menuItemLabel :: AppMessage
menuItemLabel = AppMessage
MsgOpenChanRLinkShort,
                menuItemRoute :: Route App
menuItemRoute = Route App
OpenChanR,
                menuItemAccessCallback :: Bool
menuItemAccessCallback = Bool
True,
                menuItemActiveCallback :: Bool
menuItemActiveCallback = Maybe (Route App)
mcurrentRoute Maybe (Route App) -> Maybe (Route App) -> Bool
forall a. Eq a => a -> a -> Bool
== Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
OpenChanR,
                menuItemNoReferrer :: Bool
menuItemNoReferrer = Bool
False
              },
          MenuItem -> MenuTypes
NavbarLeft (MenuItem -> MenuTypes) -> MenuItem -> MenuTypes
forall a b. (a -> b) -> a -> b
$
            MenuItem :: AppMessage -> Route App -> Bool -> Bool -> Bool -> MenuItem
MenuItem
              { menuItemLabel :: AppMessage
menuItemLabel = AppMessage
MsgSwapIntoLnCreateRLinkShort,
                menuItemRoute :: Route App
menuItemRoute = Route App
SwapIntoLnCreateR,
                menuItemAccessCallback :: Bool
menuItemAccessCallback = Bool
True,
                menuItemActiveCallback :: Bool
menuItemActiveCallback =
                  Bool -> (Route App -> Bool) -> Maybe (Route App) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    Bool
False
                    ( \case
                        Route App
R:RouteApp
SwapIntoLnCreateR -> Bool
True
                        SwapIntoLnSelectR {} -> Bool
True
                        Route App
_ -> Bool
False
                    )
                    Maybe (Route App)
mcurrentRoute,
                menuItemNoReferrer :: Bool
menuItemNoReferrer = Bool
False
              },
          MenuItem -> MenuTypes
NavbarLeft (MenuItem -> MenuTypes) -> MenuItem -> MenuTypes
forall a b. (a -> b) -> a -> b
$
            MenuItem :: AppMessage -> Route App -> Bool -> Bool -> Bool -> MenuItem
MenuItem
              { menuItemLabel :: AppMessage
menuItemLabel = AppMessage
MsgAboutRLinkShort,
                menuItemRoute :: Route App
menuItemRoute = Route App
AboutR,
                menuItemAccessCallback :: Bool
menuItemAccessCallback = Bool
True,
                menuItemActiveCallback :: Bool
menuItemActiveCallback = Maybe (Route App)
mcurrentRoute Maybe (Route App) -> Maybe (Route App) -> Bool
forall a. Eq a => a -> a -> Bool
== Route App -> Maybe (Route App)
forall a. a -> Maybe a
Just Route App
AboutR,
                menuItemNoReferrer :: Bool
menuItemNoReferrer = Bool
False
              }
        ]

  let navbarLeftMenuItems :: [MenuItem]
navbarLeftMenuItems = [MenuItem
x | NavbarLeft MenuItem
x <- [MenuTypes]
menuItems]
  let navbarRightMenuItems :: [MenuItem]
navbarRightMenuItems = [MenuItem
x | NavbarRight MenuItem
x <- [MenuTypes]
menuItems]

  let navbarLeftFilteredMenuItems :: [MenuItem]
navbarLeftFilteredMenuItems = [MenuItem
x | MenuItem
x <- [MenuItem]
navbarLeftMenuItems, MenuItem -> Bool
menuItemAccessCallback MenuItem
x]
  let navbarRightFilteredMenuItems :: [MenuItem]
navbarRightFilteredMenuItems = [MenuItem
x | MenuItem
x <- [MenuItem]
navbarRightMenuItems, MenuItem -> Bool
menuItemAccessCallback MenuItem
x]

  -- We break up the default layout into two components:
  -- default-layout is the contents of the body tag, and
  -- default-layout-wrapper is the entire page. Since the final
  -- value passed to hamletToRepHtml cannot be a widget, this allows
  -- you to use normal widget features in default-layout.

  Maybe Text
mLang <- Text -> HandlerFor App (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession Text
"_LANG"
  let disclaimerTos :: Widget
disclaimerTos = $(widgetFile "disclaimer_tos")
  PageContent (Route App)
pc <- Widget -> HandlerFor App (PageContent (Route App))
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site (PageContent (Route site))
widgetToPageContent (Widget -> HandlerFor App (PageContent (Route App)))
-> Widget -> HandlerFor App (PageContent (Route App))
forall a b. (a -> b) -> a -> b
$ do
    Route (HandlerSite (WidgetFor App)) -> Widget
forall (m :: * -> *).
MonadWidget m =>
Route (HandlerSite m) -> m ()
addStylesheet (Route (HandlerSite (WidgetFor App)) -> Widget)
-> Route (HandlerSite (WidgetFor App)) -> Widget
forall a b. (a -> b) -> a -> b
$ Route Static -> Route App
StaticR Route Static
css_bootstrap_css
    Route (HandlerSite (WidgetFor App)) -> Widget
forall (m :: * -> *).
MonadWidget m =>
Route (HandlerSite m) -> m ()
addStylesheet (Route (HandlerSite (WidgetFor App)) -> Widget)
-> Route (HandlerSite (WidgetFor App)) -> Widget
forall a b. (a -> b) -> a -> b
$ Route Static -> Route App
StaticR Route Static
css_app_css
    --  generated from @Settings/StaticFiles.hs@
    $(widgetFile "default-layout")

  ((Route (HandlerSite (HandlerFor App)) -> [(Text, Text)] -> Text)
 -> Markup)
-> HandlerFor App Markup
forall (m :: * -> *) output.
MonadHandler m =>
((Route (HandlerSite m) -> [(Text, Text)] -> Text) -> output)
-> m output
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")

panelLayout ::
  BootstrapColor ->
  AppMessage ->
  AppMessage ->
  Widget ->
  Handler Html
panelLayout :: BootstrapColor
-> AppMessage -> AppMessage -> Widget -> HandlerFor App Markup
panelLayout BootstrapColor
color AppMessage
msgShort AppMessage
msgLong =
  Maybe PanelConfig -> Widget -> HandlerFor App Markup
newLayout (Maybe PanelConfig -> Widget -> HandlerFor App Markup)
-> (PanelConfig -> Maybe PanelConfig)
-> PanelConfig
-> Widget
-> HandlerFor App Markup
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PanelConfig -> Maybe PanelConfig
forall a. a -> Maybe a
Just (PanelConfig -> Widget -> HandlerFor App Markup)
-> PanelConfig -> Widget -> HandlerFor App Markup
forall a b. (a -> b) -> a -> b
$
    PanelConfig :: BootstrapColor -> AppMessage -> AppMessage -> PanelConfig
PanelConfig
      { panelConfigColor :: BootstrapColor
panelConfigColor = BootstrapColor
color,
        panelConfigMsgShort :: AppMessage
panelConfigMsgShort = AppMessage
msgShort,
        panelConfigMsgLong :: AppMessage
panelConfigMsgLong = AppMessage
msgLong
      }

-- Note: Some functionality previously present in the scaffolding has been
-- moved to documentation in the Wiki. Following are some hopefully helpful
-- links:
--
--
-- https://github.com/yesodweb/yesod/wiki/Sending-email
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding