├── hypertrout.png ├── .gitignore ├── packages.dhall ├── spago.dhall ├── test ├── Main.purs └── Hyper │ └── Trout │ ├── TestSite.purs │ └── RouterSpec.purs ├── Makefile ├── bower.json ├── docs ├── static │ ├── syntax.css │ └── docs.css ├── src │ ├── Site1.purs │ ├── MultiMethodExample.purs │ ├── template.html │ ├── Site2.purs │ ├── Site3.purs │ └── index.md └── index.html ├── .travis.yml ├── README.md ├── examples ├── RoutingReaderT.purs └── Routing.purs ├── src └── Hyper │ └── Trout │ └── Router.purs └── LICENSE /hypertrout.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/purescript-hyper/purescript-hypertrout/HEAD/hypertrout.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc* 7 | /.psa* 8 | /.spago 9 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.13.8/packages.dhall sha256:0e95ec11604dc8afc1b129c4d405dcc17290ce56d7d0665a0ff15617e32bbf03 3 | 4 | let overrides = {=} 5 | 6 | let additions = {=} 7 | 8 | in upstream // overrides // additions 9 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = 2 | "hypertrout" 3 | , dependencies = 4 | [ "argonaut-generic" 5 | , "console" 6 | , "hyper" 7 | , "prelude" 8 | , "psci-support" 9 | , "spec" 10 | , "spec-discovery" 11 | , "trout" 12 | ] 13 | , packages = 14 | ./packages.dhall 15 | , sources = 16 | [ "src/**/*.purs", "test/**/*.purs" ] 17 | } 18 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Effect (Effect) 5 | import Effect.Aff (launchAff_) 6 | import Test.Spec.Discovery (discover) 7 | import Test.Spec.Reporter.Console (consoleReporter) 8 | import Test.Spec.Runner (runSpec) 9 | 10 | main :: Effect Unit 11 | main = discover "Hyper\\.Trout\\..*Spec" >>= runSpec [consoleReporter] >>> launchAff_ 12 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | VERSION ?= $(shell git rev-parse --short HEAD) 2 | 3 | all: html examples docs-examples 4 | 5 | .PHONY: html 6 | html: docs/index.html 7 | 8 | docs/index.html: docs/src/index.md docs/src/template.html docs/src/*.purs 9 | pandoc \ 10 | $< \ 11 | -t html5 \ 12 | --standalone \ 13 | -S \ 14 | --filter pandoc-include-code \ 15 | --toc \ 16 | "--metadata=subtitle:Build servers in Hyper using Trout" \ 17 | "--metadata=version:$(VERSION)" \ 18 | --template=docs/src/template.html \ 19 | -o $@ 20 | 21 | .PHONY: examples 22 | examples: bower_components 23 | spago build -p examples/**/*.purs 24 | 25 | .PHONY: docs-examples 26 | docs-examples: bower_components 27 | spago build -p docs/src/**/*.purs 28 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-hypertrout", 3 | "license": "MPL-2.0", 4 | "repository": { 5 | "type": "git", 6 | "url": "git://github.com/owickstrom/purescript-hypertrout.git" 7 | }, 8 | "ignore": ["**/.*", "node_modules", "bower_components", "output"], 9 | "dependencies": { 10 | "purescript-prelude": "^4.1.1", 11 | "purescript-console": "^4.4.0", 12 | "purescript-hyper": "^0.11.1", 13 | "purescript-trout": "^0.12.3" 14 | }, 15 | "devDependencies": { 16 | "purescript-psci-support": "^4.0.0", 17 | "purescript-spec": "^4.0.0", 18 | "purescript-spec-discovery": "^4.0.0", 19 | "purescript-argonaut-generic": "^6.0.0" 20 | }, 21 | "resolutions": { 22 | "purescript-spec": "^4.0.0" 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /docs/static/syntax.css: -------------------------------------------------------------------------------- 1 | /* Loosely based on pygment's default colors */ 2 | table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode, table.sourceCode pre 3 | { margin: 0; padding: 0; border: 0; vertical-align: baseline; border: none; } 4 | td.lineNumbers { border-right: 1px solid #AAAAAA; text-align: right; color: #AAAAAA; padding-right: 5px; padding-left: 5px; } 5 | td.sourceCode { padding-left: 5px; } 6 | pre.sourceCode { } 7 | code.sourceCode span.kw { color: #6900EA; } 8 | code.sourceCode span.dt { color: #990099; } 9 | code.sourceCode span.dv { color: #333333; } 10 | code.sourceCode span.bn { color: #333333; } 11 | code.sourceCode span.fl { color: #333333; } 12 | code.sourceCode span.ch { color: #333333; } 13 | code.sourceCode span.st { color: #579E00; } 14 | code.sourceCode span.co { color: #60a0b0; font-style: italic; } 15 | code.sourceCode span.ot { color: #6900EA; } 16 | code.sourceCode span.al { color: red; font-weight: bold; } 17 | code.sourceCode span.fu { color: #990099; } 18 | code.sourceCode span.re { } 19 | code.sourceCode span.er { color: red; font-weight: bold; } 20 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | 3 | sudo: false 4 | 5 | node_js: 6 | - "11" 7 | 8 | env: 9 | matrix: 10 | - PATH=$HOME:$HOME/purescript:$PATH 11 | 12 | install: 13 | - PURS_VER=v0.13.8 14 | - SPAGO_VER=0.15.3 15 | - PULP_VER=15.0.0 16 | - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$PURS_VER/linux64.tar.gz 17 | - wget -O $HOME/spago.tar.gz https://github.com/purescript/spago/releases/download/$SPAGO_VER/linux.tar.gz 18 | - tar -xvf $HOME/purescript.tar.gz -C $HOME/ 19 | - tar -xvf $HOME/spago.tar.gz -C $HOME/ 20 | - chmod a+x $HOME/purescript/purs 21 | - chmod a+x $HOME/spago 22 | - npm install -g bower@^1.8.8 pulp@^$PULP_VER 23 | - spago install 24 | - bower install 25 | 26 | script: 27 | - export VERSION=branch-job-$TRAVIS_JOB_NUMBER 28 | - if [[ "$TRAVIS_PULL_REQUEST" != "false" ]]; then export VERSION=pull-request-job-$TRAVIS_JOB_NUMBER; 29 | fi 30 | - if [[ "$TRAVIS_TAG" != "" ]]; then export VERSION=$TRAVIS_TAG; fi 31 | - spago build 32 | - spago test 33 | - make examples docs-examples 34 | - rm -rf .spago output 35 | - pulp build 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |
2 |

3 | Hypertrout 6 |

7 |
8 | 9 |

10 | Type-level routing for Hyper web servers using Trout. 11 |

