-- eidolon -- A simple gallery in Haskell and Yesod -- Copyright (C) 2015 Amedeo Molnár -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published -- by the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . {-# LANGUAGE FlexibleInstances #-} module Foundation where import Prelude import Yesod import Yesod.Static import Yesod.Default.Util (addStaticContentExternal) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Database.Persist.Sql -- (ConnectionPool, runSqlPool) import Settings.StaticFiles import Settings import Model import Licence import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) import Yesod.Core.Types -- costom imports import qualified Data.Text as T import Data.Text.Encoding import Data.Maybe (fromJust) import Network.Wai import Helper hiding (hmacKeccak) import Yesod.Auth import Yesod.Auth.HmacKeccak import System.IO.Unsafe (unsafePerformIO) -- | The site argument 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 = App { appSettings :: AppSettings , appStatic :: Static -- ^ Settings for static file serving. , appConnPool :: ConnectionPool -- ^ Database connection pool. , appHttpManager :: Manager , appLogger :: Logger } instance HasHttpManager App where getHttpManager = appHttpManager -- Set up i18n messages. See the message folder. mkMessage "App" "messages" "en" -- 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 linked documentation for an -- explanation for this split. mkYesodData "App" $(parseRoutesFile "config/routes") type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) renderLayout :: Widget -> Handler Html renderLayout widget = do master <- getYesod route <- getCurrentRoute mmsg <- getMessage -- msu <- lookupSession "userId" musername <- maybeAuthId slug <- case musername of Just name -> do user <- runDB $ getBy $ UniqueUser name return $ userSlug $ entityVal $ fromJust user Nothing -> return ("" :: T.Text) admin <- case musername of Just name -> do user <- runDB $ getBy $ UniqueUser name return $ userAdmin $ entityVal $ fromJust user Nothing -> return False let block = appSignupBlocked $ appSettings master -- 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. searchWidget <- widgetToPageContent $ [whamlet|