packages feed

servant-stache (empty) → 0.1.0.0

raw patch · 7 files changed

+363/−0 lines, 7 filesdep +aesondep +basedep +http-mediasetup-changed

Dependencies added: aeson, base, http-media, servant, servant-server, servant-stache, stache, text, transformers, unordered-containers, vector, warp, xss-sanitize

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for servant-stache++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Tatsuya Hirose (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tatsuya Hirose nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,18 @@+# servant-stache+Content-Types and template management for rendering Mustache templates in servant Web applications. This package is heavily inspired by [servant-ede](http://hackage.haskell.org/package/servant-ede). Documentation and examples available at `Servant.Mustache`.++## Example++Example code is in `example` directory. You can run example as below.++```bash+$ git clone git@github.com:lotz84/servant-stache.git+$ cd servant-stache+$ stack build+$ stack exec example+```++And access <http://localhost:8080> on browser.++## Contribution+Feel free to send a PR or create a new issue.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++import GHC.Generics++import Data.Aeson+import Network.HTTP.Media ((//))+import qualified Network.Wai.Handler.Warp as Warp+import Servant+import Servant.Mustache+++-- * For HTML Examle++data User = User+  { name :: String+  , age :: Int+  } deriving (Generic, ToJSON)+++-- * For Template Example++data CSS++instance Accept CSS where+  contentType _ = "text" // "css"++data CSSData = CSSData+  { darken :: Bool+  , pageWidth :: Int+  } deriving (Generic, ToJSON)+++-- * Server implementation++type API = Get '[HTML "user"] User+      :<|> "style.css" :> Get '[Template CSS "style"] CSSData++api :: Proxy API+api = Proxy++server :: Server API+server = pure (User "lambdabot" 35)+    :<|> pure (CSSData True 400)++main :: IO ()+main = do+  loadTemplates "example/templates"+  putStrLn "Listening on port 8080"+  Warp.run 8080 $ serve api server
+ servant-stache.cabal view
@@ -0,0 +1,63 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 1200df16cf696c0810a2e4953c186a794dfb7646101d651f71ceca33d37305a4++name:           servant-stache+version:        0.1.0.0+synopsis:       Content-Types for rendering Mustache in servant+description:    Content-Types and template management for rendering Mustache templates in servant Web applications. This package is heavily inspired by <http://hackage.haskell.org/package/servant-ede servant-ede>. Documentation and examples available at "Servant.Mustache".+category:       Web+homepage:       https://github.com/lotz84/servant-stache#readme+bug-reports:    https://github.com/lotz84/servant-stache/issues+author:         Tatsuya Hirose+maintainer:     tatsuya.hirose.0804@gmail.com+copyright:      2018 Tatsuya Hirose+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/lotz84/servant-stache++library+  exposed-modules:+      Servant.Mustache+  other-modules:+      Paths_servant_stache+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , http-media+    , servant+    , stache+    , text+    , transformers+    , unordered-containers+    , vector+    , xss-sanitize+  default-language: Haskell2010++executable example+  main-is: Main.hs+  other-modules:+      Paths_servant_stache+  hs-source-dirs:+      example+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , base >=4.7 && <5+    , http-media+    , servant-server+    , servant-stache+    , warp+  default-language: Haskell2010
+ src/Servant/Mustache.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Servant.Mustache+-- Copyright   :  (c) Tatsuya Hirose 2018+-- Maintainer  :  tatsuya.hirose.0804@gmail.com+-- Stability   :  experimental+--+-- Rendering Mustache templates with <http://hackage.haskell.org/package/servant servant>+-- using <https://hackage.haskell.org/package/stache stache>. This package is heavily+-- inspired by <http://hackage.haskell.org/package/servant-ede servant-ede>.+--+-- This package provides two Content-Types with servant (i.e just like 'JSON'),+-- 'HTML' and 'Template'.+-- +--+-- - 'HTML' takes a filename as parameter and lets you render the template+--   with that name against the data returned by a request handler using+--   the @text\/html;charset=utf-8@ MIME type, XSS-sanitizing the said data+--   along the way.+-- - 'Template' does the same except that it's parametrized over the content type+--   to be sent along with the rendered template. Any type that has an 'Accept'+--   instance will do.+-----------------------------------------------------------------------------+module Servant.Mustache+  ( -- * Content-Types+    HTML+  , Template++    -- * Loading template files+  , loadTemplates+) where++import Data.Proxy (Proxy(..))+import Control.Concurrent.MVar (MVar, newEmptyMVar, readMVar, putMVar)+import GHC.TypeLits (KnownSymbol(..), Symbol, symbolVal)+import System.IO.Unsafe (unsafePerformIO)++import Control.Monad.IO.Class (MonadIO(..))+import Data.Aeson+import qualified Data.HashMap.Strict as HM+import Data.Text (Text, pack)+import Data.Text.Lazy.Encoding (encodeUtf8)+import qualified Data.Vector as V+import Network.HTTP.Media ((//), (/:))+import Servant.API.ContentTypes (Accept(..), MimeRender(..))+import Text.HTML.SanitizeXSS (sanitize)+import qualified Text.Mustache as Stache+++-- global store of templates+{-# NOINLINE __template_store #-}+__template_store :: MVar Stache.Template+__template_store = unsafePerformIO newEmptyMVar+++-- | This function initializes a global template store+--   and fills it with the resulting compiled templates.+--   This function /does not/ scan the directory recursively.+--+--   /IMPORTANT/: Must /always/ be called before starting your /servant/ application.+-- +loadTemplates :: (MonadIO io) => FilePath -> io ()+loadTemplates dir = do+  template <- Stache.compileMustacheDir undefined dir+  liftIO $ putMVar __template_store template+++-- | A generic template for any content, parametrized over the+--   content-type (or MIME) associated to the template.+--+--   The first parameter is the content-type you want to send along with+--   rendered templates (must be an instance of 'Accept'). The second+--   parameter is the name of (or path to) the template file. Any type+--   used with this content-type (like @CSSData@ below) must have an+--   instance of the 'ToJSON' class.+--+--   Here is how you could render and serve, say, /CSS/+--   (Cascading Style Sheets) templates that make use+--   of some @CSSData@ data type to tweak the styling.+--+-- @+-- data CSS+--+-- instance Accept CSS where+--   contentType _ = "text" // "css"+--+-- data CSSData = CSSData+--   { darken :: Bool+--   , pageWidth :: Int+--   } deriving (Generic, ToJSON)+--+-- type StyleAPI = "style.css" :> Get '[Template CSS "style"] CSSData+-- @+--+-- @style.mustache@ could for example be:+--+-- > body {+-- >   {{#darken}}+-- >   background-color: #222;+-- >   color: blue;+-- >   {{/darken}}+-- >   {{^darken}}+-- >   background-color: white;+-- >   color: back;+-- >   {{/darken}}+-- > }+-- >+-- > #content {+-- >   width: {{pageWidth}}px;+-- >   margin: 0 auto;+-- > }+--+-- A complete, runnable version of this can be found+-- in the @examples@ folder of the git repository+data Template (ct :: *) (file :: Symbol)++-- | use @ct@'s content-type+instance Accept ct => Accept (Template ct file) where+  contentType _ = contentType ctproxy+    where ctproxy = Proxy :: Proxy ct++-- | render the contents of @file@ in the global template store+instance (KnownSymbol file, Accept ct, ToJSON a) => MimeRender (Template ct file) a where+  mimeRender _ val =+    encodeUtf8 $ Stache.renderMustache template (toJSON val)+    where template = tstore { Stache.templateActual = Stache.PName (pack filename) }+          filename = symbolVal (Proxy :: Proxy file)+          tstore = unsafePerformIO (readMVar __template_store)+++-- | 'HTML' content type. 'HTML' takes a type-level string+--   which is a filename for the template you want to use+--   to render values. Types used with the 'HTML' content+--   type (like @User@ below) must provide a 'ToJSON' instance.+--+--   The filename doesn't contain any extension. For example, if+--   the template filename is @user.mustache@, `HTML` takes @user@+--   as filename.+--+-- @+-- data User = User { name :: String, age :: Int } deriving (Generic, ToJSON)+--+-- type UserAPI = "user" :> Get '[HTML "user"] User+--+-- userAPI :: Proxy UserAPI+-- userAPI = Proxy+--+-- server :: Server API+-- server = pure (User "lambdabot" 31)+--+-- main :: IO ()+-- main = do+--   loadTemplates "./templates"+--   run 8080 (serve userAPI server)+-- @+--+-- This will look for a template at @.\/templates\/user.mustache@, which could+-- for example be:+--+-- > <ul>+-- >   <li><strong>Name:</strong> {{ name }}</li>+-- >   <li><strong>Age:</strong> {{ age }}</li>+-- > </ul>+--+-- /IMPORTANT/: it XSS-sanitizes every bit of text in the 'Value'+-- passed to the template.+data HTML (file :: Symbol)++-- | @text/html;charset=utf-8@+instance Accept (HTML file) where+  contentType _ = "text" // "html" /: ("charset", "utf-8")++-- | XSS-sanitizes data before rendering it+instance (KnownSymbol file, ToJSON a) => MimeRender (HTML file) a where+  mimeRender _ val = mimeRender (Proxy :: Proxy (Template (HTML file) file)) $+    sanitizeValue (toJSON val)++sanitizeObject :: Object -> Object+sanitizeObject = HM.fromList . map sanitizeKV . HM.toList++sanitizeKV :: (Text, Value) -> (Text, Value)+sanitizeKV (k, v) = (sanitize k, sanitizeValue v)++sanitizeValue :: Value -> Value+sanitizeValue (String s) = String (sanitize s)+sanitizeValue (Array a) = Array (V.map sanitizeValue a)+sanitizeValue (Object o) = Object (sanitizeObject o)+sanitizeValue x = x