12 | 13 |
14 | 15 | Hypertrout lets you build [Hyper](https://hyper.wickstrom.tech) web servers on 16 | top of the [purescript-trout](https://github.com/purescript-hyper/purescript-trout) 17 | API for type-level routing. 18 | 19 | ## Usage 20 | 21 | For the documentation on how to use this package, please see [the 22 | tutorials](https://purescript-hyper.github.io/purescript-hypertrout/). 23 | 24 | There are also [runnable examples in this repository](examples/). 25 | 26 | ## API Documentation 27 | 28 | This library's API documentation is published [on Pursuit](https://pursuit.purescript.org/packages/purescript-hypertrout). 29 | 30 | ## Changelog 31 | 32 | * **0.11.1** 33 | - Update dependencies. 34 | * **0.11.0** 35 | - Updates for PureScript 0.13 36 | - Upgrade to Hyper 0.10.0 37 | - Upgrade to Trout 0.12.0 38 | - Various dependency upgrades 39 | - Migration to Spago as primary package manager / build tool 40 | * **0.10.0** 41 | - Updates for PureScript 0.12 42 | - Upgrade to Hyper 0.9.0 43 | - Upgrade to Trout 0.11.0 44 | * **0.9.0** 45 | - Add QueryParam and QueryParams 46 | - Upgrade to Hyper 0.8.0 47 | - Use Trout 0.10.0 and the named routing types (backwards-incompatible 48 | change!) 49 | 50 | ## License 51 | 52 | [Mozilla Public License Version 2.0](LICENSE) 53 | -------------------------------------------------------------------------------- /examples/RoutingReaderT.purs: -------------------------------------------------------------------------------- 1 | module Examples.RoutingReaderT where 2 | 3 | import Prelude 4 | import Control.Monad.Indexed ((:*>)) 5 | import Control.Monad.Except (ExceptT) 6 | import Control.Monad.Reader (ReaderT, ask, runReaderT) 7 | import Data.Maybe (fromMaybe) 8 | import Effect (Effect) 9 | import Effect.Aff (Aff) 10 | import Hyper.Node.Server (defaultOptionsWithLogging, runServer') 11 | import Hyper.Response (closeHeaders, respond, writeStatus) 12 | import Hyper.Trout.Router (RoutingError, router) 13 | import Text.Smolder.HTML (p) 14 | import Text.Smolder.Markup (text) 15 | import Type.Proxy (Proxy(..)) 16 | import Type.Trout (type (:=), Resource) 17 | import Type.Trout.ContentType.HTML (class EncodeHTML, HTML) 18 | import Type.Trout.Method (Get) 19 | 20 | data Greeting = Greeting String 21 | 22 | type Site = "greeting" := Resource (Get Greeting HTML) 23 | 24 | instance encodeHTMLGreeting :: EncodeHTML Greeting where 25 | encodeHTML (Greeting g) = p (text g) 26 | 27 | runAppM ∷ ∀ a. String -> ReaderT String Aff a → Aff a 28 | runAppM = flip runReaderT 29 | 30 | site :: Proxy Site 31 | site = Proxy 32 | 33 | greetingResource 34 | :: forall m 35 | . Monad m 36 | => {"GET" :: ExceptT RoutingError (ReaderT String m) Greeting} 37 | greetingResource = 38 | {"GET": Greeting <$> ask} 39 | 40 | main :: Effect Unit 41 | main = 42 | let app = router site {"greeting": greetingResource} onRoutingError 43 | 44 | onRoutingError status msg = 45 | writeStatus status 46 | :*> closeHeaders 47 | :*> respond (fromMaybe "" msg) 48 | 49 | in runServer' defaultOptionsWithLogging {} (runAppM "Hello") app 50 | -------------------------------------------------------------------------------- /docs/src/Site1.purs: -------------------------------------------------------------------------------- 1 | module Site1 where 2 | 3 | import Prelude 4 | import Control.Monad.Indexed ((:*>)) 5 | import Data.Maybe (maybe) 6 | import Data.MediaType.Common (textHTML) 7 | import Effect (Effect) 8 | import Hyper.Node.Server (defaultOptions, runServer) 9 | import Hyper.Response (contentType, respond, closeHeaders, writeStatus) 10 | import Hyper.Trout.Router (router) 11 | import Text.Smolder.HTML (p) 12 | import Text.Smolder.Markup (text) 13 | import Type.Proxy (Proxy(..)) 14 | import Type.Trout (Resource) 15 | import Type.Trout.ContentType.HTML (class EncodeHTML, HTML) 16 | import Type.Trout.Method (Get) 17 | 18 | -- start snippet routing-type 19 | data Home = Home 20 | 21 | type Site1 = Resource (Get Home HTML) 22 | -- end snippet routing-type 23 | 24 | -- start snippet handler 25 | home :: forall m. Applicative m => {"GET" :: m Home} 26 | home = {"GET": pure Home} 27 | -- end snippet handler 28 | 29 | -- start snippet encoding 30 | instance encodeHTMLHome :: EncodeHTML Home where 31 | encodeHTML Home = 32 | p (text "Welcome to my site!") 33 | -- end snippet encoding 34 | 35 | -- start snippet proxy 36 | site1 :: Proxy Site1 37 | site1 = Proxy 38 | -- end snippet proxy 39 | 40 | -- start snippet main 41 | main :: Effect Unit 42 | main = 43 | runServer defaultOptions {} siteRouter 44 | -- end snippet main 45 | where 46 | 47 | -- start snippet router 48 | onRoutingError status msg = 49 | writeStatus status 50 | :*> contentType textHTML 51 | :*> closeHeaders 52 | :*> respond (maybe "" identity msg) 53 | 54 | siteRouter = router site1 home onRoutingError 55 | -- end snippet router 56 | -------------------------------------------------------------------------------- /docs/src/MultiMethodExample.purs: -------------------------------------------------------------------------------- 1 | module MultiMethodExample where 2 | 3 | import Control.Monad.Indexed ((:*>)) 4 | import Control.Monad.Error.Class (throwError) 5 | import Control.Monad.Except (ExceptT) 6 | import Data.Maybe (Maybe(..), maybe) 7 | import Data.MediaType.Common (textHTML) 8 | import Effect (Effect) 9 | import Hyper.Node.Server (defaultOptions, runServer) 10 | import Hyper.Response (closeHeaders, contentType, respond, writeStatus) 11 | import Hyper.Status (statusBadRequest) 12 | import Hyper.Trout.Router (RoutingError(..), router) 13 | import Text.Smolder.HTML (h1) 14 | import Text.Smolder.Markup (text) 15 | import Type.Proxy (Proxy(..)) 16 | import Type.Trout (type (:<|>), type (:=), Resource) 17 | import Type.Trout.ContentType.HTML (class EncodeHTML, HTML) 18 | import Type.Trout.Method (Get, Delete) 19 | import Prelude hiding (div) 20 | 21 | newtype User = User { name :: String } 22 | 23 | -- start snippet routing-type 24 | type MultiMethodExample = 25 | "user" := Resource (Get User HTML :<|> Delete User HTML) 26 | -- end snippet routing-type 27 | 28 | site :: Proxy MultiMethodExample 29 | site = Proxy 30 | 31 | getUser :: forall m. Monad m => ExceptT RoutingError m User 32 | getUser = 33 | pure (User { name: "An existing user." }) 34 | 35 | deleteUser :: forall m. Monad m => ExceptT RoutingError m User 36 | deleteUser = 37 | throwError (HTTPError { status: statusBadRequest 38 | , message: Just "Not doing that, no..." 39 | }) 40 | 41 | instance encodeHTMLUser :: EncodeHTML User where 42 | encodeHTML (User { name }) = 43 | h1 (text $ "User: " <> name) 44 | 45 | main :: Effect Unit 46 | main = 47 | let 48 | -- start snippet resources 49 | resources = 50 | { user: { "GET": getUser 51 | , "DELETE": deleteUser 52 | } 53 | } 54 | -- end snippet resources 55 | 56 | site3Router = router site resources onRoutingError 57 | 58 | onRoutingError status msg = 59 | writeStatus status 60 | :*> contentType textHTML 61 | :*> closeHeaders 62 | :*> respond (maybe "" identity msg) 63 | 64 | in runServer defaultOptions {} site3Router 65 | -------------------------------------------------------------------------------- /test/Hyper/Trout/TestSite.purs: -------------------------------------------------------------------------------- 1 | module Hyper.Trout.TestSite where 2 | 3 | import Prelude 4 | import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) 5 | import Data.Either (Either(..)) 6 | import Data.Maybe (Maybe) 7 | import Data.String (trim) 8 | import Text.Smolder.HTML (h1) 9 | import Text.Smolder.Markup (text) 10 | import Type.Proxy (Proxy(..)) 11 | import Type.Trout (type (:/), type (:<|>), type (:=), type (:>), Capture, CaptureAll, Raw, Resource, QueryParam, QueryParams) 12 | import Type.Trout.ContentType.HTML (HTML, class EncodeHTML) 13 | import Type.Trout.ContentType.JSON (JSON) 14 | import Type.Trout.Method (Get, Post) 15 | import Type.Trout.PathPiece (class FromPathPiece, class ToPathPiece) 16 | 17 | data Home = Home 18 | 19 | instance encodeJsonHome :: EncodeJson Home where 20 | encodeJson Home = jsonEmptyObject 21 | 22 | instance encodeHTMLHome :: EncodeHTML Home where 23 | encodeHTML Home = h1 (text "Home") 24 | 25 | newtype UserID = UserID String 26 | 27 | instance fromPathPieceUserID :: FromPathPiece UserID where 28 | fromPathPiece s = 29 | case trim s of 30 | "" -> Left "UserID must not be blank." 31 | s' -> Right (UserID s') 32 | 33 | instance toPathPieceUserID :: ToPathPiece UserID where 34 | toPathPiece (UserID s) = s 35 | 36 | data User = User UserID 37 | 38 | instance encodeUser :: EncodeJson User where 39 | encodeJson (User (UserID userId)) = 40 | "userId" := userId 41 | ~> jsonEmptyObject 42 | 43 | data WikiPage = WikiPage String 44 | 45 | instance encodeHTMLWikiPage :: EncodeHTML WikiPage where 46 | encodeHTML (WikiPage title) = text ("Viewing page: " <> title) 47 | 48 | type UserResources = 49 | "profile" := "profile" :/ Resource (Get User JSON) 50 | :<|> "friends" := "friends" :/ Resource (Get (Array User) JSON :<|> Post User JSON) 51 | 52 | type TestSite = 53 | "home" := Resource (Get Home (HTML :<|> JSON)) 54 | -- nested routes with capture 55 | :<|> "user" := "users" :/ Capture "user-id" UserID :> UserResources 56 | -- capture all 57 | :<|> "wiki" := "wiki" :/ CaptureAll "segments" String :> Resource (Get WikiPage HTML) 58 | -- query string parameters 59 | :<|> "search" := "search" :/ QueryParam "q" String :> Resource (Get (Maybe User) JSON) 60 | -- many query string parameters 61 | :<|> "searchMany" := "search-many" :/ QueryParams "q" String :> Resource (Get (Array User) JSON) 62 | -- raw middleware 63 | :<|> "about" := "about" :/ Raw "GET" 64 | 65 | testSite :: Proxy TestSite 66 | testSite = Proxy 67 | -------------------------------------------------------------------------------- /docs/static/docs.css: -------------------------------------------------------------------------------- 1 | html, body { 2 | height: 100%; 3 | } 4 | body { 5 | 6 | max-width: 700px; 7 | margin: 0 auto; 8 | padding: 10px; 9 | 10 | line-height: 1.6; 11 | font-size: 15px; 12 | font-family: 'Fira Sans', 'Helvetica', 'Arial', sans-serif; 13 | 14 | color: #333; 15 | -webkit-text-size-adjust: 100%; 16 | -webkit-font-feature-settings: "kern" 1; 17 | -moz-font-feature-settings: "kern" 1; 18 | -o-font-feature-settings: "kern" 1; 19 | font-feature-settings: "kern" 1; 20 | font-kerning: normal; 21 | -webkit-font-smoothing: antialiased; 22 | } 23 | 24 | p, pre, table, ul, ol { 25 | margin: 1em 0; 26 | } 27 | 28 | ul ol, 29 | ul ul, 30 | ol ul, 31 | ol ol { 32 | margin: 0 0 0; 33 | } 34 | 35 | ul li, 36 | ol li { 37 | margin-bottom: .5em; 38 | } 39 | 40 | li > a + ul, 41 | li > a + ol { 42 | margin-top: .5em; 43 | } 44 | 45 | blockquote { 46 | font-size: 120%; 47 | margin: 1em 2em 1.5em; 48 | color: #888; 49 | } 50 | 51 | pre, 52 | code { 53 | font-family: 'Fira Mono', 'Menlo', 'Consolas', 'Ubuntu Mono', Courier, monospace; 54 | line-height: inherit; 55 | color: #333; 56 | } 57 | 58 | pre { 59 | position: relative; 60 | overflow: auto; 61 | padding: 1em; 62 | background: #f7f7f7; 63 | border-left: 5px solid #ddd; 64 | border-right: 5px solid #ddd; 65 | } 66 | 67 | ul code, 68 | ol code, 69 | p code { 70 | background: #eee; 71 | padding: 0 2px; 72 | line-height: 1.3; 73 | } 74 | 75 | pre:before { 76 | display: block; 77 | content: attr(caption); 78 | position: absolute; 79 | top: 0; 80 | left: 0; 81 | right: 0; 82 | overflow: hidden; 83 | text-overflow: ellipsis; 84 | white-space: nowrap; 85 | } 86 | 87 | pre:before, 88 | table caption { 89 | font-style: italic; 90 | font-size: 16px; 91 | text-align: center; 92 | } 93 | table { 94 | border-spacing: 0; 95 | border-collapse: separate; 96 | } 97 | table caption { 98 | position: absolute; 99 | top: 0; 100 | left: 0; 101 | right: 0; 102 | } 103 | table th, 104 | table td { 105 | padding: 4px; 106 | } 107 | table th { 108 | padding: 6px 4px 4px; 109 | border-top: 1px solid #111; 110 | border-bottom: 1px solid #111; 111 | font-weight: 400; 112 | } 113 | 114 | body > table { 115 | position: relative; 116 | width: 100%; 117 | padding: 2em; 118 | } 119 | 120 | a { 121 | color: #706ec3; 122 | } 123 | a:visited { 124 | color: #80808e; 125 | } 126 | a:hover { 127 | color: #8583d4; 128 | } 129 | 130 | p { 131 | text-align: justify; 132 | } 133 | 134 | header { 135 | text-align: center; 136 | } 137 | 138 | figure { 139 | text-align: center; 140 | } 141 | 142 | img { 143 | max-width: 100%; 144 | } 145 | 146 | h1, 147 | h2, 148 | h3, 149 | h4, 150 | h5, 151 | h6 { 152 | font-weight: 800; 153 | margin: 1.5em 0 .5em 0; 154 | } 155 | 156 | header .subtitle { 157 | text-align: center; 158 | font-size: 125%; 159 | } 160 | 161 | h2 { 162 | padding-bottom: .25em; 163 | border-bottom: 1px solid #ddd; 164 | } 165 | 166 | .author { 167 | font-style: normal; 168 | } 169 | 170 | footer { 171 | padding: 1em; 172 | text-align: center; 173 | color: #888; 174 | font-size: 13px; 175 | } 176 | -------------------------------------------------------------------------------- /docs/src/template.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | $for(author-meta)$ 8 | 9 | $endfor$ 10 | $if(date-meta)$ 11 | 12 | $endif$ 13 | $if(keywords)$ 14 | 15 | $endif$ 16 | $if(title-prefix)$$title-prefix$ – $endif$$pagetitle$ 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 | $if(math)$ 46 | $math$ 47 | $endif$ 48 | 51 | $for(header-includes)$ 52 | $header-includes$ 53 | $endfor$ 54 | $for(css)$ 55 | 56 | $endfor$ 57 | 58 | 59 | $for(include-before)$ 60 | $include-before$ 61 | $endfor$ 62 | $if(title)$ 63 |
64 |

$title$

65 | $if(subtitle)$ 66 |

$subtitle$

67 | $endif$ 68 | $for(author)$ 69 | 70 | $endfor$ 71 | $if(date)$ 72 |

$date$

73 | $endif$ 74 |
75 | $endif$ 76 | $if(toc)$ 77 |

Contents

78 | 81 | $endif$ 82 | $body$ 83 | 92 | 93 | $for(include-after)$ 94 | $include-after$ 95 | $endfor$ 96 | 97 | 98 | -------------------------------------------------------------------------------- /docs/src/Site2.purs: -------------------------------------------------------------------------------- 1 | module Site2 where 2 | 3 | import Control.Monad.Indexed ((:*>)) 4 | import Control.Monad.Error.Class (throwError) 5 | import Control.Monad.Except (ExceptT) 6 | import Data.Array (find) 7 | import Data.Maybe (Maybe(..), maybe) 8 | import Data.MediaType.Common (textHTML) 9 | import Data.Traversable (traverse_) 10 | import Effect (Effect) 11 | import Hyper.Node.Server (defaultOptions, runServer) 12 | import Hyper.Response (closeHeaders, contentType, respond, writeStatus) 13 | import Hyper.Status (statusNotFound) 14 | import Hyper.Trout.Router (RoutingError(..), router) 15 | import Text.Smolder.HTML (div, h1, li, p, ul) 16 | import Text.Smolder.Markup (text) 17 | import Type.Proxy (Proxy(..)) 18 | import Type.Trout (type (:/), type (:<|>), type (:=), type (:>), Capture, Resource) 19 | import Type.Trout.ContentType.HTML (class EncodeHTML, HTML, linkTo) 20 | import Type.Trout.Links (linksTo) 21 | import Type.Trout.Method (Get) 22 | import Prelude hiding (div) 23 | 24 | -- start snippet resources-and-type 25 | data Home = Home 26 | 27 | data AllUsers = AllUsers (Array User) 28 | 29 | newtype User = User { id :: Int, name :: String } 30 | 31 | type Site2 = 32 | "home" := Resource (Get Home HTML) 33 | :<|> "users" := "users" :/ Resource (Get AllUsers HTML) 34 | :<|> "user" := "users" :/ Capture "user-id" Int 35 | :> Resource (Get User HTML) 36 | 37 | site2 :: Proxy Site2 38 | site2 = Proxy 39 | -- end snippet resources-and-type 40 | 41 | -- start snippet handlers 42 | homeResource :: forall m. Monad m => {"GET" :: ExceptT RoutingError m Home} 43 | homeResource = {"GET": pure Home} 44 | 45 | usersResource :: forall m. Monad m => {"GET" :: ExceptT RoutingError m AllUsers} 46 | usersResource = {"GET": AllUsers <$> getUsers} 47 | 48 | userResource :: forall m. Monad m => Int -> {"GET" :: ExceptT RoutingError m User} 49 | userResource id' = 50 | {"GET": 51 | find (\(User u) -> u.id == id') <$> getUsers >>= 52 | case _ of 53 | Just user -> pure user 54 | Nothing -> 55 | throwError (HTTPError { status: statusNotFound 56 | , message: Just "User not found." 57 | }) 58 | } 59 | -- end snippet handlers 60 | 61 | -- start snippet encoding 62 | instance encodeHTMLHome :: EncodeHTML Home where 63 | encodeHTML Home = 64 | let {users} = linksTo site2 65 | in p do 66 | text "Welcome to my site! Go check out my " 67 | linkTo users (text "Users") 68 | text "." 69 | 70 | instance encodeHTMLAllUsers :: EncodeHTML AllUsers where 71 | encodeHTML (AllUsers users) = 72 | div do 73 | h1 (text "Users") 74 | ul (traverse_ linkToUser users) 75 | where 76 | linkToUser (User u) = 77 | let {user} = linksTo site2 78 | in li (linkTo (user u.id) (text u.name)) 79 | 80 | instance encodeHTMLUser :: EncodeHTML User where 81 | encodeHTML (User { name }) = 82 | h1 (text name) 83 | -- end snippet encoding 84 | 85 | -- start snippet get-users 86 | getUsers :: forall m. Applicative m => m (Array User) 87 | getUsers = 88 | pure 89 | [ User { id: 1, name: "John Paul Jones" } 90 | , User { id: 2, name: "Tal Wilkenfeld" } 91 | , User { id: 3, name: "John Patitucci" } 92 | , User { id: 4, name: "Jaco Pastorious" } 93 | ] 94 | -- end snippet get-users 95 | 96 | -- start snippet main 97 | main :: Effect Unit 98 | main = 99 | let resources = { home: homeResource 100 | , users: usersResource 101 | , user: userResource 102 | } 103 | 104 | otherSiteRouter = 105 | router site2 resources onRoutingError 106 | 107 | onRoutingError status msg = 108 | writeStatus status 109 | :*> contentType textHTML 110 | :*> closeHeaders 111 | :*> respond (maybe "" identity msg) 112 | 113 | in runServer defaultOptions {} otherSiteRouter 114 | -- end snippet main 115 | -------------------------------------------------------------------------------- /examples/Routing.purs: -------------------------------------------------------------------------------- 1 | module Examples.Routing where 2 | 3 | import Prelude 4 | import Control.Monad.Indexed ((:*>)) 5 | import Control.Monad.Error.Class (throwError) 6 | import Control.Monad.Except (ExceptT) 7 | import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) 8 | import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) 9 | import Data.Array (find, (..)) 10 | import Data.Foldable (traverse_) 11 | import Data.Generic.Rep (class Generic) 12 | import Data.Maybe (Maybe(..), maybe) 13 | import Data.MediaType.Common (textHTML) 14 | import Effect (Effect) 15 | import Effect.Aff (Aff) 16 | import Hyper.Node.Server (defaultOptions, runServer) 17 | import Hyper.Response (closeHeaders, contentType, respond, writeStatus) 18 | import Hyper.Status (statusNotFound) 19 | import Hyper.Trout.Router (RoutingError(..), router) 20 | import Text.Smolder.HTML (h1, li, nav, p, section, ul) 21 | import Text.Smolder.Markup (text) 22 | import Type.Proxy (Proxy(..)) 23 | import Type.Trout (type (:/), type (:<|>), type (:=), type (:>), Capture, Resource) 24 | import Type.Trout.ContentType.HTML (class EncodeHTML, HTML, linkTo) 25 | import Type.Trout.ContentType.JSON (JSON) 26 | import Type.Trout.Links (linksTo) 27 | import Type.Trout.Method (Get) 28 | 29 | type PostID = Int 30 | 31 | newtype Post = Post { id :: PostID 32 | , title :: String 33 | } 34 | 35 | derive instance genericPost :: Generic Post _ 36 | 37 | instance encodeJsonPost :: EncodeJson Post where 38 | encodeJson (Post { id, title }) = 39 | "id" := id 40 | ~> "title" := title 41 | ~> jsonEmptyObject 42 | 43 | instance encodeHTMLPost :: EncodeHTML Post where 44 | encodeHTML (Post { id: postId, title}) = 45 | let {posts} = linksTo site 46 | in section do 47 | h1 (text title) 48 | p (text "Contents...") 49 | nav (linkTo posts (text "All Posts")) 50 | 51 | newtype PostsView = PostsView (Array Post) 52 | 53 | derive instance genericPostsView :: Generic PostsView _ 54 | 55 | instance encodeJsonPostsView :: EncodeJson PostsView where 56 | encodeJson = genericEncodeJson 57 | 58 | instance encodeHTMLPostsView :: EncodeHTML PostsView where 59 | encodeHTML (PostsView posts) = 60 | let {post} = linksTo site 61 | postLink (Post { id: postId, title }) = 62 | li (linkTo (post postId) (text title)) 63 | in section do 64 | h1 (text "Posts") 65 | ul (traverse_ postLink posts) 66 | 67 | type Site = 68 | "posts" := Resource (Get PostsView (HTML :<|> JSON)) 69 | :<|> "post" := "posts" :/ Capture "id" PostID :> Resource (Get Post (HTML :<|> JSON)) 70 | 71 | site :: Proxy Site 72 | site = Proxy 73 | 74 | type AppM a = ExceptT RoutingError Aff a 75 | 76 | -- This would likely be a database query in 77 | -- a real app: 78 | allPosts :: AppM (Array Post) 79 | allPosts = pure (map (\i -> Post { id: i, title: "Post #" <> show i }) (1..10)) 80 | 81 | postsResource :: { "GET" :: AppM PostsView } 82 | postsResource = { "GET": PostsView <$> allPosts } 83 | 84 | postResource :: PostID -> { "GET" :: AppM Post } 85 | postResource postId = 86 | { "GET": 87 | find (\(Post p) -> p.id == postId) <$> allPosts >>= 88 | case _ of 89 | Just post -> pure post 90 | -- You can throw 404 Not Found in here as well. 91 | Nothing -> throwError (HTTPError { status: statusNotFound 92 | , message: Just "Post not found." 93 | }) 94 | } 95 | 96 | main :: Effect Unit 97 | main = 98 | runServer defaultOptions {} siteRouter 99 | where 100 | siteRouter = router 101 | site 102 | { posts: postsResource 103 | , post: postResource 104 | } 105 | onRoutingError 106 | onRoutingError status msg = do 107 | writeStatus status 108 | :*> contentType textHTML 109 | :*> closeHeaders 110 | :*> respond (maybe "" identity msg) 111 | -------------------------------------------------------------------------------- /docs/src/Site3.purs: -------------------------------------------------------------------------------- 1 | module Site3 where 2 | 3 | import Control.Monad.Indexed ((:*>)) 4 | import Control.Monad.Error.Class (throwError) 5 | import Control.Monad.Except (ExceptT) 6 | import Data.Argonaut (class EncodeJson, encodeJson, fromArray, jsonEmptyObject, (:=), (~>)) 7 | import Data.Array (find) 8 | import Data.Foldable (traverse_) 9 | import Data.Maybe (Maybe(..), maybe) 10 | import Data.MediaType.Common (textHTML) 11 | import Effect (Effect) 12 | import Hyper.Node.Server (defaultOptions, runServer) 13 | import Hyper.Response (closeHeaders, contentType, respond, writeStatus) 14 | import Hyper.Status (statusNotFound) 15 | import Hyper.Trout.Router (RoutingError(..), router) 16 | import Text.Smolder.HTML (div, h1, li, p, ul) 17 | import Text.Smolder.Markup (text) 18 | import Type.Proxy (Proxy(..)) 19 | import Type.Trout (type (:/), type (:<|>), type (:=), type (:>), Capture, Resource) 20 | import Type.Trout.ContentType.HTML (class EncodeHTML, HTML, linkTo) 21 | import Type.Trout.ContentType.JSON (JSON) 22 | import Type.Trout.Links (linksTo) 23 | import Type.Trout.Method (Get) 24 | import Prelude hiding (div) 25 | 26 | data Home = Home 27 | 28 | newtype User = User { id :: Int, name :: String } 29 | 30 | instance encodeJsonUser :: EncodeJson User where 31 | encodeJson (User { id, name }) = 32 | "id" := show id 33 | ~> "name" := name 34 | ~> jsonEmptyObject 35 | 36 | 37 | data AllUsers = AllUsers (Array User) 38 | 39 | instance encodeJsonAllUsers :: EncodeJson AllUsers where 40 | encodeJson (AllUsers users) = fromArray (map encodeJson users) 41 | 42 | -- start snippet routing-type 43 | type Site3 = 44 | "home" := Resource (Get Home HTML) 45 | :<|> "users" := "users" :/ Resource (Get AllUsers (HTML :<|> JSON)) 46 | :<|> "user" := "users" :/ Capture "user-id" Int 47 | :> Resource (Get User (HTML :<|> JSON)) 48 | -- end snippet routing-type 49 | 50 | site3 :: Proxy Site3 51 | site3 = Proxy 52 | 53 | homeResource :: forall m. Monad m => {"GET" :: ExceptT RoutingError m Home} 54 | homeResource = {"GET": pure Home} 55 | 56 | usersResource :: forall m. Monad m => {"GET" :: ExceptT RoutingError m AllUsers} 57 | usersResource = {"GET": AllUsers <$> getUsers} 58 | 59 | userResource :: forall m. Monad m => Int -> {"GET" :: ExceptT RoutingError m User} 60 | userResource id' = 61 | {"GET": 62 | find (\(User u) -> u.id == id') <$> getUsers >>= 63 | case _ of 64 | Just user -> pure user 65 | Nothing -> 66 | throwError (HTTPError { status: statusNotFound 67 | , message: Just "User not found." 68 | }) 69 | } 70 | 71 | instance encodeHTMLHome :: EncodeHTML Home where 72 | encodeHTML Home = 73 | let {users} = linksTo site3 74 | in p do 75 | text "Welcome to my site! Go check out my " 76 | linkTo users (text "Users") 77 | text "." 78 | 79 | instance encodeHTMLAllUsers :: EncodeHTML AllUsers where 80 | encodeHTML (AllUsers users) = 81 | div do 82 | h1 (text "Users") 83 | ul (traverse_ linkToUser users) 84 | where 85 | linkToUser (User u) = 86 | let {user} = linksTo site3 87 | in li (linkTo (user u.id) (text u.name)) 88 | 89 | instance encodeHTMLUser :: EncodeHTML User where 90 | encodeHTML (User { name }) = 91 | h1 (text name) 92 | 93 | getUsers :: forall m. Applicative m => m (Array User) 94 | getUsers = 95 | pure 96 | [ User { id: 1, name: "John Paul Jones" } 97 | , User { id: 2, name: "Tal Wilkenfeld" } 98 | , User { id: 3, name: "John Patitucci" } 99 | , User { id: 4, name: "Jaco Pastorious" } 100 | ] 101 | 102 | main :: Effect Unit 103 | main = 104 | let resources = { home: homeResource 105 | , users: usersResource 106 | , user: userResource 107 | } 108 | 109 | site3Router = 110 | router site3 resources onRoutingError 111 | 112 | onRoutingError status msg = 113 | writeStatus status 114 | :*> contentType textHTML 115 | :*> closeHeaders 116 | :*> respond (maybe "" identity msg) 117 | 118 | in runServer defaultOptions {} site3Router 119 | -------------------------------------------------------------------------------- /test/Hyper/Trout/RouterSpec.purs: -------------------------------------------------------------------------------- 1 | module Hyper.Trout.RouterSpec (spec) where 2 | 3 | import Prelude 4 | import Control.Monad.Indexed ((:*>)) 5 | import Data.Either (Either(..)) 6 | import Data.HTTP.Method (Method(POST, GET)) 7 | import Data.Maybe (Maybe(..), maybe) 8 | import Data.MediaType.Common (textPlain) 9 | import Data.String (joinWith) 10 | import Data.Tuple (Tuple(..)) 11 | import Foreign.Object (Object) 12 | import Foreign.Object as F 13 | import Hyper.Conn (Conn) 14 | import Hyper.Middleware (Middleware, evalMiddleware) 15 | import Hyper.Request (class Request) 16 | import Hyper.Response (class Response, contentType, headers, respond, class ResponseWritable, ResponseEnded, StatusLineOpen, closeHeaders, writeStatus) 17 | import Hyper.Status (statusBadRequest, statusMethodNotAllowed, statusOK) 18 | import Hyper.Test.TestServer (TestResponse(..), TestRequest(..), defaultRequest, testHeaders, testServer, testStatus, testStringBody) 19 | import Hyper.Trout.TestSite (Home(..), User(..), UserID(..), WikiPage(..), testSite) 20 | import Hyper.Trout.Router (router) 21 | import Test.Spec (Spec, describe, it) 22 | import Test.Spec.Assertions (shouldEqual) 23 | 24 | homeResource :: forall m. Monad m => {"GET" :: m Home} 25 | homeResource = {"GET": pure Home} 26 | 27 | profileResource :: forall m. Monad m => UserID -> {"GET" :: m User} 28 | profileResource userId = {"GET": pure (User userId)} 29 | 30 | friendsResource 31 | :: forall m 32 | . Monad m 33 | => UserID 34 | -> { "GET" :: m (Array User) 35 | , "POST" :: m User 36 | } 37 | friendsResource (UserID uid) = 38 | { "GET": pure [ User (UserID "foo") 39 | , User (UserID "bar") 40 | ] 41 | -- TODO: add ReqBody when supported 42 | , "POST": pure (User (UserID "new-user")) 43 | } 44 | 45 | wikiResource :: forall m. Monad m => Array String -> {"GET" :: m WikiPage} 46 | wikiResource segments = {"GET": pure (WikiPage (joinWith "/" segments))} 47 | 48 | aboutMiddleware 49 | :: forall m req res c r 50 | . Monad m 51 | => Request req m 52 | => Response res m r 53 | => ResponseWritable r m String 54 | => Middleware 55 | m 56 | (Conn req (res StatusLineOpen) c) 57 | (Conn req (res ResponseEnded) c) 58 | Unit 59 | aboutMiddleware = do 60 | writeStatus statusOK 61 | :*> contentType textPlain 62 | :*> closeHeaders 63 | :*> respond "This is a test." 64 | 65 | searchResource :: forall f m. Functor f => Monad m => f String -> {"GET" :: m (f User)} 66 | searchResource q = 67 | {"GET": pure $ User <<< UserID <$> q} 68 | 69 | spec :: Spec Unit 70 | spec = 71 | describe "Hyper.Routing.Router" do 72 | let userResources userId = { profile: profileResource userId 73 | , friends: friendsResource userId 74 | } 75 | resources = { home: homeResource 76 | , user: userResources 77 | , wiki: wikiResource 78 | , about: aboutMiddleware 79 | , search: searchResource 80 | , searchMany: searchResource 81 | } 82 | 83 | onRoutingError status msg = do 84 | writeStatus status 85 | :*> headers [] 86 | :*> respond (maybe "" identity msg) 87 | 88 | makeRequestWithHeaders method path headers = 89 | { request: TestRequest defaultRequest { method = Left method 90 | , url = path 91 | , headers = headers 92 | } 93 | , response: TestResponse Nothing [] [] 94 | , components: {} 95 | } 96 | # evalMiddleware (router testSite resources onRoutingError) 97 | # testServer 98 | 99 | makeRequest method path = 100 | makeRequestWithHeaders method path (F.empty :: Object String) 101 | 102 | describe "router" do 103 | it "matches root" do 104 | conn <- makeRequest GET "/" 105 | testStringBody conn `shouldEqual` "

