├── .ghci ├── .gitignore ├── Api.hs ├── Api └── Data.hs ├── Application.hs ├── Foundation.hs ├── Handler ├── Comment.hs ├── Common.hs └── Home.hs ├── Import.hs ├── Import └── NoFoundation.hs ├── Model.hs ├── README.md ├── Resolve.hs ├── Settings.hs ├── Settings └── StaticFiles.hs ├── app ├── DevelMain.hs ├── devel.hs └── main.hs ├── config ├── apiRoutes ├── favicon.ico ├── keter.yml ├── models ├── robots.txt ├── routes ├── settings.yml └── test-settings.yml ├── justfile ├── rest.hurl ├── stack.yaml ├── stack.yaml.lock ├── static ├── .babelrc ├── .eslintrc ├── app │ └── jsx │ │ └── home.jsx ├── css │ └── bootstrap.css ├── fonts │ ├── glyphicons-halflings-regular.eot │ ├── glyphicons-halflings-regular.svg │ ├── glyphicons-halflings-regular.ttf │ └── glyphicons-halflings-regular.woff ├── package.json └── webpack.config.js ├── templates ├── default-layout-wrapper.hamlet ├── default-layout.hamlet ├── homepage.hamlet ├── homepage.julius └── homepage.lucius ├── test ├── Handler │ ├── CommentSpec.hs │ ├── CommonSpec.hs │ └── HomeSpec.hs ├── Spec.hs └── TestImport.hs └── yesod-rest.cabal /.ghci: -------------------------------------------------------------------------------- 1 | :set -i.:config:dist/build/autogen 2 | :set -DDEVELOPMENT 3 | :set -XCPP 4 | :set -XDeriveDataTypeable 5 | :set -XEmptyDataDecls 6 | :set -XFlexibleContexts 7 | :set -XGADTs 8 | :set -XGeneralizedNewtypeDeriving 9 | :set -XMultiParamTypeClasses 10 | :set -XNoImplicitPrelude 11 | :set -XNoMonomorphismRestriction 12 | :set -XOverloadedStrings 13 | :set -XQuasiQuotes 14 | :set -XRecordWildCards 15 | :set -XTemplateHaskell 16 | :set -XTupleSections 17 | :set -XTypeFamilies 18 | :set -XViewPatterns 19 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist* 2 | static/tmp/ 3 | static/combined/ 4 | config/client_session_key.aes 5 | *.hi 6 | *.o 7 | *.sqlite3 8 | *.sqlite3-shm 9 | *.sqlite3-wal 10 | .hsenv* 11 | cabal-dev/ 12 | .stack-work/ 13 | yesod-devel/ 14 | .cabal-sandbox 15 | cabal.sandbox.config 16 | .DS_Store 17 | *.swp 18 | *.keter 19 | node_modules 20 | static/builds 21 | npm-debug.log 22 | .envrc 23 | -------------------------------------------------------------------------------- /Api.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE QuasiQuotes #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# OPTIONS_GHC -fno-warn-orphans #-} 8 | 9 | module Api 10 | ( module Api.Data 11 | , module Api 12 | ) where 13 | 14 | import Api.Data 15 | import Yesod 16 | import Import.NoFoundation 17 | import Resolve 18 | import Foundation () 19 | 20 | instance YesodSubDispatch ApiSub App where 21 | yesodSubDispatch = $(mkYesodSubDispatch resourcesApiSub) 22 | 23 | -- getUserR :: ApiHandler RepJson 24 | getUserR :: SubHandlerFor ApiSub App RepJson 25 | getUserR = return $ repJson $ object ["name" .= name, "age" .= age] 26 | where 27 | name = "Sibi" :: Text 28 | age = 28 :: Int 29 | 30 | -- postUserR :: ApiHandler RepJson 31 | postUserR :: SubHandlerFor ApiSub App RepJson 32 | postUserR = do 33 | user <- requireCheckJsonBody 34 | _ <- liftHandler $ runDB $ insert user 35 | return $ repJson $ object ["ident" .= userIdent user, "password" .= userPassword user] 36 | 37 | patchUserPasswordR :: Text -> SubHandlerFor ApiSub App TypedContent 38 | patchUserPasswordR ident = do 39 | user <- 40 | liftHandler $ 41 | helperFunc ident 42 | let x = invalidArgs ["User id is invalid"] 43 | maybe x (return . toTypedContent . toJSON) user 44 | 45 | helperFunc :: Text -> HandlerFor App (Maybe (Entity User)) 46 | helperFunc ident = runDB $ do 47 | updateWhere [UserIdent ==. ident] [UserPassword =. Nothing] 48 | user <- selectFirst [UserIdent ==. ident] [] 49 | return user 50 | -------------------------------------------------------------------------------- /Api/Data.hs: -------------------------------------------------------------------------------- 1 | {-#LANGUAGE RankNTypes#-} 2 | 3 | module Api.Data where 4 | 5 | import Yesod 6 | import Yesod.Auth 7 | import Database.Persist.Sql (SqlBackend) 8 | import ClassyPrelude 9 | 10 | -- Subsites have foundations just like master sites. 11 | data ApiSub = ApiSub 12 | 13 | type ApiHandler a = forall master. (Yesod master, YesodAuth master, YesodPersistBackend master ~ SqlBackend, YesodPersist master) => HandlerT ApiSub (HandlerT master IO) a 14 | 15 | -- We have a familiar analogue from mkYesod, with just one extra parameter. 16 | mkYesodSubData "ApiSub" $(parseRoutesFile "config/apiRoutes") 17 | -------------------------------------------------------------------------------- /Application.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | module Application 3 | ( getApplicationDev 4 | , appMain 5 | , develMain 6 | , makeFoundation 7 | , makeLogWare 8 | -- * for DevelMain 9 | , getApplicationRepl 10 | , shutdownApp 11 | -- * for GHCI 12 | , handler 13 | , db 14 | ) where 15 | 16 | import Control.Monad.Logger (liftLoc, runLoggingT) 17 | import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, 18 | pgPoolSize, runSqlPool) 19 | import Import 20 | import Language.Haskell.TH.Syntax (qLocation) 21 | import Network.Wai (Middleware) 22 | import Network.Wai.Handler.Warp (Settings, defaultSettings, 23 | defaultShouldDisplayException, 24 | runSettings, setHost, 25 | setOnException, setPort, getPort) 26 | import Network.Wai.Middleware.RequestLogger (Destination (Logger), 27 | IPAddrSource (..), 28 | OutputFormat (..), destination, 29 | mkRequestLogger, outputFormat) 30 | import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, 31 | toLogStr) 32 | import Api (ApiSub(..)) 33 | import Resolve 34 | -- Import all relevant handler modules here. 35 | -- Don't forget to add new modules to your cabal file! 36 | import Handler.Common 37 | import Handler.Home 38 | import Handler.Comment 39 | 40 | -- This line actually creates our YesodDispatch instance. It is the second half 41 | -- of the call to mkYesodData which occurs in Foundation.hs. Please see the 42 | -- comments there for more details. 43 | mkYesodDispatch "App" resourcesApp 44 | 45 | -- | This function allocates resources (such as a database connection pool), 46 | -- performs initialization and returns a foundation datatype value. This is also 47 | -- the place to put your migrate statements to have automatic database 48 | -- migrations handled by Yesod. 49 | makeFoundation :: AppSettings -> IO App 50 | makeFoundation appSettings = do 51 | -- Some basic initializations: HTTP connection manager, logger, and static 52 | -- subsite. 53 | appHttpManager <- newManager 54 | appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger 55 | appStatic <- 56 | (if appMutableStatic appSettings then staticDevel else static) 57 | (appStaticDir appSettings) 58 | 59 | getApiSub <- return ApiSub 60 | 61 | -- We need a log function to create a connection pool. We need a connection 62 | -- pool to create our foundation. And we need our foundation to get a 63 | -- logging function. To get out of this loop, we initially create a 64 | -- temporary foundation without a real connection pool, get a log function 65 | -- from there, and then create the real foundation. 66 | let mkFoundation appConnPool = App {..} 67 | -- The App {..} syntax is an example of record wild cards. For more 68 | -- information, see: 69 | -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html 70 | tempFoundation = mkFoundation $ error "connPool forced in tempFoundation" 71 | logFunc = messageLoggerSource tempFoundation appLogger 72 | 73 | -- Create the database connection pool 74 | pool <- flip runLoggingT logFunc $ createPostgresqlPool 75 | (pgConnStr $ appDatabaseConf appSettings) 76 | (pgPoolSize $ appDatabaseConf appSettings) 77 | 78 | -- Perform database migration using our application's logging settings. 79 | runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc 80 | 81 | -- Return the foundation 82 | return $ mkFoundation pool 83 | 84 | -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and 85 | -- applying some additional middlewares. 86 | makeApplication :: App -> IO Application 87 | makeApplication foundation = do 88 | logWare <- makeLogWare foundation 89 | -- Create the WAI application and apply middlewares 90 | appPlain <- toWaiAppPlain foundation 91 | return $ logWare $ defaultMiddlewaresNoLogging appPlain 92 | 93 | makeLogWare :: App -> IO Middleware 94 | makeLogWare foundation = 95 | mkRequestLogger def 96 | { outputFormat = 97 | if appDetailedRequestLogging $ appSettings foundation 98 | then Detailed True 99 | else Apache 100 | (if appIpFromHeader $ appSettings foundation 101 | then FromFallback 102 | else FromSocket) 103 | , destination = Logger $ loggerSet $ appLogger foundation 104 | } 105 | 106 | 107 | -- | Warp settings for the given foundation value. 108 | warpSettings :: App -> Settings 109 | warpSettings foundation = 110 | setPort (appPort $ appSettings foundation) 111 | $ setHost (appHost $ appSettings foundation) 112 | $ setOnException (\_req e -> 113 | when (defaultShouldDisplayException e) $ messageLoggerSource 114 | foundation 115 | (appLogger foundation) 116 | $(qLocation >>= liftLoc) 117 | "yesod" 118 | LevelError 119 | (toLogStr $ "Exception from Warp: " ++ show e)) 120 | defaultSettings 121 | 122 | -- | For yesod devel, return the Warp settings and WAI Application. 123 | getApplicationDev :: IO (Settings, Application) 124 | getApplicationDev = do 125 | settings <- getAppSettings 126 | foundation <- makeFoundation settings 127 | wsettings <- getDevSettings $ warpSettings foundation 128 | app <- makeApplication foundation 129 | return (wsettings, app) 130 | 131 | getAppSettings :: IO AppSettings 132 | getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv 133 | 134 | -- | main function for use by yesod devel 135 | develMain :: IO () 136 | develMain = develMainHelper getApplicationDev 137 | 138 | -- | The @main@ function for an executable running this site. 139 | appMain :: IO () 140 | appMain = do 141 | -- Get the settings from all relevant sources 142 | settings <- loadYamlSettingsArgs 143 | -- fall back to compile-time values, set to [] to require values at runtime 144 | [configSettingsYmlValue] 145 | 146 | -- allow environment variables to override 147 | useEnv 148 | 149 | -- Generate the foundation from the settings 150 | foundation <- makeFoundation settings 151 | 152 | -- Generate a WAI Application from the foundation 153 | app <- makeApplication foundation 154 | 155 | -- Run the application with Warp 156 | runSettings (warpSettings foundation) app 157 | 158 | 159 | -------------------------------------------------------------- 160 | -- Functions for DevelMain.hs (a way to run the app from GHCi) 161 | -------------------------------------------------------------- 162 | getApplicationRepl :: IO (Int, App, Application) 163 | getApplicationRepl = do 164 | settings <- getAppSettings 165 | foundation <- makeFoundation settings 166 | wsettings <- getDevSettings $ warpSettings foundation 167 | app1 <- makeApplication foundation 168 | return (getPort wsettings, foundation, app1) 169 | 170 | shutdownApp :: App -> IO () 171 | shutdownApp _ = return () 172 | 173 | 174 | --------------------------------------------- 175 | -- Functions for use in development with GHCi 176 | --------------------------------------------- 177 | 178 | -- | Run a handler 179 | handler :: Handler a -> IO a 180 | handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h 181 | 182 | -- | Run DB queries 183 | db :: ReaderT SqlBackend (HandlerFor App) a -> IO a 184 | db = handler . runDB 185 | -------------------------------------------------------------------------------- /Foundation.hs: -------------------------------------------------------------------------------- 1 | {-#LANGUAGE InstanceSigs#-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | 4 | module Foundation where 5 | 6 | import Import.NoFoundation 7 | import Database.Persist.Sql (runSqlPool) 8 | import Text.Hamlet (hamletFile) 9 | import Text.Jasmine (minifym) 10 | import Yesod.Auth.OpenId (authOpenId, IdentifierType (Claimed)) 11 | import Yesod.Default.Util (addStaticContentExternal) 12 | import qualified Yesod.Core.Unsafe as Unsafe 13 | import qualified Data.CaseInsensitive as CI 14 | import qualified Data.Text.Encoding as TE 15 | import Resolve 16 | import Api.Data 17 | 18 | -- | A convenient synonym for creating forms. 19 | type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) 20 | 21 | -- Please see the documentation for the Yesod typeclass. There are a number 22 | -- of settings which can be configured by overriding methods here. 23 | instance Yesod App where 24 | -- Controls the base of generated URLs. For more information on modifying, 25 | -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot 26 | approot = ApprootRequest $ \app req -> 27 | case appRoot $ appSettings app of 28 | Nothing -> getApprootText guessApproot app req 29 | Just root -> root 30 | 31 | -- Store session data on the client in encrypted cookies, 32 | -- default session idle timeout is 120 minutes 33 | makeSessionBackend _ = Just <$> defaultClientSessionBackend 34 | 120 -- timeout in minutes 35 | "config/client_session_key.aes" 36 | 37 | -- Yesod Middleware allows you to run code before and after each handler function. 38 | -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks. 39 | -- Some users may also want to add the defaultCsrfMiddleware, which: 40 | -- a) Sets a cookie with a CSRF token in it. 41 | -- b) Validates that incoming write requests include that token in either a header or POST parameter. 42 | -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware 43 | -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package. 44 | yesodMiddleware = defaultYesodMiddleware 45 | 46 | defaultLayout widget = do 47 | master <- getYesod 48 | mmsg <- getMessage 49 | 50 | -- We break up the default layout into two components: 51 | -- default-layout is the contents of the body tag, and 52 | -- default-layout-wrapper is the entire page. Since the final 53 | -- value passed to hamletToRepHtml cannot be a widget, this allows 54 | -- you to use normal widget features in default-layout. 55 | 56 | pc <- widgetToPageContent $ do 57 | addStylesheet $ StaticR css_bootstrap_css 58 | $(widgetFile "default-layout") 59 | withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") 60 | 61 | -- The page to be redirected to when authentication is required. 62 | authRoute _ = Just $ AuthR LoginR 63 | 64 | -- Routes not requiring authentication. 65 | isAuthorized (AuthR _) _ = return Authorized 66 | isAuthorized FaviconR _ = return Authorized 67 | isAuthorized RobotsR _ = return Authorized 68 | isAuthorized HomeR _ = return Authorized 69 | isAuthorized (ApisiteR UserR) _ = return Authorized 70 | isAuthorized (ApisiteR _) _ = return $ Unauthorized "you must be admin" 71 | -- Default to Authorized for now. 72 | isAuthorized _ _ = return Authorized 73 | 74 | --isAuthorized _ _ = return $ Unauthorized "you must be admin" 75 | 76 | -- This function creates static content files in the static folder 77 | -- and names them based on a hash of their content. This allows 78 | -- expiration dates to be set far in the future without worry of 79 | -- users receiving stale content. 80 | addStaticContent ext mime content = do 81 | master <- getYesod 82 | let staticDir = appStaticDir $ appSettings master 83 | addStaticContentExternal 84 | minifym 85 | genFileName 86 | staticDir 87 | (StaticR . flip StaticRoute []) 88 | ext 89 | mime 90 | content 91 | where 92 | -- Generate a unique filename based on the content itself 93 | genFileName lbs = "autogen-" ++ base64md5 lbs 94 | 95 | -- What messages should be logged. The following includes all messages when 96 | -- in development, and warnings and errors in production. 97 | -- shouldLogIO app _source level = 98 | -- appShouldLogAll (appSettings app) 99 | -- || level == LevelWarn 100 | -- || level == LevelError 101 | 102 | makeLogger = return . appLogger 103 | 104 | -- How to run database actions. 105 | instance YesodPersist App where 106 | type YesodPersistBackend App = SqlBackend 107 | -- runDB :: (MonadHandler m, HandlerSite m ~ App, MonadUnliftIO m) => ReaderT SqlBackend m a -> m a 108 | runDB action = do 109 | master <- getYesod 110 | runSqlPool action $ appConnPool master 111 | 112 | runDB2 :: (MonadHandler m, HandlerSite m ~ App, MonadUnliftIO m) => ReaderT SqlBackend m a -> m a 113 | runDB2 action = do 114 | master <- getYesod 115 | runSqlPool action $ appConnPool master 116 | 117 | instance YesodPersistRunner App where 118 | getDBRunner = defaultGetDBRunner appConnPool 119 | 120 | instance YesodAuth App where 121 | type AuthId App = UserId 122 | 123 | -- Where to send a user after successful login 124 | loginDest _ = HomeR 125 | -- Where to send a user after logout 126 | logoutDest _ = HomeR 127 | -- Override the above two destinations when a Referer: header is present 128 | redirectToReferer _ = True 129 | 130 | authenticate creds = liftHandler $ runDB $ do 131 | x <- getBy $ UniqueUser $ credsIdent creds 132 | case x of 133 | Just (Entity uid _) -> return $ Authenticated uid 134 | Nothing -> Authenticated <$> insert User 135 | { userIdent = credsIdent creds 136 | , userPassword = Nothing 137 | } 138 | 139 | -- You can add other plugins like Google Email, email or OAuth here 140 | authPlugins _ = [authOpenId Claimed []] 141 | 142 | authHttpManager = fmap getHttpManager getYesod 143 | 144 | instance YesodAuthPersist App 145 | 146 | -- This instance is required to use forms. You can modify renderMessage to 147 | -- achieve customized and internationalized form validation messages. 148 | instance RenderMessage App FormMessage where 149 | renderMessage _ _ = defaultFormMessage 150 | 151 | -- Useful when writing code that is re-usable outside of the Handler context. 152 | -- An example is background jobs that send email. 153 | -- This can also be useful for writing code that works across multiple Yesod applications. 154 | instance HasHttpManager App where 155 | getHttpManager = appHttpManager 156 | 157 | unsafeHandler :: App -> Handler a -> IO a 158 | unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger 159 | 160 | -- Note: Some functionality previously present in the scaffolding has been 161 | -- moved to documentation in the Wiki. Following are some hopefully helpful 162 | -- links: 163 | -- 164 | -- https://github.com/yesodweb/yesod/wiki/Sending-email 165 | -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain 166 | -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding 167 | -------------------------------------------------------------------------------- /Handler/Comment.hs: -------------------------------------------------------------------------------- 1 | module Handler.Comment where 2 | 3 | import Import 4 | import Resolve 5 | 6 | postCommentR :: Handler Value 7 | postCommentR = do 8 | -- requireJsonBody will parse the request body into the appropriate type, or return a 400 status code if the request JSON is invalid. 9 | -- (The ToJSON and FromJSON instances are derived in the config/models file). 10 | comment <- (requireJsonBody :: Handler Comment) 11 | 12 | -- The YesodAuth instance in Foundation.hs defines the UserId to be the type used for authentication. 13 | maybeCurrentUserId <- maybeAuthId 14 | let comment' = comment { commentUserId = maybeCurrentUserId } 15 | 16 | insertedComment <- runDB $ insertEntity comment' 17 | returnJson insertedComment 18 | -------------------------------------------------------------------------------- /Handler/Common.hs: -------------------------------------------------------------------------------- 1 | -- | Common handler functions. 2 | module Handler.Common where 3 | 4 | import Data.FileEmbed (embedFile) 5 | import Resolve 6 | import Import 7 | 8 | -- These handlers embed files in the executable at compile time to avoid a 9 | -- runtime dependency, and for efficiency. 10 | 11 | getFaviconR :: Handler TypedContent 12 | getFaviconR = do cacheSeconds $ 60 * 60 * 24 * 30 -- cache for a month 13 | return $ TypedContent "image/x-icon" 14 | $ toContent $(embedFile "config/favicon.ico") 15 | 16 | getRobotsR :: Handler TypedContent 17 | getRobotsR = return $ TypedContent typePlain 18 | $ toContent $(embedFile "config/robots.txt") 19 | -------------------------------------------------------------------------------- /Handler/Home.hs: -------------------------------------------------------------------------------- 1 | module Handler.Home where 2 | 3 | import Import 4 | import Resolve 5 | 6 | -- This is a handler function for the GET request method on the HomeR 7 | -- resource pattern. All of your resource patterns are defined in 8 | -- config/routes 9 | -- 10 | -- The majority of the code you will write in Yesod lives in these handler 11 | -- functions. You can spread them across multiple files if you are so 12 | -- inclined, or create a single monolithic file. 13 | getHomeR :: Handler Html 14 | getHomeR = do 15 | defaultLayout $ do 16 | setTitle "Welcome To Yesod!" 17 | addScript $ StaticR builds_bundle_js 18 | $(widgetFile "homepage") 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /Import.hs: -------------------------------------------------------------------------------- 1 | module Import 2 | ( module Import 3 | ) where 4 | 5 | import Foundation as Import 6 | import Import.NoFoundation as Import 7 | -------------------------------------------------------------------------------- /Import/NoFoundation.hs: -------------------------------------------------------------------------------- 1 | module Import.NoFoundation 2 | ( module Import 3 | ) where 4 | 5 | import ClassyPrelude.Yesod as Import 6 | import Model as Import 7 | import Settings as Import 8 | import Settings.StaticFiles as Import 9 | import Yesod.Auth as Import 10 | import Yesod.Core.Types as Import (loggerSet) 11 | import Yesod.Default.Config2 as Import 12 | -------------------------------------------------------------------------------- /Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE DerivingStrategies #-} 3 | {-# LANGUAGE StandaloneDeriving #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | {-# LANGUAGE DataKinds #-} 6 | 7 | module Model where 8 | 9 | import ClassyPrelude.Yesod 10 | import Database.Persist.Quasi 11 | 12 | -- You can define all of your database entities in the entities file. 13 | -- You can find more information on persistent and how to declare entities 14 | -- at: 15 | -- http://www.yesodweb.com/book/persistent/ 16 | share [mkPersist sqlSettings, mkMigrate "migrateAll"] 17 | $(persistFileWith lowerCaseSettings "config/models") 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | yesod-rest 2 | ----------- 3 | 4 | A Yesod scaffolding site with Postgres backend. It provides a JSON API 5 | backend as a 6 | [separate subsite](http://www.yesodweb.com/book/creating-a-subsite). The 7 | primary purpose of this repository is to use Yesod as a API server 8 | backend and do the frontend development using a tool like React or 9 | Angular. The current code includes a basic hello world using 10 | [React](https://facebook.github.io/react/) and 11 | [Babel](https://babeljs.io/) which is bundled finally by 12 | [webpack](https://webpack.github.io/) and added in the handler 13 | `getHomeR` in a type safe manner. 14 | 15 | # Features 16 | 17 | 1. Provides an API server. 18 | 2. Boilerplate for writing frontend code using React Javascript 19 | ecosystem is provided. (can be easily adapted to other tools like 20 | Angular, etc.) 21 | 3. Brings all the advantage of Yesod - type safe urls, simple DSL for 22 | routes etc. 23 | 24 | # Setup and Execution steps 25 | 26 | 1. Install [Stack](https://docs.haskellstack.org/en/stable/install_and_upgrade/). 27 | 2. sudo apt-get install libpq-dev postgresql postgresql-contrib (For Debian based systems) 28 | 3. cd yesod-rest 29 | 4. stack build yesod-bin cabal-install --install-ghc 30 | 5. cd static && npm install 31 | 6. npm run webpack 32 | 7. stack build 33 | 8. stack exec -- yesod devel (Runs development server) 34 | 9. (Or) stack exec yesod-rest 35 | 36 | # Adding a API Route 37 | 38 | Add the route to `config/apiRoutes` file and define your corresponding 39 | handler function in `API.hs`. 40 | 41 | # Demo: 42 | 43 | You can see the [rest.hurl](./rest.hurl) 44 | 45 | # FAQ 46 | 47 | * I see this error on `stack exec yesod-rest`: 48 | 49 | ``` text 50 | yesod-rest: libpq: failed (could not connect to server: Connection refused 51 | Is the server running on host "localhost" (127.0.0.1) and accepting 52 | TCP/IP connections on port 5432?) 53 | ``` 54 | 55 | You most likely haven't installed the postgres server. For Ubuntu systems, it can be done by: 56 | 57 | `sudo apt-get install postgresql postgresql-contrib` 58 | 59 | * I see this error on `stack exec yesod-rest`: 60 | 61 | ``` text 62 | yesod-rest: libpq: failed (FATAL: password authentication failed for user "postgres" 63 | FATAL: password authentication failed for user "postgres") 64 | ``` 65 | 66 | [See this.](http://stackoverflow.com/a/7696398/1651941) 67 | 68 | * I see this error on `stack exec yesod-rest`: 69 | 70 | ``` text 71 | yesod-rest: libpq: failed (FATAL: database "test" does not exist) 72 | ``` 73 | 74 | Create a database named `test` on your postgres server. 75 | 76 | * The `webpack` program is automatically getting closed. 77 | 78 | Try running this command: 79 | 80 | ``` shell 81 | echo fs.inotify.max_user_watches=524288 | sudo tee -a /etc/sysctl.conf && sudo sysctl -p 82 | ``` 83 | -------------------------------------------------------------------------------- /Resolve.hs: -------------------------------------------------------------------------------- 1 | module Resolve where 2 | 3 | import Api.Data 4 | import Yesod.Core.Types (Logger) 5 | import Database.Persist.Sql (ConnectionPool) 6 | import Settings (AppSettings) 7 | import ClassyPrelude.Yesod -- (Static, Manager, encodeUtf8, Text) 8 | import Yesod.Auth 9 | 10 | -- | The foundation datatype for your application. This can be a good place to 11 | -- keep settings and values requiring initialization before your application 12 | -- starts running, such as database connections. Every handler will have 13 | -- access to the data present here. 14 | data App = App 15 | { appSettings :: AppSettings 16 | , appStatic :: Static -- ^ Settings for static file serving. 17 | , appConnPool :: ConnectionPool -- ^ Database connection pool. 18 | , appHttpManager :: Manager 19 | , appLogger :: Logger 20 | , getApiSub :: ApiSub -- ^ API sub site 21 | } 22 | 23 | -- This is where we define all of the routes in our application. For a full 24 | -- explanation of the syntax, please see: 25 | -- http://www.yesodweb.com/book/routing-and-handlers 26 | -- 27 | -- Note that this is really half the story; in Application.hs, mkYesodDispatch 28 | -- generates the rest of the code. Please see the following documentation 29 | -- for an explanation for this split: 30 | -- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules 31 | -- 32 | -- This function also generates the following type synonyms: 33 | -- type Handler = HandlerT App IO 34 | -- type Widget = WidgetT App IO () 35 | mkYesodData "App" $(parseRoutesFile "config/routes") 36 | -------------------------------------------------------------------------------- /Settings.hs: -------------------------------------------------------------------------------- 1 | {-# Language CPP #-} 2 | -- | Settings are centralized, as much as possible, into this file. This 3 | -- includes database connection settings, static file locations, etc. 4 | -- In addition, you can configure a number of different aspects of Yesod 5 | -- by overriding methods in the Yesod typeclass. That instance is 6 | -- declared in the Foundation.hs file. 7 | module Settings where 8 | 9 | import ClassyPrelude.Yesod hiding (throw) 10 | import Control.Exception (throw) 11 | import Data.Aeson (Result (..), fromJSON, withObject, (.!=), 12 | (.:?)) 13 | import Data.FileEmbed (embedFile) 14 | import Data.Yaml (decodeEither') 15 | import Database.Persist.Postgresql (PostgresConf) 16 | import Language.Haskell.TH.Syntax (Exp, Name, Q) 17 | import Network.Wai.Handler.Warp (HostPreference) 18 | import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) 19 | import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, 20 | widgetFileReload) 21 | 22 | -- | Runtime settings to configure this application. These settings can be 23 | -- loaded from various sources: defaults, environment variables, config files, 24 | -- theoretically even a database. 25 | data AppSettings = AppSettings 26 | { appStaticDir :: String 27 | -- ^ Directory from which to serve static files. 28 | , appDatabaseConf :: PostgresConf 29 | -- ^ Configuration settings for accessing the database. 30 | , appRoot :: Maybe Text 31 | -- ^ Base for all generated URLs. If @Nothing@, determined 32 | -- from the request headers. 33 | , appHost :: HostPreference 34 | -- ^ Host/interface the server should bind to. 35 | , appPort :: Int 36 | -- ^ Port to listen on 37 | , appIpFromHeader :: Bool 38 | -- ^ Get the IP address from the header when logging. Useful when sitting 39 | -- behind a reverse proxy. 40 | 41 | , appDetailedRequestLogging :: Bool 42 | -- ^ Use detailed request logging system 43 | , appShouldLogAll :: Bool 44 | -- ^ Should all log messages be displayed? 45 | , appReloadTemplates :: Bool 46 | -- ^ Use the reload version of templates 47 | , appMutableStatic :: Bool 48 | -- ^ Assume that files in the static dir may change after compilation 49 | , appSkipCombining :: Bool 50 | -- ^ Perform no stylesheet/script combining 51 | 52 | -- Example app-specific configuration values. 53 | , appCopyright :: Text 54 | -- ^ Copyright text to appear in the footer of the page 55 | , appAnalytics :: Maybe Text 56 | -- ^ Google Analytics code 57 | } 58 | 59 | instance FromJSON AppSettings where 60 | parseJSON = withObject "AppSettings" $ \o -> do 61 | let defaultDev = 62 | #if DEVELOPMENT 63 | True 64 | #else 65 | False 66 | #endif 67 | appStaticDir <- o .: "static-dir" 68 | appDatabaseConf <- o .: "database" 69 | appRoot <- o .:? "approot" 70 | appHost <- fromString <$> o .: "host" 71 | appPort <- o .: "port" 72 | appIpFromHeader <- o .: "ip-from-header" 73 | 74 | appDetailedRequestLogging <- o .:? "detailed-logging" .!= defaultDev 75 | appShouldLogAll <- o .:? "should-log-all" .!= defaultDev 76 | appReloadTemplates <- o .:? "reload-templates" .!= defaultDev 77 | appMutableStatic <- o .:? "mutable-static" .!= defaultDev 78 | appSkipCombining <- o .:? "skip-combining" .!= defaultDev 79 | 80 | appCopyright <- o .: "copyright" 81 | appAnalytics <- o .:? "analytics" 82 | 83 | return AppSettings {..} 84 | 85 | -- | Settings for 'widgetFile', such as which template languages to support and 86 | -- default Hamlet settings. 87 | -- 88 | -- For more information on modifying behavior, see: 89 | -- 90 | -- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile 91 | widgetFileSettings :: WidgetFileSettings 92 | widgetFileSettings = def 93 | 94 | -- | How static files should be combined. 95 | combineSettings :: CombineSettings 96 | combineSettings = def 97 | 98 | -- The rest of this file contains settings which rarely need changing by a 99 | -- user. 100 | 101 | widgetFile :: String -> Q Exp 102 | widgetFile = (if appReloadTemplates compileTimeAppSettings 103 | then widgetFileReload 104 | else widgetFileNoReload) 105 | widgetFileSettings 106 | 107 | -- | Raw bytes at compile time of @config/settings.yml@ 108 | configSettingsYmlBS :: ByteString 109 | configSettingsYmlBS = $(embedFile configSettingsYml) 110 | 111 | -- | @config/settings.yml@, parsed to a @Value@. 112 | configSettingsYmlValue :: Value 113 | configSettingsYmlValue = either throw id $ decodeEither' configSettingsYmlBS 114 | 115 | -- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@. 116 | compileTimeAppSettings :: AppSettings 117 | compileTimeAppSettings = 118 | case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of 119 | Error e -> error e 120 | Success settings -> settings 121 | 122 | -- The following two functions can be used to combine multiple CSS or JS files 123 | -- at compile time to decrease the number of http requests. 124 | -- Sample usage (inside a Widget): 125 | -- 126 | -- > $(combineStylesheets 'StaticR [style1_css, style2_css]) 127 | 128 | combineStylesheets :: Name -> [Route Static] -> Q Exp 129 | combineStylesheets = combineStylesheets' 130 | (appSkipCombining compileTimeAppSettings) 131 | combineSettings 132 | 133 | combineScripts :: Name -> [Route Static] -> Q Exp 134 | combineScripts = combineScripts' 135 | (appSkipCombining compileTimeAppSettings) 136 | combineSettings 137 | -------------------------------------------------------------------------------- /Settings/StaticFiles.hs: -------------------------------------------------------------------------------- 1 | module Settings.StaticFiles where 2 | 3 | import Yesod.Static (staticFilesList) 4 | 5 | -- This generates easy references to files in the static directory at compile time, 6 | -- giving you compile-time verification that referenced files exist. 7 | -- Warning: any files added to your static directory during run-time can't be 8 | -- accessed this way. You'll have to use their FilePath or URL to access them. 9 | -- 10 | -- For example, to refer to @static/js/script.js@ via an identifier, you'd use: 11 | -- 12 | -- js_script_js 13 | -- 14 | -- If the identifier is not available, you may use: 15 | -- 16 | -- StaticFile ["js", "script.js"] [] 17 | 18 | -- Uncomment if you want to create routes for all of your static files 19 | --staticFiles (appStaticDir compileTimeAppSettings) 20 | 21 | staticFilesList "static" ["css/bootstrap.css", "builds/bundle.js"] 22 | -------------------------------------------------------------------------------- /app/DevelMain.hs: -------------------------------------------------------------------------------- 1 | -- | Running your app inside GHCi. 2 | -- 3 | -- To start up GHCi for usage with Yesod, first make sure you are in dev mode: 4 | -- 5 | -- > cabal configure -fdev 6 | -- 7 | -- Note that @yesod devel@ automatically sets the dev flag. 8 | -- Now launch the repl: 9 | -- 10 | -- > cabal repl --ghc-options="-O0 -fobject-code" 11 | -- 12 | -- To start your app, run: 13 | -- 14 | -- > :l DevelMain 15 | -- > DevelMain.update 16 | -- 17 | -- You can also call @DevelMain.shutdown@ to stop the app 18 | -- 19 | -- You will need to add the foreign-store package to your .cabal file. 20 | -- It is very light-weight. 21 | -- 22 | -- If you don't use cabal repl, you will need 23 | -- to run the following in GHCi or to add it to 24 | -- your .ghci file. 25 | -- 26 | -- :set -DDEVELOPMENT 27 | -- 28 | -- There is more information about this approach, 29 | -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci 30 | 31 | module DevelMain where 32 | 33 | import Prelude 34 | import Application (getApplicationRepl, shutdownApp) 35 | 36 | import Control.Exception (finally) 37 | import Control.Monad ((>=>)) 38 | import Control.Concurrent 39 | import Data.IORef 40 | import Foreign.Store 41 | import Network.Wai.Handler.Warp 42 | import GHC.Word 43 | 44 | -- | Start or restart the server. 45 | -- newStore is from foreign-store. 46 | -- A Store holds onto some data across ghci reloads 47 | update :: IO () 48 | update = do 49 | mtidStore <- lookupStore tidStoreNum 50 | case mtidStore of 51 | -- no server running 52 | Nothing -> do 53 | done <- storeAction doneStore newEmptyMVar 54 | tid <- start done 55 | _ <- storeAction (Store tidStoreNum) (newIORef tid) 56 | return () 57 | -- server is already running 58 | Just tidStore -> restartAppInNewThread tidStore 59 | where 60 | doneStore :: Store (MVar ()) 61 | doneStore = Store 0 62 | 63 | -- shut the server down with killThread and wait for the done signal 64 | restartAppInNewThread :: Store (IORef ThreadId) -> IO () 65 | restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do 66 | killThread tid 67 | withStore doneStore takeMVar 68 | readStore doneStore >>= start 69 | 70 | 71 | -- | Start the server in a separate thread. 72 | start :: MVar () -- ^ Written to when the thread is killed. 73 | -> IO ThreadId 74 | start done = do 75 | (port, site, app) <- getApplicationRepl 76 | forkIO (finally (runSettings (setPort port defaultSettings) app) 77 | -- Note that this implies concurrency 78 | -- between shutdownApp and the next app that is starting. 79 | -- Normally this should be fine 80 | (putMVar done () >> shutdownApp site)) 81 | 82 | -- | kill the server 83 | shutdown :: IO () 84 | shutdown = do 85 | mtidStore <- lookupStore tidStoreNum 86 | case mtidStore of 87 | -- no server running 88 | Nothing -> putStrLn "no Yesod app running" 89 | Just tidStore -> do 90 | withStore tidStore $ readIORef >=> killThread 91 | putStrLn "Yesod app is shutdown" 92 | 93 | tidStoreNum :: Word32 94 | tidStoreNum = 1 95 | 96 | modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () 97 | modifyStoredIORef store f = withStore store $ \ref -> do 98 | v <- readIORef ref 99 | f v >>= writeIORef ref 100 | -------------------------------------------------------------------------------- /app/devel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PackageImports #-} 2 | import "yesod-rest" Application (develMain) 3 | import Prelude (IO) 4 | 5 | main :: IO () 6 | main = develMain 7 | -------------------------------------------------------------------------------- /app/main.hs: -------------------------------------------------------------------------------- 1 | import Prelude (IO) 2 | import Application (appMain) 3 | 4 | main :: IO () 5 | main = appMain 6 | -------------------------------------------------------------------------------- /config/apiRoutes: -------------------------------------------------------------------------------- 1 | /user UserR GET POST 2 | /user/#Text UserPasswordR PATCH 3 | -------------------------------------------------------------------------------- /config/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/psibi/yesod-rest/aa319766be3f4f35c7bc1a4c438b129e412ddb20/config/favicon.ico -------------------------------------------------------------------------------- /config/keter.yml: -------------------------------------------------------------------------------- 1 | # After you've edited this file, remove the following line to allow 2 | # `yesod keter` to build your bundle. 3 | user-edited: false 4 | 5 | # A Keter app is composed of 1 or more stanzas. The main stanza will define our 6 | # web application. See the Keter documentation for more information on 7 | # available stanzas. 8 | stanzas: 9 | 10 | # Your Yesod application. 11 | - type: webapp 12 | 13 | # Name of your executable. You are unlikely to need to change this. 14 | # Note that all file paths are relative to the keter.yml file. 15 | # 16 | # The path given is for Stack projects. If you're still using cabal, change 17 | # to 18 | # exec: ../dist/build/yesod-rest/yesod-rest 19 | exec: ../dist/bin/yesod-rest 20 | 21 | # Command line options passed to your application. 22 | args: [] 23 | 24 | hosts: 25 | # You can specify one or more hostnames for your application to respond 26 | # to. The primary hostname will be used for generating your application 27 | # root. 28 | - www.yesod-rest.com 29 | 30 | # Enable to force Keter to redirect to https 31 | # Can be added to any stanza 32 | requires-secure: false 33 | 34 | # Static files. 35 | - type: static-files 36 | hosts: 37 | - static.yesod-rest.com 38 | root: ../static 39 | 40 | # Uncomment to turn on directory listings. 41 | # directory-listing: true 42 | 43 | # Redirect plain domain name to www. 44 | - type: redirect 45 | 46 | hosts: 47 | - yesod-rest.com 48 | actions: 49 | - host: www.yesod-rest.com 50 | # secure: false 51 | # port: 80 52 | 53 | # Uncomment to switch to a non-permanent redirect. 54 | # status: 303 55 | 56 | # Use the following to automatically copy your bundle upon creation via `yesod 57 | # keter`. Uses `scp` internally, so you can set it to a remote destination 58 | # copy-to: user@host:/opt/keter/incoming/ 59 | 60 | # You can pass arguments to `scp` used above. This example limits bandwidth to 61 | # 1024 Kbit/s and uses port 2222 instead of the default 22 62 | # copy-to-args: 63 | # - "-l 1024" 64 | # - "-P 2222" 65 | 66 | # If you would like to have Keter automatically create a PostgreSQL database 67 | # and set appropriate environment variables for it to be discovered, uncomment 68 | # the following line. 69 | # plugins: 70 | # postgres: true 71 | -------------------------------------------------------------------------------- /config/models: -------------------------------------------------------------------------------- 1 | User json 2 | ident Text 3 | password Text Maybe 4 | UniqueUser ident 5 | deriving Typeable 6 | Email 7 | email Text 8 | userId UserId Maybe 9 | verkey Text Maybe 10 | UniqueEmail email 11 | Comment json -- Adding "json" causes ToJSON and FromJSON instances to be derived. 12 | message Text 13 | userId UserId Maybe 14 | deriving Eq 15 | deriving Show 16 | 17 | -- By default this file is used in Model.hs (which is imported by Foundation.hs) 18 | -------------------------------------------------------------------------------- /config/robots.txt: -------------------------------------------------------------------------------- 1 | User-agent: * 2 | -------------------------------------------------------------------------------- /config/routes: -------------------------------------------------------------------------------- 1 | /static StaticR Static appStatic 2 | /auth AuthR Auth getAuth 3 | 4 | /favicon.ico FaviconR GET 5 | /robots.txt RobotsR GET 6 | 7 | / HomeR GET 8 | /api/v1 ApisiteR ApiSub getApiSub 9 | /comments CommentR POST 10 | -------------------------------------------------------------------------------- /config/settings.yml: -------------------------------------------------------------------------------- 1 | # Values formatted like "_env:ENV_VAR_NAME:default_value" can be overridden by the specified environment variable. 2 | # See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables 3 | 4 | static-dir: "_env:STATIC_DIR:static" 5 | host: "_env:HOST:*4" # any IPv4 host 6 | port: "_env:PORT:9000" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line. 7 | ip-from-header: "_env:IP_FROM_HEADER:false" 8 | 9 | # Default behavior: determine the application root from the request headers. 10 | # Uncomment to set an explicit approot 11 | #approot: "_env:APPROOT:http://localhost:3000" 12 | 13 | # Optional values with the following production defaults. 14 | # In development, they default to the inverse. 15 | # 16 | # development: false 17 | # detailed-logging: false 18 | # should-log-all: false 19 | # reload-templates: false 20 | # mutable-static: false 21 | # skip-combining: false 22 | 23 | # NB: If you need a numeric value (e.g. 123) to parse as a String, wrap it in single quotes (e.g. "_env:PGPASS:'123'") 24 | # See https://github.com/yesodweb/yesod/wiki/Configuration#parsing-numeric-values-as-strings 25 | 26 | database: 27 | user: "_env:PGUSER:postgres" 28 | password: "_env:PGPASS:postgres" 29 | host: "_env:PGHOST:localhost" 30 | port: "_env:PGPORT:5432" 31 | # See config/test-settings.yml for an override during tests 32 | database: "_env:PGDATABASE:test" 33 | poolsize: "_env:PGPOOLSIZE:10" 34 | 35 | copyright: Insert copyright statement here 36 | #analytics: UA-YOURCODE 37 | -------------------------------------------------------------------------------- /config/test-settings.yml: -------------------------------------------------------------------------------- 1 | database: 2 | # NOTE: By design, this setting prevents the PGDATABASE environment variable 3 | # from affecting test runs, so that we don't accidentally affect the 4 | # production database during testing. If you're not concerned about that and 5 | # would like to have environment variable overrides, you could instead use 6 | # something like: 7 | # 8 | # database: "_env:PGDATABASE:yesod-rest_LOWER_test" 9 | database: yesod-rest_LOWER_test 10 | -------------------------------------------------------------------------------- /justfile: -------------------------------------------------------------------------------- 1 | # List all recipes 2 | default: 3 | just --list --unsorted 4 | 5 | # Build 6 | build: 7 | stack build --fast 8 | 9 | # Run postgres via docker 10 | postgres: 11 | docker run --name yesod-rest --net=host --rm -it -e POSTGRES_PASSWORD=postgres -p 5432:5432 postgres:15.3-alpine -c log_statement=all 12 | 13 | # psql to docker 14 | psql: 15 | psql -U postgres -h localhost 16 | 17 | # Shutdown postgres 18 | postgres-down: 19 | docker container stop yesod-rest 20 | 21 | # Serve 22 | serve: 23 | stack run 24 | 25 | # Hurl tests 26 | hurl: 27 | hurl --test rest.hurl 28 | -------------------------------------------------------------------------------- /rest.hurl: -------------------------------------------------------------------------------- 1 | GET http://localhost:9000 2 | HTTP 200 3 | 4 | GET http://localhost:9000/api/v1/user 5 | HTTP 200 6 | [Asserts] 7 | status == 200 8 | jsonpath "$.name" contains "Sibi" 9 | 10 | POST http://localhost:9000/api/v1/user 11 | Content-Type: application/json 12 | Accept: application/json 13 | { 14 | "ident": "Sibi Prabakaran", 15 | "password": "strongPassword" 16 | } 17 | HTTP 200 18 | [Asserts] 19 | status == 200 20 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-22.27 2 | 3 | packages: 4 | - '.' 5 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: bc144ddf301a5c99f2cf51c7de50279ba144fd4486cb3c66f87ed761d6bbf6e9 10 | size: 719131 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/27.yaml 12 | original: lts-22.27 13 | -------------------------------------------------------------------------------- /static/.babelrc: -------------------------------------------------------------------------------- 1 | { 2 | presets: ["es2015", "react", "stage-0"] 3 | } 4 | -------------------------------------------------------------------------------- /static/.eslintrc: -------------------------------------------------------------------------------- 1 | { 2 | "extends": "eslint-config-airbnb", 3 | "env": { 4 | "browser": true 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /static/app/jsx/home.jsx: -------------------------------------------------------------------------------- 1 | import React from 'react'; 2 | import { render } from 'react-dom'; 3 | 4 | const HelloWorld = () => (
Hello world
); 5 | 6 | const app = document.getElementById('app'); 7 | render(, app); 8 | -------------------------------------------------------------------------------- /static/fonts/glyphicons-halflings-regular.eot: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/psibi/yesod-rest/aa319766be3f4f35c7bc1a4c438b129e412ddb20/static/fonts/glyphicons-halflings-regular.eot -------------------------------------------------------------------------------- /static/fonts/glyphicons-halflings-regular.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | -------------------------------------------------------------------------------- /static/fonts/glyphicons-halflings-regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/psibi/yesod-rest/aa319766be3f4f35c7bc1a4c438b129e412ddb20/static/fonts/glyphicons-halflings-regular.ttf -------------------------------------------------------------------------------- /static/fonts/glyphicons-halflings-regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/psibi/yesod-rest/aa319766be3f4f35c7bc1a4c438b129e412ddb20/static/fonts/glyphicons-halflings-regular.woff -------------------------------------------------------------------------------- /static/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "yesod-rest", 3 | "version": "1.0.0", 4 | "description": "A yesod REST template", 5 | "main": "index.js", 6 | "scripts": { 7 | "test": "echo \"Error: no test specified\" && exit 1", 8 | "webpack": "webpack -w", 9 | "lint": "eslint ./app --ext .js,.jsx" 10 | }, 11 | "repository": { 12 | "type": "git", 13 | "url": "git+ssh://git@github.com/psibi/yesod-rest.git" 14 | }, 15 | "keywords": [ 16 | "yesod", 17 | "react", 18 | "REST" 19 | ], 20 | "author": "Sibi", 21 | "license": "BSD-3-Clause", 22 | "bugs": { 23 | "url": "https://github.com/psibi/yesod-rest/issues" 24 | }, 25 | "homepage": "https://github.com/psibi/yesod-rest#readme", 26 | "dependencies": { 27 | "react": "^15.3.1", 28 | "react-dom": "^15.3.1" 29 | }, 30 | "devDependencies": { 31 | "babel-cli": "^6.11.4", 32 | "babel-core": "^6.13.2", 33 | "babel-eslint": "^6.1.2", 34 | "babel-loader": "^6.2.5", 35 | "babel-preset-es2015": "^6.13.2", 36 | "babel-preset-react": "^6.11.1", 37 | "babel-preset-stage-0": "^6.5.0", 38 | "eslint": "^3.5.0", 39 | "eslint-config-airbnb": "^11.1.0", 40 | "eslint-plugin-import": "^1.15.0", 41 | "eslint-plugin-jsx-a11y": "^2.2.2", 42 | "eslint-plugin-react": "^6.2.2", 43 | "webpack": "^1.13.2" 44 | } 45 | } 46 | -------------------------------------------------------------------------------- /static/webpack.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | entry: { 3 | home: './app/jsx/home.jsx' 4 | }, 5 | output: { 6 | path: 'builds', 7 | filename: "bundle.js" 8 | }, 9 | module: { 10 | loaders: [ 11 | { 12 | test: /\.jsx?$/, 13 | exclude: /(node_modules|bower_components)/, 14 | loader: 'babel', 15 | query: { 16 | presets: ['es2015', 'react', 'stage-0'] 17 | } 18 | } 19 | ] 20 | } 21 | }; 22 | -------------------------------------------------------------------------------- /templates/default-layout-wrapper.hamlet: -------------------------------------------------------------------------------- 1 | $newline never 2 | \ 3 | \ 4 | \ 5 | \ 6 | \ 7 | 8 | 9 | 10 | 11 | #{pageTitle pc} 12 | <meta name="description" content=""> 13 | <meta name="author" content=""> 14 | 15 | <meta name="viewport" content="width=device-width,initial-scale=1"> 16 | 17 | ^{pageHead pc} 18 | 19 | \<!--[if lt IE 9]> 20 | \<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script> 21 | \<![endif]--> 22 | <script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/jquery/2.1.4/jquery.js"> 23 | <script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/js-cookie/2.0.3/js.cookie.min.js"> 24 | 25 | <script> 26 | /* The `defaultCsrfMiddleware` Middleware added in Foundation.hs adds a CSRF token the request cookies. */ 27 | /* AJAX requests should add that token to a header to be validated by the server. */ 28 | /* See the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package for details. */ 29 | var csrfHeaderName = "#{TE.decodeUtf8 $ CI.foldedCase defaultCsrfHeaderName}"; 30 | 31 | var csrfCookieName = "#{TE.decodeUtf8 defaultCsrfCookieName}"; 32 | var csrfToken = Cookies.get(csrfCookieName); 33 | 34 | 35 | if (csrfToken) { 36 | \ $.ajaxPrefilter(function( options, originalOptions, jqXHR ) { 37 | \ if (!options.crossDomain) { 38 | \ jqXHR.setRequestHeader(csrfHeaderName, csrfToken); 39 | \ } 40 | \ }); 41 | } 42 | 43 | <script> 44 | document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js'); 45 | <body> 46 | <div class="container"> 47 | <header> 48 | <div id="main" role="main"> 49 | ^{pageBody pc} 50 | <footer> 51 | #{appCopyright $ appSettings master} 52 | 53 | $maybe analytics <- appAnalytics $ appSettings master 54 | <script> 55 | if(!window.location.href.match(/localhost/)){ 56 | window._gaq = [['_setAccount','#{analytics}'],['_trackPageview'],['_trackPageLoadTime']]; 57 | (function() { 58 | \ var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true; 59 | \ ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js'; 60 | \ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s); 61 | })(); 62 | } 63 | -------------------------------------------------------------------------------- /templates/default-layout.hamlet: -------------------------------------------------------------------------------- 1 | $maybe msg <- mmsg 2 | <div #message>#{msg} 3 | ^{widget} 4 | -------------------------------------------------------------------------------- /templates/homepage.hamlet: -------------------------------------------------------------------------------- 1 | <h1.jumbotron> 2 | Welcome to Yesod! 3 | 4 | <div #app> 5 | 6 | -------------------------------------------------------------------------------- /templates/homepage.julius: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/psibi/yesod-rest/aa319766be3f4f35c7bc1a4c438b129e412ddb20/templates/homepage.julius -------------------------------------------------------------------------------- /templates/homepage.lucius: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/psibi/yesod-rest/aa319766be3f4f35c7bc1a4c438b129e412ddb20/templates/homepage.lucius -------------------------------------------------------------------------------- /test/Handler/CommentSpec.hs: -------------------------------------------------------------------------------- 1 | module Handler.CommentSpec (spec) where 2 | 3 | import TestImport 4 | import Resolve 5 | import Data.Aeson 6 | 7 | spec :: Spec 8 | spec = withApp $ do 9 | describe "valid request" $ do 10 | it "gives a 200" $ do 11 | get HomeR 12 | statusIs 200 13 | 14 | let message = "My message" :: Text 15 | body = object [ "message" .= message ] 16 | encoded = encode body 17 | 18 | request $ do 19 | setMethod "POST" 20 | setUrl CommentR 21 | setRequestBody encoded 22 | addRequestHeader ("Content-Type", "application/json") 23 | 24 | statusIs 200 25 | 26 | [Entity _id comment] <- runDB $ selectList [CommentMessage ==. message] [] 27 | assertEq "Should have " comment (Comment message Nothing) 28 | 29 | describe "invalid requests" $ do 30 | it "400s when the JSON body is invalid" $ do 31 | get HomeR 32 | 33 | let body = object [ "foo" .= ("My message" :: Value) ] 34 | 35 | request $ do 36 | setMethod "POST" 37 | setUrl CommentR 38 | setRequestBody $ encode body 39 | addRequestHeader ("Content-Type", "application/json") 40 | 41 | statusIs 400 42 | 43 | -------------------------------------------------------------------------------- /test/Handler/CommonSpec.hs: -------------------------------------------------------------------------------- 1 | module Handler.CommonSpec (spec) where 2 | 3 | import TestImport 4 | import Resolve 5 | 6 | spec :: Spec 7 | spec = withApp $ do 8 | describe "robots.txt" $ do 9 | it "gives a 200" $ do 10 | get RobotsR 11 | statusIs 200 12 | it "has correct User-agent" $ do 13 | get RobotsR 14 | bodyContains "User-agent: *" 15 | describe "favicon.ico" $ do 16 | it "gives a 200" $ do 17 | get FaviconR 18 | statusIs 200 19 | -------------------------------------------------------------------------------- /test/Handler/HomeSpec.hs: -------------------------------------------------------------------------------- 1 | module Handler.HomeSpec (spec) where 2 | 3 | import TestImport 4 | import Resolve 5 | 6 | spec :: Spec 7 | spec = withApp $ do 8 | -- This is a simple example of using a database access in a test. The 9 | -- test will succeed for a fresh scaffolded site with an empty database, 10 | -- but will fail on an existing database with a non-empty user table. 11 | it "leaves the user table empty" $ do 12 | get HomeR 13 | statusIs 200 14 | users <- runDB $ selectList ([] :: [Filter User]) [] 15 | assertEq "user table empty" 0 $ length users 16 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /test/TestImport.hs: -------------------------------------------------------------------------------- 1 | module TestImport 2 | ( module TestImport 3 | , module X 4 | ) where 5 | 6 | import Application (makeFoundation, makeLogWare) 7 | import ClassyPrelude as X hiding (delete, deleteBy) 8 | import Database.Persist as X hiding (get) 9 | import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName) 10 | import Foundation as X 11 | import Model as X 12 | import Test.Hspec as X 13 | import Text.Shakespeare.Text (st) 14 | import Yesod.Default.Config2 (ignoreEnv, loadYamlSettings) 15 | import Yesod.Test as X 16 | import Resolve 17 | 18 | runDB :: SqlPersistM a -> YesodExample App a 19 | runDB query = do 20 | app <- getTestYesod 21 | liftIO $ runDBWithApp app query 22 | 23 | runDBWithApp :: App -> SqlPersistM a -> IO a 24 | runDBWithApp app query = runSqlPersistMPool query (appConnPool app) 25 | 26 | 27 | withApp :: SpecWith (TestApp App) -> Spec 28 | withApp = before $ do 29 | settings <- loadYamlSettings 30 | ["config/test-settings.yml", "config/settings.yml"] 31 | [] 32 | ignoreEnv 33 | foundation <- makeFoundation settings 34 | wipeDB foundation 35 | logWare <- liftIO $ makeLogWare foundation 36 | return (foundation, logWare) 37 | 38 | -- This function will truncate all of the tables in your database. 39 | -- 'withApp' calls it before each test, creating a clean environment for each 40 | -- spec to run in. 41 | wipeDB :: App -> IO () 42 | wipeDB app = runDBWithApp app $ do 43 | tables <- getTables 44 | sqlBackend <- ask 45 | 46 | let escapedTables = map (connEscapeName sqlBackend . DBName) tables 47 | query = "TRUNCATE TABLE " ++ intercalate ", " escapedTables 48 | rawExecute query [] 49 | 50 | getTables :: MonadIO m => ReaderT SqlBackend m [Text] 51 | getTables = do 52 | tables <- rawSql [st| 53 | SELECT table_name 54 | FROM information_schema.tables 55 | WHERE table_schema = 'public'; 56 | |] [] 57 | 58 | return $ map unSingle tables 59 | -------------------------------------------------------------------------------- /yesod-rest.cabal: -------------------------------------------------------------------------------- 1 | name: yesod-rest 2 | version: 0.0.0 3 | cabal-version: >= 1.8 4 | build-type: Simple 5 | 6 | Flag dev 7 | Description: Turn on development settings, like auto-reload templates. 8 | Default: False 9 | 10 | Flag library-only 11 | Description: Build for use with "yesod devel" 12 | Default: False 13 | 14 | library 15 | hs-source-dirs: ., app 16 | exposed-modules: Application 17 | Foundation 18 | Import 19 | Import.NoFoundation 20 | Model 21 | Resolve 22 | Api 23 | Api.Data 24 | Settings 25 | Settings.StaticFiles 26 | Handler.Common 27 | Handler.Home 28 | Handler.Comment 29 | 30 | if flag(dev) || flag(library-only) 31 | cpp-options: -DDEVELOPMENT 32 | ghc-options: -Wall -fwarn-tabs -O0 33 | else 34 | ghc-options: -Wall -fwarn-tabs -O2 35 | 36 | extensions: TemplateHaskell 37 | QuasiQuotes 38 | OverloadedStrings 39 | NoImplicitPrelude 40 | MultiParamTypeClasses 41 | TypeFamilies 42 | GADTs 43 | GeneralizedNewtypeDeriving 44 | FlexibleContexts 45 | FlexibleInstances 46 | EmptyDataDecls 47 | NoMonomorphismRestriction 48 | DeriveDataTypeable 49 | ViewPatterns 50 | TupleSections 51 | RecordWildCards 52 | 53 | build-depends: base 54 | , yesod 55 | , yesod-core 56 | , yesod-auth 57 | , yesod-static 58 | , yesod-form 59 | , classy-prelude 60 | , classy-prelude-conduit 61 | , classy-prelude-yesod 62 | , bytestring 63 | , text 64 | , persistent 65 | , persistent-postgresql 66 | , persistent-template 67 | , template-haskell 68 | , shakespeare 69 | , hjsmin 70 | , monad-control 71 | , wai-extra 72 | , yaml 73 | , http-conduit 74 | , directory 75 | , warp 76 | , data-default 77 | , aeson 78 | , conduit 79 | , monad-logger 80 | , fast-logger 81 | , wai-logger 82 | , file-embed 83 | , safe 84 | , unordered-containers 85 | , containers 86 | , vector 87 | , time 88 | , case-insensitive 89 | , wai 90 | 91 | executable yesod-rest 92 | if flag(library-only) 93 | Buildable: False 94 | 95 | main-is: main.hs 96 | hs-source-dirs: app 97 | build-depends: base, yesod-rest 98 | 99 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 100 | 101 | test-suite test 102 | type: exitcode-stdio-1.0 103 | main-is: Spec.hs 104 | other-modules: Handler.CommentSpec 105 | Handler.CommonSpec 106 | Handler.HomeSpec 107 | TestImport 108 | hs-source-dirs: test 109 | ghc-options: -Wall 110 | 111 | extensions: TemplateHaskell 112 | QuasiQuotes 113 | OverloadedStrings 114 | NoImplicitPrelude 115 | CPP 116 | MultiParamTypeClasses 117 | TypeFamilies 118 | GADTs 119 | GeneralizedNewtypeDeriving 120 | FlexibleContexts 121 | FlexibleInstances 122 | EmptyDataDecls 123 | NoMonomorphismRestriction 124 | DeriveDataTypeable 125 | ViewPatterns 126 | TupleSections 127 | 128 | build-depends: base 129 | , yesod-rest 130 | , yesod-test 131 | , yesod-core 132 | , yesod 133 | , persistent 134 | , persistent-postgresql 135 | , resourcet 136 | , monad-logger 137 | , shakespeare 138 | , transformers 139 | , hspec 140 | , classy-prelude 141 | , classy-prelude-yesod 142 | , aeson 143 | --------------------------------------------------------------------------------