Home

" 106 | 107 | it "considers Accept header for multi-content-type resources" do 108 | conn <- makeRequestWithHeaders GET "/" (F.singleton "accept" "application/json") 109 | testStatus conn `shouldEqual` Just statusOK 110 | testStringBody conn `shouldEqual` "{}" 111 | 112 | it "validates based on custom Capture instance" do 113 | conn <- makeRequest GET "/users/ /profile" 114 | testStatus conn `shouldEqual` Just statusBadRequest 115 | testStringBody conn `shouldEqual` "UserID must not be blank." 116 | 117 | it "matches nested routes" do 118 | conn <- makeRequest GET "/users/owi/profile" 119 | testStringBody conn `shouldEqual` "{\"userId\":\"owi\"}" 120 | 121 | it "ignores extraneous query string parameters" do 122 | conn <- makeRequest GET "/users/owi/profile?bugs=bunny" 123 | testStringBody conn `shouldEqual` "{\"userId\":\"owi\"}" 124 | 125 | it "supports arrays of JSON values" do 126 | conn <- makeRequest GET "/users/owi/friends" 127 | testStringBody conn `shouldEqual` "[{\"userId\":\"foo\"},{\"userId\":\"bar\"}]" 128 | 129 | it "supports second method of resource with different representation" do 130 | conn <- makeRequest POST "/users/owi/friends" 131 | testStringBody conn `shouldEqual` "{\"userId\":\"new-user\"}" 132 | 133 | it "matches CaptureAll route" do 134 | conn <- makeRequest GET "/wiki/foo/bar/baz.txt" 135 | testStringBody conn `shouldEqual` "Viewing page: foo/bar/baz.txt" 136 | 137 | it "matches QueryParam route" do 138 | conn <- makeRequest GET "/search?q=bunny" 139 | testStringBody conn `shouldEqual` "{\"userId\":\"bunny\"}" 140 | 141 | it "matches QueryParam route with empty value" do 142 | conn <- makeRequest GET "/search?q" 143 | testStringBody conn `shouldEqual` "{\"userId\":\"\"}" 144 | 145 | it "matches QueryParam route with missing key" do 146 | conn <- makeRequest GET "/search?r=bunny" 147 | testStringBody conn `shouldEqual` "null" 148 | 149 | it "matches QueryParams route" do 150 | conn <- makeRequest GET "/search-many?q=bugs&q=bunny" 151 | testStringBody conn `shouldEqual` "[{\"userId\":\"bugs\"},{\"userId\":\"bunny\"}]" 152 | 153 | it "matches QueryParams route with empty value" do 154 | conn <- makeRequest GET "/search-many?q&q=bunny" 155 | testStringBody conn `shouldEqual` "[{\"userId\":\"\"},{\"userId\":\"bunny\"}]" 156 | 157 | it "matches QueryParams route with missing key" do 158 | conn <- makeRequest GET "/search-many?p&q=bunny" 159 | testStringBody conn `shouldEqual` "[{\"userId\":\"bunny\"}]" 160 | 161 | it "matches Raw route" do 162 | conn <- makeRequest GET "/about" 163 | testHeaders conn `shouldEqual` [ Tuple "Content-Type" "text/plain" ] 164 | testStringBody conn `shouldEqual` "This is a test." 165 | 166 | it "checks HTTP method" do 167 | conn <- makeRequest POST "/" 168 | testStatus conn `shouldEqual` Just statusMethodNotAllowed 169 | -------------------------------------------------------------------------------- /docs/src/index.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Hypertrout 3 | author: Oskar Wickström 4 | --- 5 | 6 | ## Purpose 7 | 8 | The purpose of this 9 | package, 10 | [Hypertrout](https://github.com/owickstrom/purescript-hypertrout), is 11 | writing web servers using the *type-level routing API* 12 | in [Trout](https://github.com/owickstrom/purescript-trout). It 13 | provides a router middleware which, together with records of handler 14 | functions for resources, and rendering instances, gives us a 15 | full-fledged server. 16 | 17 | ## A Single-Resource Example 18 | 19 | Let's say we want to render a home page as HTML. We start out by 20 | declaring the data type `Home`, and the structure of our site: 21 | 22 | ``` {.haskell language=purescript include=docs/src/Site1.purs snippet=routing-type} 23 | ``` 24 | 25 | `Resource (Get Home HTML)` is a routing type with only one resource, 26 | responding to HTTP GET requests, rendering a `Home` value as HTML. So 27 | where does the `Home` value come from? We provide it using a *handler* 28 | inside a resource record. A resource record for `Site1` would be some 29 | value of the following type: 30 | 31 | ``` {.haskell} 32 | forall m. Monad m => {"GET" :: ExceptT RoutingError m Home} 33 | ``` 34 | 35 | The resource record has fields for each supported HTTP method, with values 36 | being the corresponding handlers. A resource record type, supporting both GET 37 | and POST, could have the following type: 38 | 39 | ``` {.haskell} 40 | forall m. Monad m => { "GET" :: ExceptT RoutingError m SomeType 41 | , "POST" :: ExceptT RoutingError m SomeType 42 | } 43 | ``` 44 | 45 | We can construct a resource record for the `Site1` routing type using `pure` 46 | and a `Home` value: 47 | 48 | ``` {.haskell language=purescript include=docs/src/Site1.purs snippet=handler} 49 | ``` 50 | 51 | Nice! But what comes out on the other end? We need something that 52 | renders the `Home` value as HTML. By providing an instance of 53 | `EncodeHTML` for `Home`, we instruct the resource how to render. 54 | 55 | ``` {.haskell include=docs/src/Site1.purs snippet=encoding} 56 | ``` 57 | 58 | The `HTML` type is a phantom type, only used as a marker type, and the 59 | actual markup is written in the `MarkupM` DSL from 60 | [purescript-smolder](https://github.com/bodil/purescript-smolder). 61 | 62 | We are getting ready to create the server. First, we need a value-level 63 | representation of the `Site1` type, to be able to pass it to the 64 | `router` function. For that we use 65 | [Proxy](https://pursuit.purescript.org/packages/purescript-proxy/1.0.0/docs/Type.Proxy). 66 | Its documentation describes it as follows: 67 | 68 | > The Proxy type and values are for situations where type information is 69 | > required for an input to determine the type of an output, but where it 70 | > is not possible or convenient to provide a value for the input. 71 | 72 | We create a top-level definition of the type `Proxy Site1` with the 73 | value constructor `Proxy`. 74 | 75 | ``` {.haskell include=docs/src/Site1.purs snippet=proxy} 76 | ``` 77 | 78 | We pass the proxy, our handler, and the `onRoutingError` function for 79 | cases where no route matched the request, to the `router` function. 80 | 81 | ``` {.haskell include=docs/src/Site1.purs snippet=router} 82 | ``` 83 | 84 | The value returned by `router` is regular middleware, ready to be passed 85 | to a server. 86 | 87 | ``` {.haskell include=docs/src/Site1.purs snippet=main} 88 | ``` 89 | 90 | ## Routing Multiple Resources 91 | 92 | Real-world servers often need more than one resource. To combine 93 | multiple resources, resource routing types are separated using the 94 | `:<|>` operator, the type-level operator for separating 95 | *alternatives*. 96 | 97 | ``` {.haskell} 98 | RoutingType1 :<|> RoutingType2 :<|> ... :<|> RoutingTypeN 99 | ``` 100 | 101 | When combining multiple resources in a routing type, each resource has 102 | to be named. The `:=` type-level operator names a resource, or another 103 | nested structure of resources, using a Symbol on the left-hand side, 104 | and a routing type on the right-hand side. 105 | 106 | ``` {.haskell} 107 | "" := RoutingType 108 | ``` 109 | 110 | The following is a routing type for two resources, named `"foo"` and 111 | `"bar"`: 112 | 113 | ``` {.haskell} 114 | "foo" := Resource (Get Foo HTML) 115 | :<|> "bar" := Resource (Get Bar HTML) 116 | ``` 117 | 118 | Named routes can be nested to create a structure of arbitrary depth, a 119 | practice useful for grouping related resources: 120 | 121 | ``` {.haskell} 122 | type UserResources = 123 | "profile" := Resource (Get UserProfile HTML) 124 | :<|> "settings" := Resource (Get UserSettings HTML) 125 | 126 | type AdminResources = 127 | "users" := Resource (Get Users HTML) 128 | :<|> "logs" := Resource (Get Logs HTML) 129 | 130 | type MyNestedResources = 131 | "user" := UserResources 132 | :<|> "admin" := AdminResources 133 | ``` 134 | 135 | ### Example 136 | 137 | Let's define a router for an application that shows a home page with 138 | links, a page listing users, and a page rendering a specific user. 139 | 140 | ``` {.haskell include=docs/src/Site2.purs snippet=resources-and-type} 141 | ``` 142 | 143 | There are some new things in this code that we haven't talked about, 144 | and some we touched upon a bit. Here's a walk-through of what's going 145 | on: 146 | 147 | - `:<|>` is the type-level operator that, in general, separates 148 | alternatives. In case of resources, a router will try each route 149 | in order until one matches. 150 | - `:=` names a route, where the left-hand argument is a Symbol, the 151 | name, and the right-hand argument is a routing type. Named routes 152 | are combined with `:<|>`, as explained previously. 153 | - `:/` separates a literal path segment and the rest of the routing 154 | type. Note that a named routing type, created with `:=`, has no relation 155 | to literal path segments. In other words, if want a resource named 156 | `"foo"` to be served under the path `/foo`, we write: 157 | ``` {.haskell} 158 | "foo" := "foo" :/ ... 159 | ``` 160 | - `Capture` takes a descriptive string and a type. It takes the next 161 | available path segment and tries to convert it to the given type. 162 | Each capture in a routing type corresponds to an argument in the 163 | handler function. 164 | - `:>` separates a routing type modifier, like `Capture`, and the rest 165 | of the routing type. 166 | 167 | We define a resource record using regular functions on the specified data 168 | types, returning `ExceptT RoutingError m a` values, where `m` is the monad of 169 | our middleware, and `a` is the type to render for the resource and method. 170 | 171 | ``` {.haskell include=docs/src/Site2.purs snippet=handlers} 172 | ``` 173 | 174 | As in the single-resource example, we want to render as HTML. Let's 175 | create instances for our data types. Notice how we can create links 176 | between routes in a type-safe manner. 177 | 178 | ``` {.haskell include=docs/src/Site2.purs snippet=encoding} 179 | ``` 180 | 181 | The record destructuring on the value returned by `linksTo` extracts the 182 | correct link, based on the names from the routing type. Each link will have a 183 | type based on the corresponding resource. `user` in the previous code has 184 | type `Int -> URI`, while `users` has no captures and thus has type `URI`. 185 | 186 | We are still missing `getUsers`, our source of `User` values. In a real 187 | application it would probably be a database query, but for this example 188 | we simply hard-code some famous users of proper instruments. 189 | 190 | ``` {.haskell include=docs/src/Site2.purs snippet=get-users} 191 | ``` 192 | 193 | Almost done! We just need to create the router, and start a server. 194 | 195 | ``` {.haskell include=docs/src/Site2.purs snippet=main} 196 | ``` 197 | 198 | Notice how the `resources` record matches the names and structure of our 199 | routing type. If we fail to match the type we get a compile error. 200 | 201 | ## Multi-Method Resources 202 | 203 | So far we have just used a single method per resource, the `Get` method. 204 | By replacing the single method type with a sequence of alternatives, 205 | constructed with the type-level operator `:<|>`, we get a resource with 206 | multiple methods. 207 | 208 | ``` {.haskell include=docs/src/MultiMethodExample.purs snippet=routing-type} 209 | ``` 210 | 211 | `MultiMethodExample` is a routing type with a *single resource*, named 212 | `"user"`, which has *multiple resource methods*. Handlers for the 213 | resource methods are provided as a record value, with field names 214 | matching the HTTP methods: 215 | 216 | ``` {.haskell include=docs/src/MultiMethodExample.purs snippet=resources} 217 | ``` 218 | 219 | ## Content Negotiation 220 | 221 | By specifying alternative content types for a method, Hyper can choose 222 | a response and content type based on the request `Accept` header. This 223 | is called *content negotiation*. Instead of specifying a single type, 224 | like `HTML` or `JSON`, we provide alternatives using `:<|>`. All content 225 | types must have `MimeRender` instances for the response body type. 226 | 227 | ``` {.haskell include=docs/src/Site3.purs snippet=routing-type} 228 | ``` 229 | 230 | By making requests to this site, using `Accept` headers, we can see how 231 | the router chooses the matching content type (output formatted and 232 | shortened for readability). 233 | 234 | ``` {.bash} 235 | $ curl -H 'Accept: application/json' http://localhost:3000/users 236 | [ 237 | { 238 | "name": "John Paul Jones", 239 | "id": "1" 240 | }, 241 | { 242 | "name": "Tal Wilkenfeld", 243 | "id": "2" 244 | }, 245 | ... 246 | ] 247 | ``` 248 | 249 | There is support for *wildcards* and *qualities* as well. 250 | 251 | ``` {.bash} 252 | $ curl -H 'Accept: text/*;q=1.0' http://localhost:3000/users 253 |
254 |

Users

255 | 260 |
261 | ``` 262 | -------------------------------------------------------------------------------- /src/Hyper/Trout/Router.purs: -------------------------------------------------------------------------------- 1 | module Hyper.Trout.Router 2 | ( RoutingError(..) 3 | , class Router 4 | , route 5 | , router 6 | ) where 7 | 8 | import Prelude 9 | import Data.HTTP.Method as Method 10 | import Type.Trout as Trout 11 | import Type.Trout.Record as Record 12 | import Control.Monad.Error.Class (throwError) 13 | import Control.Monad.Except (ExceptT, runExceptT) 14 | import Control.Monad.Indexed (ibind, (:*>)) 15 | import Data.Array (elem, filter, null, uncons) 16 | import Data.Either (Either(..), either) 17 | import Data.Generic.Rep (class Generic) 18 | import Data.Generic.Rep.Eq (genericEq) 19 | import Data.Generic.Rep.Show (genericShow) 20 | import Data.HTTP.Method (CustomMethod, Method) 21 | import Data.Lazy (force) 22 | import Data.Maybe (Maybe(..), fromMaybe) 23 | import Data.MediaType.Common (textPlain) 24 | import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) 25 | import Data.Traversable (traverse) 26 | import Data.Tuple (Tuple(..), fst, lookup, snd) 27 | import Foreign.Object (Object) 28 | import Foreign.Object (lookup) as F 29 | import Hyper.Conn (Conn) 30 | import Hyper.ContentNegotiation (AcceptHeader, NegotiationResult(..), negotiateContent, parseAcceptHeader) 31 | import Hyper.Middleware (Middleware, lift') 32 | import Hyper.Request (class Request, getRequestData) 33 | import Hyper.Response (class Response, class ResponseWritable, ResponseEnded, StatusLineOpen, closeHeaders, contentType, end, respond, writeStatus) 34 | import Hyper.Status (Status, statusBadRequest, statusMethodNotAllowed, statusNotAcceptable, statusNotFound, statusOK) 35 | import Prim.Row (class Cons) 36 | import Type.Proxy (Proxy(..)) 37 | import Type.Trout (type (:<|>), type (:=), type (:>), Capture, CaptureAll, QueryParam, QueryParams, Lit, Raw) 38 | import Type.Trout.ContentType (class AllMimeRender, allMimeRender) 39 | import Type.Trout.PathPiece (class FromPathPiece, fromPathPiece) 40 | 41 | type Method' = Either Method CustomMethod 42 | 43 | type RoutingContext = { path :: Array String 44 | , query :: Array (Tuple String (Maybe String)) 45 | , method :: Method' 46 | } 47 | 48 | data RoutingError 49 | = HTTPError { status :: Status 50 | , message :: Maybe String 51 | } 52 | 53 | type Handler r = Either RoutingError r 54 | 55 | derive instance genericRoutingError :: Generic RoutingError _ 56 | 57 | instance eqRoutingError :: Eq RoutingError where 58 | eq = genericEq 59 | 60 | instance showRoutingError :: Show RoutingError where 61 | show = genericShow 62 | 63 | class Router e h r | e -> h, e -> r where 64 | route :: Proxy e -> RoutingContext -> h -> Handler r 65 | 66 | orHandler :: forall r. Handler r -> Handler r -> Handler r 67 | orHandler h1 h2 = 68 | case h1 of 69 | Left err1 -> 70 | case h2 of 71 | -- The Error that's thrown depends on the errors' HTTP codes. 72 | Left err2 -> throwError (selectError err1 err2) 73 | Right handler -> pure handler 74 | Right handler -> pure handler 75 | where 76 | fallbackStatuses = [statusNotFound, statusMethodNotAllowed] 77 | selectError (HTTPError errL) (HTTPError errR) = 78 | case Tuple errL.status errR.status of 79 | Tuple s1 s2 80 | | s1 `elem` fallbackStatuses && s2 == statusNotFound -> HTTPError errL 81 | | s1 /= statusNotFound && s2 `elem` fallbackStatuses -> HTTPError errL 82 | | otherwise -> HTTPError errR 83 | 84 | instance routerAltNamed :: ( Router t1 h1 out 85 | , Router t2 (Record h2) out 86 | , IsSymbol name 87 | , Cons name h1 h2 hs 88 | ) 89 | => Router (name := t1 :<|> t2) (Record hs) out where 90 | route _ context handlers = 91 | route (Proxy :: Proxy t1) context (Record.get name handlers) 92 | `orHandler` 93 | route (Proxy :: Proxy t2) context (Record.delete name handlers) 94 | where 95 | name = SProxy :: SProxy name 96 | 97 | instance routerNamed :: ( Router t h out 98 | , IsSymbol name 99 | , Cons name h () hs 100 | ) 101 | => Router (name := t) (Record hs) out where 102 | route _ context handlers = 103 | route (Proxy :: Proxy t) context (Record.get (SProxy :: SProxy name) handlers) 104 | 105 | instance routerLit :: ( Router e h out 106 | , IsSymbol lit 107 | ) 108 | => Router (Lit lit :> e) h out where 109 | route _ ctx r = 110 | case uncons ctx.path of 111 | Just { head, tail } | head == expectedSegment -> 112 | route (Proxy :: Proxy e) ctx { path = tail} r 113 | Just _ -> throwError (HTTPError { status: statusNotFound 114 | , message: Nothing 115 | }) 116 | Nothing -> throwError (HTTPError { status: statusNotFound 117 | , message: Nothing 118 | }) 119 | where expectedSegment = reflectSymbol (SProxy :: SProxy lit) 120 | 121 | instance routerCapture :: ( Router e h out 122 | , FromPathPiece v 123 | ) 124 | => Router (Capture c v :> e) (v -> h) out where 125 | route _ ctx r = 126 | case uncons ctx.path of 127 | Nothing -> throwError (HTTPError { status: statusNotFound 128 | , message: Nothing 129 | }) 130 | Just { head, tail } -> 131 | case fromPathPiece head of 132 | Left err -> throwError (HTTPError { status: statusBadRequest 133 | , message: Just err 134 | }) 135 | Right x -> route (Proxy :: Proxy e) ctx { path = tail } (r x) 136 | 137 | 138 | instance routerCaptureAll :: ( Router e h out 139 | , FromPathPiece v 140 | ) 141 | => Router (CaptureAll c v :> e) (Array v -> h) out where 142 | route _ ctx r = 143 | case traverse fromPathPiece ctx.path of 144 | Left err -> throwError (HTTPError { status: statusBadRequest 145 | , message: Just err 146 | }) 147 | Right xs -> route (Proxy :: Proxy e) ctx { path = [] } (r xs) 148 | 149 | 150 | instance routerQueryParam :: ( IsSymbol k 151 | , Router e h out 152 | , FromPathPiece t 153 | ) 154 | => Router (QueryParam k t :> e) (Maybe t -> h) out where 155 | route _ ctx r = 156 | let k = reflectSymbol (SProxy :: SProxy k) 157 | v = map (fromMaybe "") $ lookup k $ ctx.query in 158 | case fromPathPiece <$> v of 159 | Nothing -> go Nothing 160 | Just (Right v') -> go (Just v') 161 | Just (Left err) -> throwError (HTTPError { status: statusBadRequest 162 | , message: Just err 163 | }) 164 | where go = route (Proxy :: Proxy e) ctx <<< r 165 | 166 | 167 | instance routerQueryParams :: ( IsSymbol k 168 | , Router e h out 169 | , FromPathPiece t 170 | ) 171 | => Router (QueryParams k t :> e) (Array t -> h) out where 172 | route _ ctx r = 173 | let k = reflectSymbol (SProxy :: SProxy k) 174 | v = map (fromMaybe "" <<< snd) $ filter ((==) k <<< fst) $ ctx.query in 175 | case traverse fromPathPiece v of 176 | Right v' -> go v' 177 | Left err -> throwError (HTTPError { status: statusBadRequest 178 | , message: Just err 179 | }) 180 | where go = route (Proxy :: Proxy e) ctx <<< r 181 | 182 | 183 | routeEndpoint :: forall e r method 184 | . IsSymbol method 185 | => Proxy e 186 | -> RoutingContext 187 | -> r 188 | -> SProxy method 189 | -> Either RoutingError r 190 | routeEndpoint _ context r methodProxy = do 191 | unless (null context.path) $ 192 | throwError (HTTPError { status: statusNotFound 193 | , message: Nothing 194 | }) 195 | 196 | let expectedMethod = Method.fromString (reflectSymbol methodProxy) 197 | unless (expectedMethod == context.method) $ 198 | throwError (HTTPError { status: statusMethodNotAllowed 199 | , message: Just ("Method " 200 | <> show context.method 201 | <> " did not match " 202 | <> show expectedMethod 203 | <> ".") 204 | }) 205 | pure r 206 | 207 | getAccept :: Object String -> Either String (Maybe AcceptHeader) 208 | getAccept m = 209 | case F.lookup "accept" m of 210 | Just a -> Just <$> parseAcceptHeader a 211 | Nothing -> pure Nothing 212 | 213 | instance routerAltMethod :: ( IsSymbol method 214 | , Router (Trout.Method method body ct) (Record hs) out 215 | , Router methods (Record hs) out 216 | ) 217 | => Router 218 | (Trout.Method method body ct :<|> methods) 219 | (Record hs) 220 | out 221 | where 222 | route _ context handlers = 223 | route (Proxy :: Proxy (Trout.Method method body ct)) context handlers 224 | `orHandler` 225 | route (Proxy :: Proxy methods) context handlers 226 | 227 | instance routerMethod :: ( Monad m 228 | , Request req m 229 | , Response res m r 230 | , ResponseWritable r m b 231 | , IsSymbol method 232 | , AllMimeRender body ct b 233 | , Cons method (ExceptT RoutingError m body) hs' hs 234 | ) 235 | => Router 236 | (Trout.Method method body ct) 237 | (Record hs) 238 | (Middleware 239 | m 240 | { request :: req, response :: (res StatusLineOpen), components :: c} 241 | { request :: req, response :: (res ResponseEnded), components :: c} 242 | Unit) 243 | where 244 | route proxy context handlers = do 245 | let handler = lift' (runExceptT (Record.get (SProxy :: SProxy method) handlers)) `ibind` 246 | case _ of 247 | Left (HTTPError { status }) -> do 248 | writeStatus status 249 | :*> contentType textPlain 250 | :*> closeHeaders 251 | :*> end 252 | Right body -> do 253 | { headers } <- getRequestData 254 | case getAccept headers of 255 | Left err -> do 256 | writeStatus statusBadRequest 257 | :*> contentType textPlain 258 | :*> closeHeaders 259 | :*> end 260 | Right parsedAccept -> do 261 | case negotiateContent parsedAccept (allMimeRender (Proxy :: Proxy ct) body) of 262 | Match (Tuple ct rendered) -> do 263 | writeStatus statusOK 264 | :*> contentType ct 265 | :*> closeHeaders 266 | :*> respond rendered 267 | Default (Tuple ct rendered) -> do 268 | writeStatus statusOK 269 | :*> contentType ct 270 | :*> closeHeaders 271 | :*> respond rendered 272 | NotAcceptable _ -> do 273 | writeStatus statusNotAcceptable 274 | :*> contentType textPlain 275 | :*> closeHeaders 276 | :*> end 277 | routeEndpoint proxy context handler (SProxy :: SProxy method) 278 | where bind = ibind 279 | 280 | instance routerRaw :: IsSymbol method 281 | => Router 282 | (Raw method) 283 | (Middleware 284 | m 285 | { request :: req 286 | , response :: (res StatusLineOpen) 287 | , components :: c 288 | } 289 | { request :: req 290 | , response :: (res ResponseEnded) 291 | , components :: c 292 | } 293 | Unit) 294 | (Middleware 295 | m 296 | { request :: req 297 | , response :: (res StatusLineOpen) 298 | , components :: c 299 | } 300 | { request :: req 301 | , response :: (res ResponseEnded) 302 | , components :: c 303 | } 304 | Unit) 305 | where 306 | route proxy context r = 307 | routeEndpoint proxy context r (SProxy :: SProxy method) 308 | 309 | 310 | instance routerResource :: ( Router methods h out 311 | ) 312 | => Router (Trout.Resource methods) h out where 313 | route proxy = route (Proxy :: Proxy methods) 314 | 315 | 316 | router 317 | :: forall s r m req res c 318 | . Monad m 319 | => Request req m 320 | => Router s r (Middleware 321 | m 322 | (Conn req (res StatusLineOpen) c) 323 | (Conn req (res ResponseEnded) c) 324 | Unit) 325 | => Proxy s 326 | -> r 327 | -> (Status 328 | -> Maybe String 329 | -> Middleware 330 | m 331 | (Conn req (res StatusLineOpen) c) 332 | (Conn req (res ResponseEnded) c) 333 | Unit) 334 | -> Middleware 335 | m 336 | (Conn req (res StatusLineOpen) c) 337 | (Conn req (res ResponseEnded) c) 338 | Unit 339 | router site handler onRoutingError = do 340 | handler' 341 | -- Run the routing to get a handler. 342 | -- route (Proxy :: Proxy s) ctx handler 343 | -- Then, if successful, run the handler, possibly also generating an HTTPError. 344 | -- # either catch runHandler 345 | where 346 | context { parsedUrl, method } = 347 | let parsedUrl' = force parsedUrl in 348 | { path: parsedUrl'.path 349 | , query: either (const []) identity parsedUrl'.query 350 | , method: method 351 | } 352 | catch (HTTPError { status, message }) = 353 | onRoutingError status message 354 | 355 | handler' ∷ Middleware 356 | m 357 | (Conn req (res StatusLineOpen) c) 358 | (Conn req (res ResponseEnded) c) 359 | Unit 360 | handler' = do 361 | ctx <- context <$> getRequestData 362 | case route site ctx handler of 363 | Left err → catch err 364 | Right h → h 365 | 366 | bind = ibind 367 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | Hypertrout 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 | 40 | 41 | 42 |
43 |

Hypertrout

44 |

Build servers in Hyper using Trout

45 | 46 |
47 |

Contents

48 | 59 |

Purpose

60 |

The purpose of this package, Hypertrout, is writing web servers using the type-level routing API in Trout. It provides a router middleware which, together with records of handler functions for resources, and rendering instances, gives us a full-fledged server.

61 |

A Single-Resource Example

62 |

Let’s say we want to render a home page as HTML. We start out by declaring the data type Home, and the structure of our site:

63 | 
data Home = Home
 64 | 
 65 | type Site1 = Resource (Get Home HTML)
66 |

Resource (Get Home HTML) is a routing type with only one resource, responding to HTTP GET requests, rendering a Home value as HTML. So where does the Home value come from? We provide it using a handler inside a resource record. A resource record for Site1 would be some value of the following type:

67 | 
forall m. Monad m => {"GET" :: ExceptT RoutingError m Home}
68 |

The resource record has fields for each supported HTTP method, with values being the corresponding handlers. A resource record type, supporting both GET and POST, could have the following type:

69 | 
forall m. Monad m => { "GET" :: ExceptT RoutingError m SomeType
 70 |                      , "POST" :: ExceptT RoutingError m SomeType
 71 |                      }
72 |

We can construct a resource record for the Site1 routing type using pure and a Home value:

73 | 
home :: forall m. Applicative m => {"GET" :: m Home}
 74 | home = {"GET": pure Home}
75 |

Nice! But what comes out on the other end? We need something that renders the Home value as HTML. By providing an instance of EncodeHTML for Home, we instruct the resource how to render.

76 | 
instance encodeHTMLHome :: EncodeHTML Home where
 77 |   encodeHTML Home =
 78 |     p (text "Welcome to my site!")
79 |

The HTML type is a phantom type, only used as a marker type, and the actual markup is written in the MarkupM DSL from purescript-smolder.

80 |

We are getting ready to create the server. First, we need a value-level representation of the Site1 type, to be able to pass it to the router function. For that we use Proxy. Its documentation describes it as follows:

81 |
82 |

The Proxy type and values are for situations where type information is required for an input to determine the type of an output, but where it is not possible or convenient to provide a value for the input.

83 |
84 |

We create a top-level definition of the type Proxy Site1 with the value constructor Proxy.

85 | 
site1 :: Proxy Site1
 86 | site1 = Proxy
87 |

We pass the proxy, our handler, and the onRoutingError function for cases where no route matched the request, to the router function.

88 | 
    onRoutingError status msg =
 89 |       writeStatus status
 90 |       :*> contentType textHTML
 91 |       :*> closeHeaders
 92 |       :*> respond (maybe "" id msg)
 93 | 
 94 |     siteRouter = router site1 home onRoutingError
95 |

The value returned by router is regular middleware, ready to be passed to a server.

96 | 
main :: forall e. Eff (http :: HTTP, console :: CONSOLE, buffer :: BUFFER | e) Unit
 97 | main =
 98 |   runServer defaultOptions {} siteRouter
99 |

Routing Multiple Resources

100 |

Real-world servers often need more than one resource. To combine multiple resources, resource routing types are separated using the :<|> operator, the type-level operator for separating alternatives.

101 | 
RoutingType1 :<|> RoutingType2 :<|> ... :<|> RoutingTypeN
102 |

When combining multiple resources in a routing type, each resource has to be named. The := type-level operator names a resource, or another nested structure of resources, using a Symbol on the left-hand side, and a routing type on the right-hand side.

103 | 
"<resource-name>" := RoutingType
104 |

The following is a routing type for two resources, named "foo" and "bar":

105 | 
     "foo" := Resource (Get Foo HTML)
106 | :<|> "bar" := Resource (Get Bar HTML)
107 |

Named routes can be nested to create a structure of arbitrary depth, a practice useful for grouping related resources:

108 | 
type UserResources =
109 |        "profile"  := Resource (Get UserProfile HTML)
110 |   :<|> "settings" := Resource (Get UserSettings HTML)
111 | 
112 | type AdminResources =
113 |        "users" := Resource (Get Users HTML)
114 |   :<|> "logs"  := Resource (Get Logs HTML)
115 | 
116 | type MyNestedResources =
117 |        "user"  := UserResources
118 |   :<|> "admin" := AdminResources
119 |

Example

120 |

Let’s define a router for an application that shows a home page with links, a page listing users, and a page rendering a specific user.

121 | 
data Home = Home
122 | 
123 | data AllUsers = AllUsers (Array User)
124 | 
125 | newtype User = User { id :: Int, name :: String }
126 | 
127 | type Site2 =
128 |        "home"  := Resource (Get Home HTML)
129 |   :<|> "users" := "users" :/ Resource (Get AllUsers HTML)
130 |   :<|> "user"  := "users" :/ Capture "user-id" Int
131 |                           :> Resource (Get User HTML)
132 | 
133 | site2 :: Proxy Site2
134 | site2 = Proxy
135 |

There are some new things in this code that we haven’t talked about, and some we touched upon a bit. Here’s a walk-through of what’s going on:

136 | 144 |

We define a resource record using regular functions on the specified data types, returning ExceptT RoutingError m a values, where m is the monad of our middleware, and a is the type to render for the resource and method.

145 | 
homeResource :: forall m. Monad m => {"GET" :: ExceptT RoutingError m Home}
146 | homeResource = {"GET": pure Home}
147 | 
148 | usersResource :: forall m. Monad m => {"GET" :: ExceptT RoutingError m AllUsers}
149 | usersResource = {"GET": AllUsers <$> getUsers}
150 | 
151 | userResource :: forall m. Monad m => Int -> {"GET" :: ExceptT RoutingError m User}
152 | userResource id' =
153 |   {"GET":
154 |    find (\(User u) -> u.id == id') <$> getUsers >>=
155 |    case _ of
156 |        Just user -> pure user
157 |        Nothing ->
158 |        throwError (HTTPError { status: statusNotFound
159 |                                , message: Just "User not found."
160 |                                })
161 |   }
162 |

As in the single-resource example, we want to render as HTML. Let’s create instances for our data types. Notice how we can create links between routes in a type-safe manner.

163 | 
instance encodeHTMLHome :: EncodeHTML Home where
164 |   encodeHTML Home =
165 |     let {users} = linksTo site2
166 |     in p do
167 |       text "Welcome to my site! Go check out my "
168 |       linkTo users (text "Users")
169 |       text "."
170 | 
171 | instance encodeHTMLAllUsers :: EncodeHTML AllUsers where
172 |   encodeHTML (AllUsers users) =
173 |     div do
174 |       h1 (text "Users")
175 |       ul (traverse_ linkToUser users)
176 |     where
177 |       linkToUser (User u) =
178 |         let {user} = linksTo site2
179 |         in li (linkTo (user u.id) (text u.name))
180 | 
181 | instance encodeHTMLUser :: EncodeHTML User where
182 |   encodeHTML (User { name }) =
183 |     h1 (text name)
184 |

The record destructuring on the value returned by linksTo extracts the correct link, based on the names from the routing type. Each link will have a type based on the corresponding resource. user in the previous code has type Int -> URI, while users has no captures and thus has type URI.

185 |

We are still missing getUsers, our source of User values. In a real application it would probably be a database query, but for this example we simply hard-code some famous users of proper instruments.

186 | 
getUsers :: forall m. Applicative m => m (Array User)
187 | getUsers =
188 |   pure
189 |   [ User { id: 1, name: "John Paul Jones" }
190 |   , User { id: 2, name: "Tal Wilkenfeld" }
191 |   , User { id: 3, name: "John Patitucci" }
192 |   , User { id: 4, name: "Jaco Pastorious" }
193 |   ]
194 |

Almost done! We just need to create the router, and start a server.

195 | 
main :: forall e. Eff (http :: HTTP, console :: CONSOLE, buffer :: BUFFER | e) Unit
196 | main =
197 |   let resources = { home: homeResource
198 |                   , users: usersResource
199 |                   , user: userResource
200 |                   }
201 | 
202 |       otherSiteRouter =
203 |         router site2 resources onRoutingError
204 | 
205 |       onRoutingError status msg =
206 |         writeStatus status
207 |         :*> contentType textHTML
208 |         :*> closeHeaders
209 |         :*> respond (maybe "" id msg)
210 | 
211 |   in runServer defaultOptions {} otherSiteRouter
212 |

Notice how the resources record matches the names and structure of our routing type. If we fail to match the type we get a compile error.

213 |

Multi-Method Resources

214 |

So far we have just used a single method per resource, the Get method. By replacing the single method type with a sequence of alternatives, constructed with the type-level operator :<|>, we get a resource with multiple methods.

215 | 
type MultiMethodExample =
216 |   "user" := Resource (Get User HTML :<|> Delete User HTML)
217 |

MultiMethodExample is a routing type with a single resource, named "user", which has multiple resource methods. Handlers for the resource methods are provided as a record value, with field names matching the HTTP methods:

218 | 
      resources =
219 |         { user: { "GET": getUser
220 |                 , "DELETE": deleteUser
221 |                 }
222 |         }
223 |

Content Negotiation

224 |

By specifying alternative content types for a method, Hyper can choose a response and content type based on the request Accept header. This is called content negotiation. Instead of specifying a single type, like HTML or JSON, we provide alternatives using :<|>. All content types must have MimeRender instances for the response body type.

225 | 
type Site3 =
226 |        "home"  := Resource (Get Home HTML)
227 |   :<|> "users" := "users" :/ Resource (Get AllUsers (HTML :<|> JSON))
228 |   :<|> "user"  := "users" :/ Capture "user-id" Int
229 |                           :> Resource (Get User (HTML :<|> JSON))
230 |

By making requests to this site, using Accept headers, we can see how the router chooses the matching content type (output formatted and shortened for readability).

231 | 
$ <strong>curl -H 'Accept: application/json' http://localhost:3000/users</strong>
232 | [
233 |   {
234 |     "name": "John Paul Jones",
235 |     "id": "1"
236 |   },
237 |   {
238 |     "name": "Tal Wilkenfeld",
239 |     "id": "2"
240 |   },
241 |   ...
242 | ]
243 |

There is support for wildcards and qualities as well.

244 | 
$ curl -H 'Accept: text/*;q=1.0' http://localhost:3000/users
245 | <div>
246 |   <h1>Users</h1>
247 |   <ul>
248 |     <li><a href="/users/1">John Paul Jones</a></li>
249 |     <li><a href="/users/2">Tal Wilkenfeld</a></li>
250 |     ...
251 |   </ul>
252 | </div>
253 |
254 | Hypertrout 255 | — 256 | 0677466 257 | — 258 | © Copyright 2016-2017 Oskar Wickström 259 | — 260 | Licensed under MPL-2.0 261 |
262 | 263 | 264 | 265 | --------------------------------------------------------------------------------