├── .github └── workflows │ └── test.yml ├── .gitignore ├── LICENSE ├── META6.json ├── README.md ├── examples ├── README.pod ├── basic │ ├── .humming-bird.json │ ├── basic.raku │ ├── basic.txt │ └── favicon.ico ├── dbiish │ ├── create-db.sql │ └── dbiish.raku ├── docker │ ├── Dockerfile │ ├── README.md │ └── app.raku ├── mvc │ ├── META6-example.json │ ├── bin │ │ └── foo │ ├── lib │ │ └── App │ │ │ ├── Controller │ │ │ ├── Bar.rakumod │ │ │ └── Foo.rakumod │ │ │ ├── Foo.rakumod │ │ │ ├── Foo │ │ │ └── Render.rakumod │ │ │ └── Model │ │ │ ├── Bar.rakumod │ │ │ └── Foo.rakumod │ └── templates │ │ ├── bars.mustache │ │ ├── foos.mustache │ │ ├── footer.mustache │ │ └── header.mustache └── rest │ └── rest.raku ├── it ├── 01-basic.rakutest ├── 02-error-handlers.rakutest ├── 03-middlewares.rakutest ├── 04-catch-all-routes.rakutest ├── 05-custom-addr.rakutest └── 06-hotreload.rakutest ├── lib └── Humming-Bird │ ├── Advice.rakumod │ ├── Backend.rakumod │ ├── Backend │ └── HTTPServer.rakumod │ ├── Core.rakumod │ ├── Glue.rakumod │ ├── Middleware.rakumod │ ├── Plugin.rakumod │ └── Plugin │ ├── Config.rakumod │ ├── DBIish.rakumod │ ├── HotReload.rakumod │ ├── Logger.rakumod │ ├── Session.rakumod │ └── SlapbirdAPM.rakumod ├── sparrow.yaml └── t ├── 01-basic.rakutest ├── 02-request_encoding.rakutest ├── 03-response_decoding.rakutest ├── 04-middleware.rakutest ├── 05-cookie.rakutest ├── 06-redirect.rakutest ├── 07-advice.rakutest ├── 08-static.rakutest ├── 09-routers.rakutest ├── 10-content-guessing.rakutest ├── 11-advanced-query.rakutest ├── 12-headers.rakutest ├── 13-plugin.rakutest ├── 14-hotreload.rakutest ├── lib └── Humming-Bird │ └── Test.rakumod ├── opt ├── plugin-dbiish-sad.rakutest └── plugin-dbiish.rakutest └── static ├── .humming-bird.json ├── baobao.jpg └── test.css /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: test 2 | 3 | on: 4 | push: 5 | branches: 6 | - 'main' 7 | tags-ignore: 8 | - '*' 9 | pull_request: 10 | 11 | jobs: 12 | raku: 13 | strategy: 14 | matrix: 15 | os: 16 | - ubuntu-latest 17 | - macos-latest 18 | raku-version: 19 | - "2023.09" 20 | - "2023.08" 21 | - "latest" 22 | runs-on: ${{ matrix.os }} 23 | steps: 24 | - uses: actions/checkout@v3 25 | - uses: Raku/setup-raku@v1 26 | with: 27 | raku-version: ${{ matrix.raku-version }} 28 | - name: Install Dependencies 29 | run: zef install --/test --test-depends --deps-only . 30 | - name: Install optional depedendencies 31 | run: zef install --/test DBIish 32 | - name: Install App::Prove6 33 | run: zef install --/test App::Prove6 34 | - name: Run Tests 35 | run: prove6 -I. t/ it/ 36 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .precomp 2 | .gitconfig 3 | sdist 4 | *.db 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022-2023 Rawley F 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /META6.json: -------------------------------------------------------------------------------- 1 | { 2 | "auth": "zef:rawleyfowler", 3 | "authors": [ 4 | "Rawley Fowler" 5 | ], 6 | "build-depends": [ 7 | ], 8 | "depends": [ 9 | "HTTP::Status:auth", 10 | "DateTime::Format:auth", 11 | "MIME::Types:auth", 12 | "JSON::Fast:auth", 13 | "URI::Encode:auth", 14 | "Terminal::ANSIColor:auth", 15 | "File::Find:auth", 16 | "HTTP::Tiny:auth", 17 | "Cro::HTTP::Client", 18 | "ULID" 19 | ], 20 | "description": "A simple and composable web applications framework.", 21 | "license": "MIT", 22 | "name": "Humming-Bird", 23 | "raku": "6.d", 24 | "provides": { 25 | "Humming-Bird::Core": "lib/Humming-Bird/Core.rakumod", 26 | "Humming-Bird::Backend": "lib/Humming-Bird/Backend.rakumod", 27 | "Humming-Bird::Backend::HTTPServer": "lib/Humming-Bird/Backend/HTTPServer.rakumod", 28 | "Humming-Bird::Middleware": "lib/Humming-Bird/Middleware.rakumod", 29 | "Humming-Bird::Advice": "lib/Humming-Bird/Advice.rakumod", 30 | "Humming-Bird::Glue": "lib/Humming-Bird/Glue.rakumod", 31 | "Humming-Bird::Plugin": "lib/Humming-Bird/Plugin.rakumod", 32 | "Humming-Bird::Plugin::Config": "lib/Humming-Bird/Plugin/Config.rakumod", 33 | "Humming-Bird::Plugin::Logger": "lib/Humming-Bird/Plugin/Logger.rakumod", 34 | "Humming-Bird::Plugin::Session": "lib/Humming-Bird/Plugin/Session.rakumod", 35 | "Humming-Bird::Plugin::DBIish": "lib/Humming-Bird/Plugin/DBIish.rakumod", 36 | "Humming-Bird::Plugin::HotReload": "lib/Humming-Bird/Plugin/HotReload.rakumod", 37 | "Humming-Bird::Plugin::SlapbirdAPM": "lib/Humming-Bird/Plugin/SlapbirdAPM.rakumod" 38 | }, 39 | "resources": [ 40 | ], 41 | "source-url": "https://github.com/rawleyfowler/Humming-Bird.git", 42 | "support": { 43 | "source": "https://github.com/rawleyfowler/Humming-Bird.git" 44 | }, 45 | "tags": [ 46 | "Net", 47 | "Sinatra", 48 | "Web", 49 | "HTTP" 50 | ], 51 | "test-depends": [ 52 | "Test", 53 | "Test::When", 54 | "Test::Notice", 55 | "Test::Util::ServerPort" 56 | ], 57 | "version": "4.0.0" 58 | } 59 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |
2 |

Humming-Bird

3 | 4 | 5 | 6 | ![Zef Badge](https://raku.land/zef:rawleyfowler/Humming-Bird/badges/version?) 7 | [![SparrowCI](https://ci.sparrowhub.io/project/gh-rawleyfowler-Humming-Bird/badge)](https://ci.sparrowhub.io) 8 |
9 | 10 | Humming-Bird is a simple, composable, and performant web-framework for Raku on MoarVM. 11 | Humming-Bird was inspired mainly by [Sinatra](https://sinatrarb.com), and [Express](https://expressjs.com), and tries to keep 12 | things minimal, allowing the user to pull in things like templating engines, and ORM's on their own terms. 13 | 14 | ## Features 15 | Humming-Bird has 2 simple layers, at the lowest levels we have `Humming-Bird::Glue` which is a simple "glue-like" layer for interfacing with 16 | `Humming-Bird::Backend`'s. 17 | Then you have the actual application logic in `Humming-Bird::Core` that handles: routing, middleware, error handling, cookies, etc. 18 | 19 | - Powerful function composition based routing and application logic 20 | - Routers 21 | - Groups 22 | - Middleware 23 | - Advice (end of stack middleware) 24 | - Simple global error handling 25 | - Plugin system 26 | 27 | - Simple and helpful API 28 | - get, post, put, patch, delete, etc 29 | - Request content will be converted to the appropriate Raku data-type if possible 30 | - Static files served have their content type infered 31 | - Request/Response stash's for inter-layer route talking 32 | 33 | - Swappable backends 34 | 35 | **Note**: Humming-Bird is not meant to face the internet directly. Please use a reverse proxy such as Apache, Caddy or NGiNX. 36 | 37 | ## How to install 38 | Make sure you have [zef](https://github.com/ugexe/zef) installed. 39 | 40 | #### Install latest 41 | ```bash 42 | zef -v install https://github.com/rawleyfowler/Humming-Bird.git 43 | ``` 44 | 45 | #### Install stable 46 | ```bash 47 | zef install Humming-Bird 48 | ``` 49 | 50 | ## Performance 51 | 52 | See [this](https://github.com/rawleyfowler/Humming-Bird/issues/43#issuecomment-1454252501) for a more detailed performance preview 53 | vs. Ruby's Sinatra using `Humming-Bird::Backend::HTTPServer`. 54 | 55 | ## Examples 56 | 57 | #### Simple example: 58 | ```raku 59 | use v6.d; 60 | 61 | use Humming-Bird::Core; 62 | 63 | get('/', -> $request, $response { 64 | $response.html('

Hello World

'); 65 | }); 66 | 67 | listen(8080); 68 | 69 | # Navigate to localhost:8080! 70 | ``` 71 | 72 | #### Simple JSON CRUD example: 73 | ```raku 74 | use v6.d; 75 | 76 | use Humming-Bird::Core; 77 | use JSON::Fast; # A dependency of Humming-Bird 78 | 79 | my %users = Map.new('bob', %('name', 'bob'), 'joe', %('name', 'joe')); 80 | 81 | get('/users/:user', -> $request, $response { 82 | my $user = $request.param('user'); 83 | 84 | if %users{$user}:exists { 85 | $response.json(to-json %users{$user}); 86 | } else { 87 | $response.status(404).html("Sorry, $user does not exist."); 88 | } 89 | }); 90 | 91 | post('/users', -> $request, $response { 92 | my %user = $request.content; # Different from $request.body, $request.content will do its best to decode the data to a Map. 93 | if my-user-validation-logic(%user) { # Validate somehow, i'll leave that up to you. 94 | %users{%user} = %user; 95 | $response.status(201); # 201 created 96 | } else { 97 | $response.status(400).html('Bad request'); 98 | } 99 | }); 100 | 101 | listen(8080); 102 | ``` 103 | 104 | #### Using plugins 105 | ```raku 106 | use v6.d; 107 | 108 | use Humming-Bird::Core; 109 | 110 | plugin 'Logger'; # Corresponds to the pre-built Humming-Bird::Plugin::Logger plugin. 111 | plugin 'Config'; # Corresponds to the pre-built Humming-Bird::Plugin::Config plugin. 112 | 113 | get('/', sub ($request, $response) { 114 | my $database_url = $request.config; 115 | $response.html("Here's my database url :D " ~ $database_url); 116 | }); 117 | 118 | listen(8080); 119 | ``` 120 | 121 | #### Routers 122 | ```raku 123 | use v6.d; 124 | 125 | use Humming-Bird::Core; 126 | use Humming-Bird::Middleware; 127 | 128 | # NOTE: Declared routes persist through multiple 'use Humming-Bird::Core' statements 129 | # allowing you to declare routing logic in multiple places if you want. This is true 130 | # regardless of whether you're using the sub or Router process for defining routes. 131 | my $router = Router.new(root => '/'); 132 | 133 | plugin 'Logger'; 134 | 135 | $router.get(-> $request, $response { # Register a GET route on the root of the router 136 | $response.html('

Hello World

'); 137 | }); 138 | 139 | $router.get('/foo', -> $request, $response { # Register a GET route on /foo 140 | $response.html('Bar'); 141 | }); 142 | 143 | my $other-router = Router.new(root => '/bar'); 144 | 145 | $other-router.get('/baz', -> $request, $response { # Register a GET route on /bar/baz 146 | $response.file('hello-world.html'); # Will render hello-world.html and infer its content type 147 | }); 148 | 149 | # No need to register routers, it's underlying routes are registered with Humming-Bird on creation. 150 | listen(8080); 151 | ``` 152 | 153 | #### Middleware 154 | ```raku 155 | use v6.d; 156 | 157 | use Humming-Bird::Core; 158 | use Humming-Bird::Middleware; 159 | 160 | get('/logged', -> $request, $response { 161 | $response.html('This request has been logged!'); 162 | }, [ &middleware-logger ]); # &middleware-logger is provided by Humming-Bird::Middleware 163 | 164 | # Custom middleware 165 | sub block-firefox($request, $response, &next) { 166 | return $response.status(400) if $request.header('User-Agent').starts-with('Mozilla'); 167 | $response.status(200); 168 | } 169 | 170 | get('/no-firefox', -> $request, $response { 171 | $response.html('You are not using Firefox!'); 172 | }, [ &middleware-logger, &block-firefox ]); 173 | 174 | listen(8080); 175 | ``` 176 | 177 | Since Humming-Bird `3.0.4` it may be more favorable to use plugins to register global middlewares. 178 | 179 | #### Swappable Backends 180 | ```raku 181 | use v6.d; 182 | 183 | use Humming-Bird::Core; 184 | 185 | get('/', -> $request, $response { 186 | $response.html('This request has been logged!'); 187 | }); 188 | 189 | # Run on a different backend, assuming: 190 | listen(:backend(Humming-Bird::Backend::MyBackend)); 191 | ``` 192 | 193 | More examples can be found in the [examples](https://github.com/rawleyfowler/Humming-Bird/tree/main/examples) directory. 194 | 195 | ## Swappable backends 196 | 197 | In Humming-Bird `3.0.0` and up you are able to write your own backend, please follow the API outlined by the `Humming-Bird::Backend` role, 198 | and view `Humming-Bird::Backend::HTTPServer` for an example of how to implement a Humming-Bird backend. 199 | 200 | ## Plugin system 201 | 202 | Humming-Bird `3.0.4` (`4.0.0` created a breaking change for plugins) and up features the Humming-Bird Plugin system, this is a straight forward way to extend Humming-Bird with desired functionality before the server 203 | starts up. All you need to do is create a class that inherits from `Humming-Bird::Plugin`, for instance `Humming-Bird::Plugin::Config`, expose a single method `register` which 204 | takes arguments that align with the arguments specified in `Humming-Bird::Plugin.register`, for more arguments, take a slurpy at the end of your register method. 205 | 206 | If the return value of a `Humming-Bird::Plugin.register` is a `Hash`, Humming-Bird will assume that you 207 | are returning helpers from your plugin, meaning the keys and values will be bound to `Humming-Bird::HTTPAction`. 208 | This allows you to use functionality easily in your request/response life-cycles. 209 | 210 | Here is an example of a plugin: 211 | 212 | ```raku 213 | use JSON::Fast; 214 | use Humming-Bird::Plugin; 215 | use Humming-Bird::Core; 216 | 217 | unit class Humming-Bird::Plugin::Config does Humming-Bird::Plugin; 218 | 219 | method register($server, %routes, @middleware, @advice, **@args) { 220 | my $filename = @args[0] // '.humming-bird.json'; 221 | my %config = from-json($filename.IO.slurp // '{}'); 222 | 223 | # The key will become the name, and the value will become a method on Humming-Bird::Glue::HTTPAction, 224 | # allowing you to have helper methods available in your request/response life-cycle. 225 | return %( 226 | config => sub (Humming-Bird::Glue::HTTPAction $action) { 227 | %config; 228 | } 229 | ); 230 | 231 | CATCH { 232 | default { 233 | warn 'Failed to find or parse your ".humming-bird.json" configuration. Ensure your file is well formed, and does exist.'; 234 | } 235 | } 236 | } 237 | ``` 238 | 239 | This plugin embeds a `.config` method on the base class for Humming-Bird's Request and Response classes, allowing your config to be accessed during the request/response lifecycle. 240 | 241 | Then to register it in a Humming-Bird application: 242 | 243 | ```raku 244 | use Humming-Bird::Core; 245 | 246 | plugin 'Config', 'config/humming-bird.json'; # Second arg will be pushed to he **@args array in the register method. 247 | 248 | get('/', sub ($request, $response) { 249 | $response.write($request.config); # Echo back the field in our JSON config. 250 | }); 251 | 252 | listen(8080); 253 | ``` 254 | 255 | ## Design 256 | - Humming-Bird should be easy to pickup, and simple for developers new to Raku and/or web development. 257 | - Humming-Bird is not designed to be exposed to the internet directly. You should hide Humming-Bird behind a reverse-proxy like NGiNX, Apache, or Caddy. 258 | - Simple and composable via middlewares. 259 | 260 | ## Things to keep in mind 261 | - This project is in active development, things will break. 262 | - You may run into bugs. 263 | - This project is largely maintained by one person. 264 | 265 | ## Contributing 266 | All contributions are encouraged! I know the Raku community is amazing, so I hope to see 267 | some people get involved :D 268 | 269 | Please make sure you squash your branch, and name it accordingly before it gets merged! 270 | 271 | #### Testing 272 | 273 | Install App::Prove6 274 | 275 | ```bash 276 | zef install --force-install App::Prove6 277 | ``` 278 | 279 | Ensure that the following passes: 280 | 281 | ```bash 282 | cd Humming-Bird 283 | zef install . --force-install --/test 284 | prove6 -v -I. t/ it/ 285 | ``` 286 | 287 | ## License 288 | Humming-Bird is available under the MIT, you can view the license in the `LICENSE` file 289 | at the root of the project. For more information about the MIT, please click 290 | [here](https://mit-license.org/). 291 | -------------------------------------------------------------------------------- /examples/README.pod: -------------------------------------------------------------------------------- 1 | =head1 Examples 2 | 3 | =head4 Simple example: 4 | 5 | =for code 6 | 7 | use v6; 8 | 9 | use Humming-Bird::Core; 10 | 11 | get('/', -> $request, $response { 12 | $response.html('

Hello World

'); 13 | }); 14 | 15 | listen(8080); 16 | 17 | # Navigate to localhost:8080! 18 | 19 | =head4 Query params: 20 | 21 | =for code 22 | 23 | use v6; 24 | 25 | use Humming-Bird::Core; 26 | 27 | post('/password', -> $request, $response { 28 | my $super_secret_password = '1234'; 29 | my $password = $request.query('password') || 'Wrong!'; # /password?password= 30 | if $password eq $super_secret_password { 31 | $response.html('

That password was correct!

'); # Responses default to 200, change the with .status 32 | } else { 33 | $response.status(400).html('

Wrong Password!!!

'); 34 | } 35 | }); 36 | 37 | =head4 Simple JSON/path param example: 38 | 39 | =for code 40 | 41 | use v6; 42 | 43 | use Humming-Bird::Core; 44 | 45 | my %users = Map.new('bob', '{ "name": "bob" }', 'joe', '{ "name": "joe" }'); 46 | 47 | get('/users/:user', -> $request, $response { 48 | my $user = $request.param('user'); 49 | 50 | if %users{$user}:exists { 51 | $response.json(%users{$user}); 52 | } else { 53 | $response.status(404); 54 | } 55 | }); 56 | 57 | listen(8080); 58 | 59 | =head4 Example using routers 60 | 61 | =for code 62 | use Humming-Bird::Core; 63 | 64 | my $router = Router.new(root => '/foo/bar'); 65 | 66 | # Advice and middleware added will be appended to the routes as they are added. 67 | $router.middleware(-> $request, $response, &next { $response.header('X-MyHeader', 'True'); &next() }); 68 | $router.advice(-> $response { say $response; $response }); 69 | 70 | $router.get(-> $request, $response { $response.write('abc') }); # Registers a get route on /foo/bar 71 | 72 | $route.get('/abc', -> $request, $response { $response.write('abc') }); # Registers a get route on /foo/bar/abc 73 | 74 | listen(8080); # No need to register or anything. The router is already registered upon creation. 75 | 76 | =head4 Middleware: 77 | 78 | =for code 79 | 80 | use v6; 81 | 82 | use Humming-Bird::Core; 83 | use Humming-Bird::Middleware; 84 | 85 | get('/logged', -> $request, $response { 86 | $response.html('This request has been logged!'); 87 | }, [ &middleware-logger ]); # &m_logger is provided by Humming-Bird::Middleware 88 | 89 | # Custom middleware 90 | sub block-firefox($request, $response, &next) { 91 | return $response.status(400) if $request.header('User-Agent').starts-with('Mozilla'); 92 | $response.status(200); 93 | } 94 | 95 | get('/no-firefox', -> $request, $response { 96 | $response.html('You are not using Firefox!'); 97 | }, [ &middleware-logger, &block-firefox ]); 98 | 99 | # Scoped middleware 100 | 101 | # Both of these routes will now share the middleware specified in the last parameter of the group. 102 | group([ 103 | &get.assuming('/', -> $request, $response { 104 | $response.write('Index'); 105 | }), 106 | 107 | &post.assuming('/users', -> $request, $response { 108 | $response.write($request.body).status(204); 109 | }) 110 | ], [ &middleware-logger, &block-firefox ]); 111 | 112 | =head4 Cookies: 113 | 114 | =for code 115 | use v6; 116 | 117 | use Humming-Bird::Core; 118 | 119 | # Middleware to make sure you have an AUTH cookie 120 | sub authorized($request, $response, &next) { 121 | without $request.cookie('AUTH') { 122 | return $response.status(403); 123 | } 124 | 125 | &next(); 126 | } 127 | 128 | get('/auth/home', -> $request, $response { 129 | $response.html('You are logged in!'); 130 | }, [ &authorized ]); 131 | 132 | post('/auth/login', -> $request, $response { 133 | if $request.body eq 'Password123' { 134 | # TODO: Implement redirects 135 | $response.cookie('AUTH', 'logged in!', DateTime.now + Duration.new(3600)).html('You logged in!'); 136 | } else { 137 | $response.status(400); 138 | } 139 | }); 140 | 141 | =head4 Basic CRUD REST API: 142 | 143 | =for code 144 | # A simple REST API using Humming-Bird::Core and JSON::Fast 145 | 146 | use v6; 147 | use strict; 148 | 149 | use Humming-Bird::Core; 150 | use Humming-Bird::Middleware; 151 | use JSON::Marshal; 152 | use JSON::Unmarshal; 153 | 154 | # Basic model to represent our User 155 | class User { 156 | has Str $.name is required; 157 | has Int $.age is required; 158 | has Str $.email is required; 159 | } 160 | 161 | # Fake DB, you can pull in DBIish if you need a real DB. 162 | my @user-database = User.new(name => 'bob', age => 22, email => 'bob@bob.com'); 163 | 164 | get('/users', -> $request, $response { 165 | $response.json(marshal(@user-database)); 166 | }, [ &middleware-logger ]); 167 | 168 | post('/users', -> $request, $response { 169 | my $user := unmarshal($request.body, User); 170 | @user-database.push($user); 171 | $response.json(marshal($user)); # 204 Created 172 | }); 173 | 174 | listen(8080); 175 | 176 | =head4 After middleware aka advice 177 | 178 | =for code 179 | use v6.d; 180 | 181 | use Humming-Bird::Core; 182 | use Humming-Bird::Advice; 183 | 184 | advice(&advice-logger); # advice-logger is provided by Humming-Bird::Advice. 185 | 186 | # Custom advice 187 | our clicks-today = 0; 188 | sub update-clicks-today(Response:D $response --> Response:D) { 189 | clicks-today++; 190 | $response; 191 | } 192 | 193 | advice(&update-clicks-today); # This will fire after every response is handled. 194 | 195 | =head4 Exception/Error handlers 196 | 197 | =for code 198 | use v6.d; 199 | 200 | use Humming-Bird::Core; 201 | use HTTP::Status; 202 | 203 | # This will catch any X::AdHoc exceptions and use this as the handler 204 | error(X::AdHoc, -> $exception, $response { 205 | $response.status(500).write($exception.payload || 'Internal server error.'); # In this case, when we hit an X::AdHoc lets return a 500 with the payload of the exception 206 | }); 207 | 208 | =head4 Static files 209 | 210 | =for code 211 | 212 | use v6.d; 213 | 214 | use Humming-Bird::Core; 215 | 216 | static('/static', '/var/www/static'); # Will serve static content from /var/www/static on route /static 217 | -------------------------------------------------------------------------------- /examples/basic/.humming-bird.json: -------------------------------------------------------------------------------- 1 | { 2 | "secret_message": "boo" 3 | } 4 | -------------------------------------------------------------------------------- /examples/basic/basic.raku: -------------------------------------------------------------------------------- 1 | use v6; 2 | use strict; 3 | 4 | use Humming-Bird::Core; 5 | use Humming-Bird::Middleware; 6 | use Humming-Bird::Advice; 7 | 8 | plugin 'Config'; 9 | plugin 'Logger'; 10 | 11 | # Simple static routes 12 | get('/', -> $request, $response { 13 | $response.html('

Hello World!

'); 14 | }); 15 | 16 | 17 | # Path parameters 18 | get('/:user', -> $request, $response { 19 | my $user = $request.param('user'); 20 | $response.html(sprintf('

Hello %s

', $user)); 21 | }); 22 | 23 | 24 | # Query parameters 25 | post('/password', -> $request, $response { 26 | my $super_secret_password = '1234'; 27 | my $password = $request.query('password') || 'Wrong!'; # /password?password= 28 | if $password eq $super_secret_password { 29 | $response.html('

That password was correct!

'); # Responses default to 200, change the with .status 30 | } else { 31 | $response.status(400).html('

Wrong Password!!!

'); 32 | } 33 | }); 34 | 35 | 36 | # Serving Files 37 | get('/help.txt', -> $request, $response { 38 | $response.file('basic.txt').content_type('text/plain'); 39 | }); 40 | 41 | 42 | # Simple Middleware example 43 | get('/logged', -> $request, $response { 44 | $response.html('

Your request has been logged. Check the console.

'); 45 | }); 46 | 47 | 48 | # Custom Middleware example 49 | sub block_firefox($request, $response, &next) { 50 | if $request.header('User-Agent').starts-with('Mozilla') { 51 | return $response.status(400); # Bad Request! 52 | } 53 | 54 | next(); # Otherwise continue 55 | } 56 | 57 | get('/firefox-not-allowed', -> $request, $response { 58 | $response.html('

Hello Non-firefox user!

'); 59 | }, [&block_firefox ]); 60 | 61 | # Grouping routes 62 | # group: @route_callbacks, @middleware 63 | group([ 64 | &get.assuming('/hello', -> $request, $response { 65 | $response.html('

Hello!

'); 66 | }), 67 | 68 | &get.assuming('/hello/world', -> $request, $response { 69 | $response.html('

Hello World!

'); 70 | }) 71 | ], [ &block_firefox ]); 72 | 73 | 74 | # Simple cookie 75 | 76 | # Middleware to make sure you have an AUTH cookie 77 | sub authorized($request, $response, &next) { 78 | without $request.cookie('AUTH') { 79 | return $response.status(403); 80 | } 81 | 82 | &next(); 83 | } 84 | 85 | get('/auth/home', -> $request, $response { 86 | $response.html('You are logged in!'); 87 | }, [ &authorized ]); 88 | 89 | post('/auth/login', -> $request, $response { 90 | if $request.body eq 'Password123' { 91 | $response.cookie('AUTH', 'logged in!', DateTime.now + Duration.new(3600)).html('You logged in!'); 92 | } else { 93 | $response.status(400); 94 | } 95 | }); 96 | 97 | 98 | # Redirects 99 | get('/take/me/home', -> $request, $response { 100 | $response.redirect('/', :permanent); # Do not provide permanent for a status of 307. 101 | }); 102 | 103 | 104 | # Error throwing exception 105 | get('/throws-error', -> $request, $response { 106 | $response.html('abc.html'.IO.slurp); 107 | }); 108 | 109 | # Error handler 110 | error(X::AdHoc, -> $exn, $response { $response.status(500).write("Encountered an error.
$exn") }); 111 | 112 | # Static content 113 | static('/static', '/var/www/static'); # Server static content on '/static', from '/var/www/static' 114 | 115 | get('/favicon.ico', sub ($request, $response) { $response.file('favicon.ico'); }); 116 | 117 | get('/login', sub ($request, $response) { 118 | $request.stash = 'foobar'; 119 | $response.write('Logged in as foobar'); 120 | }, [ &middleware-session ]); 121 | 122 | get('/session', sub ($request, $response) { 123 | $response.write($request.stash.raku) 124 | }, [ &middleware-session ]); 125 | 126 | get('/form', sub ($request, $response) { 127 | $response.html('
'); 128 | }); 129 | 130 | # Echo a file back to the user. 131 | post('/form', sub ($request, $response) { 132 | my $file = $request.content..; 133 | $response.blob($file); 134 | }); 135 | 136 | # Routers 137 | my $router = Router.new(root => '/foo'); 138 | $router.get(-> $request, $response { $response.write('foo') }); 139 | $router.post(-> $request, $response { $response.write('foo post!') }); 140 | $router.get('/bar', -> $request, $response { $response.write('foo bar') }); # Registered on /foo/bar 141 | 142 | # Run the app 143 | listen(9000, timeout => 3); 144 | 145 | # vim: expandtab shiftwidth=4 146 | -------------------------------------------------------------------------------- /examples/basic/basic.txt: -------------------------------------------------------------------------------- 1 | I am a plain text file! 2 | -------------------------------------------------------------------------------- /examples/basic/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rawleyfowler/Humming-Bird/2bb90e83a4aee1ffc36270d0f1c7041eb9b27567/examples/basic/favicon.ico -------------------------------------------------------------------------------- /examples/dbiish/create-db.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE users ( 2 | id INTEGER PRIMARY KEY, 3 | name TEXT, 4 | age INTEGER 5 | ); 6 | -------------------------------------------------------------------------------- /examples/dbiish/dbiish.raku: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Core; 2 | use JSON::Fast; 3 | 4 | # Create database with: 5 | # sqlite3 mydb.db < create-db.sql 6 | 7 | # Tell Humming-Bird::Plugin::DBIish where to look for your db. 8 | plugin 'DBIish', ['SQLite', :database('mydb.db')]; 9 | plugin 'Config'; 10 | 11 | get '/users', sub ($request, $response) { 12 | my $sth = $request.db.execute(q:to/SQL/); 13 | SELECT * FROM users 14 | SQL 15 | my $json = to-json($sth.allrows(:array-of-hash)); 16 | return $response.json($json); 17 | } 18 | 19 | get '/time', sub ($request, $response) { 20 | my $sth = $request.db.execute(q:to/SQL/); 21 | SELECT TIME() as time; 22 | SQL 23 | my $json = to-json($sth.allrows(:array-of-hash)[0]); 24 | $request.config; 25 | return $response.json($json); 26 | } 27 | 28 | post '/users', sub ($request, $response) { 29 | my $sth = $request.db.prepare(q:to/SQL/); 30 | INSERT INTO users (name, age) 31 | VALUES (?, ?) 32 | RETURNING * 33 | SQL 34 | 35 | my $content = $request.content; 36 | $sth = $sth.execute($content, $content); 37 | 38 | my $json = to-json($sth.allrows(:array-of-hash)); 39 | return $response.json($json); 40 | } 41 | 42 | listen(8080); 43 | -------------------------------------------------------------------------------- /examples/docker/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM rakudo-star 2 | RUN zef install Humming-Bird 3 | EXPOSE 8080 4 | WORKDIR /docker-example 5 | COPY . . 6 | CMD ["raku", "app.raku"] 7 | -------------------------------------------------------------------------------- /examples/docker/README.md: -------------------------------------------------------------------------------- 1 | # Docker Example 2 | 3 | A simple example of how to use Humming-Bird with Docker. 4 | 5 | ### How to build 6 | ```bash 7 | cd examples/docker 8 | docker build . -t humming-bird-example 9 | docker run -p 8080:8080 -d humming-bird-example 10 | ``` 11 | -------------------------------------------------------------------------------- /examples/docker/app.raku: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | use Humming-Bird::Core; 4 | 5 | get('/', -> $request, $response { 6 | $response.html('

Hello from Docker.

'); 7 | }); 8 | 9 | listen(8080); 10 | -------------------------------------------------------------------------------- /examples/mvc/META6-example.json: -------------------------------------------------------------------------------- 1 | { 2 | "auth": "zef:my-zef", 3 | "authors": [ 4 | "My Name" 5 | ], 6 | "depends": [ 7 | "Humming-Bird", 8 | "Template::Mustache" 9 | ], 10 | "provides": { 11 | "App::Foo": "lib/App/Foo.rakumod", 12 | "App::Foo::Controller::Foo": "lib/App/Controller/Foo.rakumod", 13 | "App::Foo::Controller::Bar": "lib/App/Controller/Bar.rakumod", 14 | "App::Foo::Model::Foo": "lib/App/Model/Foo.rakumod", 15 | "App::Foo::Render": "lib/App/Foo/Render.rakumod" 16 | }, 17 | "name": "App::Foo", 18 | "perl": "6.d", 19 | "resources": [ ], 20 | "source-url": "https://github.com/rawleyfowler/Humming-Bird", 21 | "support": { 22 | "source": "https://github.com/rawleyfowler/Humming-Bird" 23 | }, 24 | "tags": [ 25 | "Example" 26 | ], 27 | "test-depends": [ 28 | "Test" 29 | ], 30 | "version": "0.0.1" 31 | } 32 | -------------------------------------------------------------------------------- /examples/mvc/bin/foo: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env raku 2 | 3 | use Humming-Bird::Core; 4 | use App::Foo; 5 | 6 | listen(1234); # Start the server on port 1234 7 | -------------------------------------------------------------------------------- /examples/mvc/lib/App/Controller/Bar.rakumod: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Core; 2 | 3 | use App::Foo::Model::Bar; 4 | use App::Foo::Render; 5 | 6 | unit module App::Foo::Controller::Bar; 7 | 8 | my $router = Router.new(base => '/bar'); 9 | 10 | $router.get(-> $request, $response { 11 | my $bars = Bar.get-all; 12 | $response.html(render('bars', :$bars)); 13 | }); 14 | 15 | $router.post(-> $request, $response { 16 | my $json = $request.content; 17 | 18 | return $response.html('400 Bad Request').status(400) unless Bar.validate($json); 19 | 20 | Bar.save($json); 21 | $response.status(201); # 201 Created 22 | }); 23 | 24 | $router.get('/:id', -> $request, $response { 25 | my $bar = Bar.get-by-id: $request.param('id'); 26 | 27 | return $response.html('404 Not Found').status(404) unless $bar; 28 | 29 | $response.html(render('bar', :$bar)); 30 | }); 31 | -------------------------------------------------------------------------------- /examples/mvc/lib/App/Controller/Foo.rakumod: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Core; 2 | 3 | use App::Foo::Model::Foo; 4 | use App::Foo::Render; 5 | 6 | unit module App::Foo::Controller::Foo; 7 | 8 | my $router = Router.new(base => '/foo'); 9 | 10 | $router.get(-> $request, $response { 11 | my $foos = Foo.get-all; 12 | $response.html(render('foos', :$foos)); 13 | }); 14 | 15 | $router.post(-> $request, $response { 16 | my $json = $request.content; 17 | 18 | return $response.html('400 Bad Request').status(400) unless Foo.validate($json); 19 | 20 | Foo.save($json); 21 | $response.status(201); # 201 Created 22 | }); 23 | 24 | $router.get('/:id', -> $request, $response { 25 | my $foo = Foo.get-by-id: $request.param('id'); 26 | 27 | return $response.html('404 Not Found').status(404) unless $foo; 28 | 29 | $response.html(render('foo', :$foo)); 30 | }); 31 | -------------------------------------------------------------------------------- /examples/mvc/lib/App/Foo.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | use Humming-Bird::Core; 4 | 5 | use App::Foo::Controller::Foo; 6 | use App::Foo::Controller::Bar; 7 | -------------------------------------------------------------------------------- /examples/mvc/lib/App/Foo/Render.rakumod: -------------------------------------------------------------------------------- 1 | use Template::Mustache; 2 | 3 | unit module App::Foo::Render; 4 | 5 | my $templater = Template::Mustache.new(:from('templates')); 6 | 7 | submethod CALL-ME(Str:D $tmpl, *%args --> Str:D) { 8 | $templater.render($tmpl, { :$title, |%args }); 9 | } 10 | -------------------------------------------------------------------------------- /examples/mvc/lib/App/Model/Bar.rakumod: -------------------------------------------------------------------------------- 1 | unit class App::Foo::Model::Bar; 2 | 3 | our @bars = []; 4 | 5 | submethod get-all { 6 | @bars; 7 | } 8 | 9 | submethod get-by-id(Str:D $id) { 10 | @bars.first(*. eq $id); 11 | } 12 | 13 | submethod validate($bar) { 14 | $bar. and $bar. and $bar.; 15 | } 16 | 17 | submethod save($bar) { 18 | @bars.push: $foo; 19 | } 20 | -------------------------------------------------------------------------------- /examples/mvc/lib/App/Model/Foo.rakumod: -------------------------------------------------------------------------------- 1 | unit class App::Foo::Model::Foo; 2 | 3 | our @foos = []; 4 | 5 | submethod get-all { 6 | @foos; 7 | } 8 | 9 | submethod get-by-id(Str:D $id) { 10 | @foos.first(*. eq $id); 11 | } 12 | 13 | submethod validate($foo) { 14 | $foo. and $foo. and $foo.; 15 | } 16 | 17 | submethod save($foo) { 18 | @foos.push: $foo; 19 | } 20 | -------------------------------------------------------------------------------- /examples/mvc/templates/bars.mustache: -------------------------------------------------------------------------------- 1 | {{> header}} 2 | {{#foos}} 3 | {{id}} - {{name}} - {{age}} 4 | {{/foos}} 5 | {{> footer}} 6 | -------------------------------------------------------------------------------- /examples/mvc/templates/foos.mustache: -------------------------------------------------------------------------------- 1 | {{> header}} 2 | {{#foos}} 3 | {{id}} - {{name}} - {{age}} 4 | {{/foos}} 5 | {{> footer}} 6 | -------------------------------------------------------------------------------- /examples/mvc/templates/footer.mustache: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /examples/mvc/templates/header.mustache: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /examples/rest/rest.raku: -------------------------------------------------------------------------------- 1 | # A simple REST API using Humming-Bird::Core and JSON::Marshal/Unmarshal 2 | 3 | # Test it with this 4 | # curl -X post http://localhost:8080/users -d '{ "name": "bob", "age": 13, "email": "bob@gmail.com" }' -v 5 | 6 | use v6; 7 | use strict; 8 | 9 | use Humming-Bird::Core; 10 | use Humming-Bird::Middleware; 11 | use Humming-Bird::Advice; 12 | use JSON::Marshal; 13 | use JSON::Unmarshal; 14 | 15 | # Basic model to represent our User 16 | class User { 17 | has Str $.name is required; 18 | has Int $.age is required; 19 | has Str $.email is required; 20 | } 21 | 22 | class X::NotFound is X::AdHoc { } 23 | 24 | # Fake DB, you can pull in DBIish if you need a real DB. 25 | my @user-database = User.new(name => 'bob', age => 22, email => 'bob@bob.com'); 26 | 27 | get('/', -> $request, $response { $response.redirect('/users', :permanent) }); 28 | 29 | get('/users', -> $request, $response { 30 | $response.json(marshal(@user-database)); 31 | }, [ &middleware-logger ]); 32 | 33 | get('/users/:name', -> $request, $response { 34 | my $name = $request.params; 35 | my $user = @user-database.first(*.name eq $name); 36 | die X::NotFound.new unless $user; 37 | $response.json(marshal($user)); 38 | }); 39 | 40 | post('/users', -> $request, $response { 41 | my $user := unmarshal($request.body, User); 42 | @user-database.push($user); 43 | # Simulate logging in 44 | $response.cookie('User', $user.name, DateTime.now + Duration.new(3600)); # One Hour 45 | $response.status(204).json(marshal($user)); # 204 Created 46 | }); 47 | 48 | error(X::NotFound, -> $exn, $response { $response.status(404).write('Requested resource not found!') }); 49 | 50 | advice(&advice-logger); # advice-logger is provided by Humming-Bird::Advice 51 | 52 | listen(8000); 53 | 54 | # vim: expandtab shiftwidth=4 55 | -------------------------------------------------------------------------------- /it/01-basic.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | use Test; 4 | 5 | use Humming-Bird::Core; 6 | use Test::Util::ServerPort; 7 | use Cro::HTTP::Client; 8 | 9 | my $body = 'abc'; 10 | 11 | get('/', -> $request, $response { 12 | $response.write($body); 13 | }); 14 | 15 | my $content; 16 | post('/form', -> $request, $response { 17 | $content := $request.content; 18 | $response; 19 | }); 20 | 21 | get('/saytest', -> $request, $response { 22 | $response.status(201); 23 | say "FOO!"; 24 | }); 25 | 26 | my $port = get-unused-port; 27 | 28 | listen($port, :no-block); 29 | 30 | sleep 1; # Yes, yes, I know 31 | 32 | my $base-uri = "http://0.0.0.0:$port"; 33 | 34 | my $client = Cro::HTTP::Client.new: :$base-uri; 35 | my $response; 36 | lives-ok({ $response = await $client.get('/') }); 37 | 38 | ok $response, 'Was response a success?'; 39 | is (await $response.body-text), 'abc', 'Is response body OK?'; 40 | 41 | lives-ok({ $response = await $client.get('/saytest') }); 42 | 43 | ok $response, 'Was saytest response a success?'; 44 | is $response.status, 201, 'Was saytest response code correct?'; 45 | 46 | # TODO: Fix this. 47 | my $blob = slurp('t/static/baobao.jpg', :bin); 48 | lives-ok({ 49 | $response = await $client.post: '/form', 50 | content-type => 'multipart/form-data', 51 | content-length => $blob.bytes, 52 | body => [ 53 | name => 'foo', 54 | age => 123, 55 | Cro::HTTP::Body::MultiPartFormData::Part.new( 56 | headers => [Cro::HTTP::Header.new( 57 | name => 'Content-type', 58 | value => 'image/jpeg' 59 | )], 60 | name => 'photo', 61 | filename => 'baobao.jpg', 62 | body-blob => $blob 63 | ) 64 | ]; 65 | }, "Can we send the baobao?"); 66 | 67 | await $response.body; 68 | 69 | ok $content., 'Is multipart param 1 good?'; 70 | ok $content., 'Is multipart param 2 good?'; 71 | ok $content., 'Is multipart param 3 (file param) good?'; 72 | is $content.., $blob, 'Is file param correct data?'; 73 | is $content.., 'baobao.jpg', 'Is the filename correctly parsed?'; 74 | 75 | done-testing; 76 | -------------------------------------------------------------------------------- /it/02-error-handlers.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | use Test; 4 | 5 | use Humming-Bird::Core; 6 | use Test::Util::ServerPort; 7 | use Cro::HTTP::Client; 8 | use HTTP::Status; 9 | 10 | plan 4; 11 | 12 | get('/', -> $request, $response { 13 | die 'adhoc'; 14 | $response.write('body'); 15 | }); 16 | 17 | error(X::AdHoc, sub ($exception, $response) { 18 | return $response.status(204).write($exception.Str); 19 | }); 20 | 21 | my $port = get-unused-port; 22 | 23 | listen($port, :no-block); 24 | 25 | sleep 1; # Yes, yes, I know 26 | 27 | my $base-uri = "http://0.0.0.0:$port"; 28 | 29 | my $client = Cro::HTTP::Client.new: :$base-uri; 30 | my $response; 31 | lives-ok({ $response = await $client.get('/') }); 32 | ok $response, 'Was response a success?'; 33 | is $response.status, 204, 'Is response status OK?'; 34 | is (await $response.body-text), 'adhoc', 'Is error body OK?'; 35 | 36 | done-testing; 37 | -------------------------------------------------------------------------------- /it/03-middlewares.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | use Test; 4 | 5 | use Humming-Bird::Core; 6 | use Test::Util::ServerPort; 7 | use Cro::HTTP::Client; 8 | use HTTP::Status; 9 | 10 | plan 5; 11 | 12 | sub test-middleware($request, $response, &next) { 13 | $response.status(204).write('abc'); 14 | } 15 | 16 | my $i = 0; 17 | sub my-incr-middleware($request, $response, &next) { 18 | $i++; 19 | &next(); 20 | } 21 | 22 | get('/', -> $request, $response { 23 | $response.status(200).write('body'); # This shouldn't be hit. 24 | }, [ &my-incr-middleware, &test-middleware ]); 25 | 26 | my $port = get-unused-port; 27 | 28 | listen($port, :no-block); 29 | 30 | sleep 1; # Yes, yes, I know 31 | 32 | my $base-uri = "http://0.0.0.0:$port"; 33 | 34 | my $client = Cro::HTTP::Client.new: :$base-uri; 35 | 36 | my $response; 37 | 38 | lives-ok({ $response = await $client.get('/') }); 39 | 40 | ok $response, 'Was response a success?'; 41 | is $response.status, 204, 'Is response status 204?'; 42 | is (await $response.body-text), 'abc', 'Is response body OK?'; 43 | is $i, 1, 'Is increment middleware working?'; 44 | 45 | done-testing; 46 | -------------------------------------------------------------------------------- /it/04-catch-all-routes.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | use Test; 4 | 5 | use Humming-Bird::Core; 6 | use Test::Util::ServerPort; 7 | use Cro::HTTP::Client; 8 | 9 | plan 12; 10 | 11 | my $body = 'abc'; 12 | 13 | get('/abc/**', -> $request, $response { 14 | $response.write($body); 15 | }); 16 | 17 | get('/**', -> $request, $response { $response.write('EFG') }); 18 | get('/abc/john', -> $request, $response { $response.write('JOHN') }); 19 | get('/lol/bob/**', -> $request, $response { $response.write('LOL!') }); 20 | 21 | my $port = get-unused-port; 22 | 23 | listen($port, :no-block); 24 | 25 | sleep 1; # Yes, yes, I know 26 | 27 | my $base-uri = "http://0.0.0.0:$port"; 28 | 29 | my $client = Cro::HTTP::Client.new: :$base-uri; 30 | my $response; 31 | 32 | lives-ok({ $response = await $client.get('/abc/haha') }, 'Does request live OK?'); 33 | ok $response, 'Was response a success?'; 34 | is (await $response.body-text), 'abc', 'Is response body OK?'; 35 | 36 | lives-ok({ $response = await $client.get('/abc/john') }, 'Does nested request live OK?'); 37 | ok $response, 'Was nested request a success?'; 38 | is (await $response.body-text), 'JOHN', 'Is nested response body OK?'; 39 | 40 | lives-ok({ $response = await $client.get('/lol/bob/bobby/dude/abc') }, 'Does long request live OK?'); 41 | ok $response, 'Was long response a success?'; 42 | is (await $response.body-text), 'LOL!', 'Is long response body OK?'; 43 | 44 | lives-ok({ $response = await $client.get('/k/efg/kadljaslkdaldjas') }, 'Does deep catch-all live OK?'); 45 | ok $response, 'Was deep response a success?'; 46 | is (await $response.body-text), 'EFG', 'Is deep response body OK?'; 47 | 48 | done-testing; 49 | -------------------------------------------------------------------------------- /it/05-custom-addr.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | use Test; 4 | 5 | use Humming-Bird::Core; 6 | use Test::Util::ServerPort; 7 | use Cro::HTTP::Client; 8 | 9 | my $body = 'abc'; 10 | 11 | get('/', -> $request, $response { 12 | $response.write($body); 13 | }); 14 | 15 | my $port = get-unused-port; 16 | my $addr = $*DISTRO.name eq 'macos' ?? '0.0.0.0' !! '127.0.0.3'; 17 | 18 | listen($port, $addr, :no-block); 19 | 20 | sleep 1; 21 | 22 | my $base-uri = "http://$addr:$port"; 23 | 24 | my $client = Cro::HTTP::Client.new: :$base-uri; 25 | my $response; 26 | lives-ok({ $response = await $client.get('/') }); 27 | 28 | ok $response, 'Was response a success?'; 29 | is (await $response.body-text), 'abc', 'Is response body OK?'; 30 | 31 | done-testing; 32 | -------------------------------------------------------------------------------- /it/06-hotreload.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | use Test; 4 | use Humming-Bird::Core; 5 | plugin 'HotReload'; 6 | 7 | plan 1; 8 | spurt "test-changes-06-hotreload", "Hamadryas"; 9 | 10 | sub hotreload-pid-exists { 11 | return True if $*CWD ~ '/.humming-bird.hotreload'.IO.e || '/tmp/.humming-bird.hotreload'; 12 | return False; 13 | } 14 | 15 | ok hotreload-pid-exists, 'PIDfile exists for HotReload Plugin'; 16 | unlink "test-changes-06-hotreload"; 17 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Advice.rakumod: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Core; 2 | use Humming-Bird::Glue; 3 | 4 | unit module Humming-Bird::Advice; 5 | 6 | sub advice-logger(Humming-Bird::Glue::Response:D $response --> Humming-Bird::Glue::Response:D) is export { 7 | my $log = "{ $response.status.Int } { $response.status } | { $response.initiator.path } | "; 8 | $log ~= $response.header('Content-Type') ?? $response.header('Content-Type') !! "no-content"; 9 | $response.log: $log; 10 | } 11 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Backend.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | unit role Humming-Bird::Backend; 4 | 5 | has Int:D $.port = 8080; 6 | has Str:D $.addr = '0.0.0.0'; 7 | has Int:D $.timeout is required; 8 | 9 | method listen(&handler) { 10 | die "{ self.^name } does not properly implement Humming-Bird::Backend."; 11 | } 12 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Backend/HTTPServer.rakumod: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | # This code is based on the excellent code by the Raku community, adapted to work with Humming-Bird. 4 | # https://github.com/raku-community-modules/HTTP-Server-Async 5 | 6 | # A simple, single-threaded asynchronous HTTP Server. 7 | 8 | use Humming-Bird::Backend; 9 | use Humming-Bird::Glue; 10 | use HTTP::Status; 11 | 12 | unit class Humming-Bird::Backend::HTTPServer does Humming-Bird::Backend; 13 | 14 | my constant $RNRN = "\r\n\r\n".encode.Buf; 15 | my constant $RN = "\r\n".encode.Buf; 16 | 17 | has Channel:D $.requests .= new; 18 | has Lock $!lock .= new; 19 | has @!connections; 20 | 21 | method close { 22 | $_.close for @!connections; 23 | } 24 | 25 | method !timeout { 26 | start { 27 | react { 28 | whenever Supply.interval(1) { 29 | CATCH { default { warn $_ } } 30 | $!lock.protect({ 31 | @!connections = @!connections.grep({ !$_.defined }); # Remove dead connections 32 | for @!connections.grep({ now - $_ >= $!timeout }) { 33 | { 34 | $_ = True; 35 | $_.write(Blob.new); 36 | $_.close; 37 | 38 | CATCH { default { warn $_ } } 39 | } 40 | } 41 | }); 42 | } 43 | } 44 | } 45 | } 46 | 47 | method !respond(&handler) { 48 | state $four-eleven = sub ($initiator) { 49 | Humming-Bird::Glue::Response.new(:$initiator, status => HTTP::Status(411)).encode; 50 | }; 51 | 52 | start { 53 | react { 54 | whenever $.requests -> $request { 55 | CATCH { 56 | when X::IO { 57 | $request.write: $four-eleven($request); 58 | $request = True; 59 | } 60 | default { .say } 61 | } 62 | my $hb-request = $request; 63 | my Humming-Bird::Glue::Response:D $hb-response = &handler($hb-request); 64 | $request.write: $hb-response.encode; 65 | $request:delete; # Mark this request as handled. 66 | $request = False with $hb-request.header('keep-alive'); 67 | } 68 | } 69 | } 70 | } 71 | 72 | method listen(&handler) { 73 | self!timeout; 74 | self!respond(&handler); 75 | react whenever IO::Socket::Async.listen($.addr // '0.0.0.0', $.port) -> $connection { 76 | my %connection-map := { 77 | socket => $connection, 78 | last-active => now 79 | } 80 | 81 | react whenever $connection.Supply: :bin -> $bytes { 82 | CATCH { default { .say } } 83 | %connection-map = now; 84 | 85 | my $header-request = False; 86 | if %connection-map:!exists { 87 | %connection-map = Humming-Bird::Glue::Request.decode($bytes); 88 | $header-request = True; 89 | } 90 | 91 | my $hb-request = %connection-map; 92 | if !$header-request { 93 | $hb-request.body.append: $bytes; 94 | } 95 | 96 | my $content-length = $hb-request.header('Content-Length'); 97 | if (!$content-length.defined || ($hb-request.body.bytes == $content-length)) { 98 | $.requests.send: %connection-map; 99 | } 100 | } 101 | 102 | CATCH { default { .say; $connection.close; %connection-map = True } } 103 | } 104 | } 105 | 106 | # vim: expandtab shiftwidth=4 107 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Core.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use strict; 3 | 4 | use HTTP::Status; 5 | use Humming-Bird::Backend::HTTPServer; 6 | use Humming-Bird::Glue; 7 | 8 | unit module Humming-Bird::Core; 9 | 10 | our constant $VERSION = '4.0.0'; 11 | 12 | ### ROUTING SECTION 13 | my constant $PARAM_IDX = ':'; 14 | my constant $CATCH_ALL_IDX = '**'; 15 | 16 | our %ROUTES; 17 | our @MIDDLEWARE; 18 | our @ADVICE = [{ $^a }]; 19 | our %ERROR; 20 | our @PLUGINS; 21 | 22 | class Route { 23 | has Str:D $.path is required where { ($^a eq '') or $^a.starts-with('/') }; 24 | has Bool:D $.static = False; 25 | has &.callback is required; 26 | has @.middlewares; # List of functions that type Request --> Request 27 | 28 | method CALL-ME(Request:D $req, $tmp?) { 29 | my Response:D $res = $tmp ?? $tmp !! Response.new(initiator => $req, status => HTTP::Status(200)); 30 | 31 | my @middlewares = [|@!middlewares, |@MIDDLEWARE, -> $a, $b, &c { &!callback($a, $b) }]; 32 | 33 | # The current route is converted to a middleware. 34 | if @middlewares.elems > 1 { 35 | # For historical purposes this code will stay here, unfortunately, it was not performant enough. 36 | # This code was written on the first day I started working on Humming-Bird. - RF 37 | # state &comp = @middlewares.prepend(-> $re, $rp, &n { &!callback.assuming($req, $res) }).map({ $^a.raku.say; $^a.assuming($req, $res) }).reverse.reduce(-> &a, &b { &b.assuming(&a) } ); 38 | 39 | for @middlewares -> &middleware { 40 | my Bool:D $next = False; 41 | &middleware($req, $res, sub { $next = True } ); 42 | last unless $next; 43 | } 44 | } 45 | else { 46 | # If there is are no middlewares, just process the callback 47 | &!callback($req, $res); 48 | } 49 | 50 | return $res; 51 | } 52 | } 53 | 54 | sub split_uri(Str:D $uri --> List:D) { 55 | my @uri_parts = $uri.split('/', :skip-empty); 56 | @uri_parts.prepend('/').List; 57 | } 58 | 59 | sub delegate-route(Route:D $route, HTTPMethod:D $meth --> Route:D) { 60 | die 'Route cannot be empty' unless $route.path; 61 | die "Invalid route: { $route.path }, routes must start with a '/'" unless $route.path.contains('/'); 62 | 63 | my @uri_parts = split_uri($route.path); 64 | 65 | my %loc := %ROUTES; 66 | for @uri_parts -> Str:D $part { 67 | unless %loc{$part}:exists { 68 | %loc{$part} = Hash.new; 69 | } 70 | 71 | %loc := %loc{$part}; 72 | } 73 | 74 | %loc{$meth} := $route; 75 | $route; # Return the route. 76 | } 77 | 78 | class Router is export { 79 | has Str:D $.root is required; 80 | has @.routes; 81 | has @!middlewares; 82 | has @!advice = ( { $^a } ); # List of functions that type Response --> Response 83 | 84 | method !add-route(Route:D $route, HTTPMethod:D $method --> Route:D) { 85 | my &advice = [o] @!advice; 86 | my &cb = $route.callback; 87 | my $r = $route.clone(path => $!root ~ $route.path, 88 | middlewares => [|$route.middlewares, |@!middlewares], 89 | callback => { &advice(&cb($^a, $^b)) }); 90 | @!routes.push: $r; 91 | delegate-route($r, $method); 92 | } 93 | 94 | multi method get(Str:D $path, &callback, @middlewares = List.new) { 95 | self!add-route(Route.new(:$path, :&callback, :@middlewares), GET); 96 | } 97 | multi method get(&callback, @middlewares = List.new) { 98 | self.get('', &callback, @middlewares); 99 | } 100 | 101 | multi method post(Str:D $path, &callback, @middlewares = List.new) { 102 | self!add-route(Route.new(:$path, :&callback, :@middlewares), POST); 103 | } 104 | multi method post(&callback, @middlewares = List.new) { 105 | self.post('', &callback, @middlewares); 106 | } 107 | 108 | multi method put(Str:D $path, &callback, @middlewares = List.new) { 109 | self!add-route(Route.new(:$path, :&callback, :@middlewares), PUT); 110 | } 111 | multi method put(&callback, @middlewares = List.new) { 112 | self.put('', &callback, @middlewares); 113 | } 114 | 115 | multi method patch(Str:D $path, &callback, @middlewares = List.new) { 116 | self!add-route(Route.new(:$path, :&callback, :@middlewares), PATCH); 117 | } 118 | multi method patch(&callback, @middlewares = List.new) { 119 | self.patch('', &callback, @middlewares); 120 | } 121 | 122 | multi method delete(Str:D $path, &callback, @middlewares = List.new) { 123 | self!add-route(Route.new(:$path, :&callback, :@middlewares), DELETE); 124 | } 125 | multi method delete(&callback, @middlewares = List.new) { 126 | self.delete('', &callback, @middlewares); 127 | } 128 | 129 | method plugin($plugin) { 130 | @PLUGINS.push: $plugin; 131 | } 132 | 133 | method middleware(&middleware) { 134 | @!middlewares.push: &middleware; 135 | } 136 | 137 | method advice(&advice) { 138 | @!advice.push: &advice; 139 | } 140 | 141 | method TWEAK { 142 | $!root = ('/' ~ $!root) unless $!root.starts-with: '/'; 143 | } 144 | } 145 | 146 | sub dispatch-request(Request:D $request, Response:D $response) { 147 | my @uri_parts = split_uri($request.path); 148 | if (@uri_parts.elems < 1) || (@uri_parts.elems == 1 && @uri_parts[0] ne '/') { 149 | return $response.status(404); 150 | } 151 | 152 | my %loc := %ROUTES; 153 | my %catch-all; 154 | for @uri_parts -> $uri { 155 | my $possible-param = %loc.keys.first: *.starts-with($PARAM_IDX); 156 | %catch-all = %loc{$CATCH_ALL_IDX} if %loc.keys.first: * eq $CATCH_ALL_IDX; 157 | 158 | if %loc{$uri}:!exists && !$possible-param { 159 | if %catch-all { 160 | %loc := %catch-all; 161 | last; 162 | } 163 | 164 | return $response.status(404); 165 | } elsif $possible-param && !%loc{$uri} { 166 | $request.params{~$possible-param.match(/<[A..Z a..z 0..9 \- \_]>+/)} = $uri; 167 | %loc := %loc{$possible-param}; 168 | } else { 169 | %loc := %loc{$uri}; 170 | } 171 | 172 | # If the route could possibly be static 173 | with %loc{$request.method} { 174 | if %loc{$request.method}.static { 175 | return %loc{$request.method}($request, $response); 176 | } 177 | } 178 | } 179 | 180 | # For HEAD requests we should return a GET request. The decoder will delete the body 181 | if $request.method === HEAD { 182 | if %loc{GET}:exists { 183 | return %loc{GET}($request, $response); 184 | } else { 185 | return $response.status(405).html('

405 Method Not Allowed

'); 186 | } 187 | } 188 | 189 | # If we don't support the request method on this route. 190 | without %loc{$request.method} { 191 | return $response.status(405).html('

405 Method Not Allowed

'); 192 | } 193 | 194 | return %loc{$request.method}($request, $response); 195 | 196 | # This is how we pass to error advice. 197 | CATCH { 198 | when %ERROR{.^name}:exists { return %ERROR{.^name}($_, $response.status(500)) } 199 | default { 200 | my $err = $_; 201 | with %*ENV { 202 | if .lc ~~ 'prod' | 'production' { 203 | return $response.status(500).html('

500 Internal Server Error

, Something went very wrong on our end!!'); 204 | } 205 | } 206 | return $response.status(500).html("

500 Internal Server Error


$err
{ $err.backtrace.nice }
"); 207 | } 208 | } 209 | } 210 | 211 | sub get(Str:D $path, &callback, @middlewares = List.new) is export { 212 | delegate-route(Route.new(:$path, :&callback, :@middlewares), GET); 213 | } 214 | 215 | sub put(Str:D $path, &callback, @middlewares = List.new) is export { 216 | delegate-route(Route.new(:$path, :&callback, :@middlewares), PUT); 217 | } 218 | 219 | sub post(Str:D $path, &callback, @middlewares = List.new) is export { 220 | delegate-route(Route.new(:$path, :&callback, :@middlewares), POST); 221 | } 222 | 223 | sub patch(Str:D $path, &callback, @middlewares = List.new) is export { 224 | delegate-route(Route.new(:$path, :&callback, :@middlewares), PATCH); 225 | } 226 | 227 | sub delete(Str:D $path, &callback, @middlewares = List.new) is export { 228 | delegate-route(Route.new(:$path, :&callback, :@middlewares), DELETE); 229 | } 230 | 231 | sub group(@routes, @middlewares) is export { 232 | .(@middlewares) for @routes; 233 | } 234 | 235 | multi sub static(Str:D $path, Str:D $static-path, @middlewares = List.new) is export { static($path, $static-path.IO, @middlewares) } 236 | multi sub static(Str:D $path, IO::Path:D $static-path, @middlewares = List.new) is export { 237 | 238 | my sub callback(Humming-Bird::Glue::Request:D $request, Humming-Bird::Glue::Response:D $response) { 239 | return $response.status(400) if $request.path.contains: '..'; 240 | my $cut-size = $path.ends-with('/') ?? $path.chars !! $path.chars + 1; 241 | my $file = $static-path.add($request.path.substr: $cut-size, $request.path.chars); 242 | 243 | return $response.status(404) unless $file.e; 244 | 245 | $response.file(~$file); 246 | } 247 | 248 | delegate-route(Route.new(:$path, :&callback, :@middlewares, :is-static), GET); 249 | } 250 | 251 | multi sub advice(--> List:D) is export { 252 | @ADVICE.clone; 253 | } 254 | 255 | multi sub advice(@advice) is export { 256 | @ADVICE.append: @advice; 257 | } 258 | 259 | multi sub advice(&advice) is export { 260 | @ADVICE.push: &advice; 261 | } 262 | 263 | multi sub middleware(@middleware) is export { 264 | @MIDDLEWARE.append: @middleware; 265 | } 266 | 267 | multi sub middleware(&middleware) is export { 268 | @MIDDLEWARE.push: &middleware; 269 | } 270 | 271 | multi sub middleware { return @MIDDLEWARE.clone } 272 | 273 | sub error($type, &handler) is export { 274 | %ERROR{$type.^name} = &handler; 275 | } 276 | 277 | sub routes(--> Hash:D) is export { 278 | %ROUTES.clone; 279 | } 280 | 281 | sub plugin(Str:D $plugin, **@args --> Array:D) is export { 282 | @PLUGINS.push: [$plugin, @args]; 283 | } 284 | 285 | sub handle(Humming-Bird::Glue::Request:D $request) { 286 | my $response = Response.new(initiator => $request, status => HTTP::Status(200)); 287 | dispatch-request($request, $response); 288 | 289 | for @ADVICE -> &advice { 290 | &advice($response); 291 | } 292 | 293 | return $response; 294 | } 295 | 296 | sub listen(Int:D $port, Str:D $addr = '0.0.0.0', :$no-block, :$timeout = 3, :$backend = Humming-Bird::Backend::HTTPServer) is export { 297 | use Terminal::ANSIColor; 298 | my $server = $backend.new(:$port, :$addr, :$timeout); 299 | 300 | for @PLUGINS -> [$plugin, @args] { 301 | my $fq = 'Humming-Bird::Plugin::' ~ $plugin; 302 | { 303 | { 304 | require ::($fq); 305 | CATCH { 306 | default { 307 | die "It doesn't look like $fq is a valid plugin? Are you sure it's installed?\n\n$_"; 308 | } 309 | } 310 | } 311 | 312 | use MONKEY; 313 | my $instance; 314 | EVAL "use $fq; \$instance = $fq.new;"; 315 | my Any $mutations = $instance.register($server, %ROUTES, @MIDDLEWARE, @ADVICE, |@args); 316 | 317 | if $mutations ~~ Hash { 318 | for $mutations.keys -> $mutation { 319 | my &method = $mutations{$mutation}; 320 | Humming-Bird::Glue::HTTPAction.^add_method($mutation, &method); 321 | } 322 | } 323 | 324 | say "Plugin: $fq ", colored('✓', 'green'); 325 | 326 | CATCH { 327 | default { 328 | die "Something went wrong registering plugin: $fq\n\n$_"; 329 | } 330 | } 331 | } 332 | } 333 | 334 | say( 335 | colored('Humming-Bird', 'green'), 336 | " listening on port http://$addr:$port", 337 | "\n" 338 | ); 339 | 340 | say( 341 | colored('Warning', 'yellow'), 342 | ': Humming-Bird is currently running in DEV mode, please set HUMMING_BIRD_ENV to PROD or PRODUCTION to enable PRODUCTION mode.', 343 | "\n" 344 | ) if (%*ENV:exists && %*ENV.Str.lc ~~ 'prod' | 'production'); 345 | 346 | if $no-block { 347 | start { 348 | $server.listen(&handle); 349 | } 350 | } else { 351 | $server.listen(&handle); 352 | } 353 | } 354 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Glue.rakumod: -------------------------------------------------------------------------------- 1 | use HTTP::Status; 2 | use MIME::Types; 3 | use URI::Encode; 4 | use DateTime::Format::RFC2822; 5 | use JSON::Fast; 6 | 7 | unit module Humming-Bird::Glue; 8 | 9 | my constant $rn = Buf.new("\r\n".encode); 10 | my constant $rnrn = Buf.new("\r\n\r\n".encode); 11 | 12 | # Mime type parser from MIME::Types 13 | my constant $mime = MIME::Types.new; 14 | 15 | enum HTTPMethod is export ; 16 | 17 | # Converts a string of headers "KEY: VALUE\r\nKEY: VALUE\r\n..." to a map of headers. 18 | my sub decode-headers(@header_block --> Map:D) { 19 | Map.new(@header_block.map(*.trim.split(': ', 2, :skip-empty).map(*.trim)).map({ [@^a[0].lc, @^a[1]] }).flat); 20 | } 21 | 22 | sub trim-utc-for-gmt(Str:D $utc --> Str:D) { $utc.subst(/"+0000"/, 'GMT') } 23 | sub now-rfc2822(--> Str:D) { 24 | trim-utc-for-gmt: DateTime.now(formatter => DateTime::Format::RFC2822.new()).utc.Str; 25 | } 26 | 27 | # Convert a string to HTTP method, defaults to GET 28 | sub http-method-of-str(Str:D $method --> HTTPMethod:D) { 29 | given $method.lc { 30 | when 'get' { GET } 31 | when 'post' { POST; } 32 | when 'put' { PUT } 33 | when 'patch' { PATCH } 34 | when 'delete' { DELETE } 35 | when 'head' { HEAD } 36 | default { GET } 37 | } 38 | } 39 | 40 | my subset SameSite of Str where 'Strict' | 'Lax'; 41 | class Cookie is export { 42 | has Str $.name; 43 | has Str $.value; 44 | has DateTime $.expires; 45 | has Str $.domain; 46 | has Str $.path where { .starts-with('/') orelse .throw } = '/'; 47 | has SameSite $.same-site = 'Strict'; 48 | has Bool $.http-only = True; 49 | has Bool $.secure = False; 50 | 51 | method encode(--> Str:D) { 52 | my $expires = ~trim-utc-for-gmt($.expires.clone(formatter => DateTime::Format::RFC2822.new()).utc.Str); 53 | ("$.name=$.value", "Expires=$expires", "SameSite=$.same-site", "Path=$.path", $.http-only ?? 'HttpOnly' !! '', $.secure ?? 'Secure' !! '', $.domain // '') 54 | .grep({ .chars }) 55 | .join('; '); 56 | } 57 | 58 | submethod decode(Str:D $cookie-string) { # We decode "simple" cookies only, since they come from the requests 59 | Map.new: $cookie-string.split(/\s/, 2, :skip-empty) 60 | .map(*.split('=', 2, :skip-empty)) 61 | .map(-> ($name, $value) { $name => Cookie.new(:$name, :$value) }) 62 | .flat; 63 | } 64 | } 65 | 66 | class HTTPAction { 67 | has $.context-id; 68 | has %.headers; 69 | has %.cookies; 70 | has %.stash; 71 | has Buf:D $.body is rw = Buf.new; 72 | 73 | # Find a header in the action, return (Any) if not found 74 | multi method header(Str:D $name --> Str) { 75 | my $lc-name = $name.lc; 76 | return Str without %.headers{$lc-name}; 77 | %.headers{$lc-name}; 78 | } 79 | 80 | multi method header(Str:D $name, Str:D $value) { 81 | %.headers{$name.lc} = $value; 82 | self; 83 | } 84 | 85 | multi method cookie(Str:D $name --> Cookie) { 86 | return Nil without %.cookies{$name}; 87 | %.cookies{$name}; 88 | } 89 | 90 | method log(Str:D $message, :$file = $*OUT) { 91 | $file.print: "[Context: { self.context-id }] | [Time: { DateTime.now }] | $message\n"; 92 | self; 93 | } 94 | } 95 | 96 | my sub parse-urlencoded(Str:D $urlencoded --> Map:D) { 97 | $urlencoded.split('&', :skip-empty).map(&uri_decode_component)>>.split('=', 2, :skip-empty)>>.map(-> $a, $b { $b.contains(',') ?? slip $a => $b.split(',', :skip-empty) !! slip $a => $b }) 98 | .flat 99 | .Map; 100 | } 101 | 102 | class Request is HTTPAction is export { 103 | has Str $.path is required; 104 | has HTTPMethod $.method is required; 105 | has Str $.version is required; 106 | has %.params; 107 | has %.query; 108 | has $!content; 109 | 110 | # Attempts to parse the body to a Map or return an empty map if we can't decode it 111 | subset Content where * ~~ Buf:D | Map:D | List:D; 112 | method content(--> Content:D) { 113 | 114 | state $prev-body = $.body; 115 | 116 | return $!content if $!content && ($prev-body eqv $.body); 117 | return $!content = Map.new unless self.header('Content-Type'); 118 | 119 | { 120 | CATCH { 121 | default { 122 | warn "Encountered Error: $_;\n Failed parsing a body of type { self.header('Content-Type') }"; return ($!content = Map.new) 123 | } 124 | } 125 | 126 | if self.header('Content-Type').ends-with: 'json' { 127 | $!content = from-json($.body.decode).Map; 128 | } elsif self.header('Content-Type').ends-with: 'urlencoded' { 129 | $!content = parse-urlencoded($.body.decode).Map; 130 | } elsif self.header('Content-Type').starts-with: 'multipart/form-data' { 131 | # Multi-part parser based on: https://github.com/croservices/cro-http/blob/master/lib/Cro/HTTP/BodyParsers.pm6 132 | my $boundary = self.header('Content-Type') ~~ /.*'boundary="' <(.*)> '"' ';'?/; 133 | 134 | # For some reason there is no standard for quotes or no quotes. 135 | $boundary //= self.header('Content-Type') ~~ /.*'boundary=' <(.*)> ';'?/; 136 | 137 | $boundary .= Str with $boundary; 138 | 139 | without $boundary { 140 | die "Missing boundary parameter in for 'multipart/form-data'"; 141 | } 142 | 143 | my $payload = $.body.decode('latin-1'); 144 | 145 | my $dd-boundary = "--$boundary"; 146 | my $start = $payload.index($dd-boundary); 147 | without $start { 148 | die "Could not find starting boundary of multipart/form-data"; 149 | } 150 | 151 | # Extract all the parts. 152 | my $search = "\r\n$dd-boundary"; 153 | $payload .= substr($start + $dd-boundary.chars); 154 | my @part-strs; 155 | loop { 156 | last if $payload.starts-with('--'); 157 | my $end-boundary-line = $payload.index("\r\n"); 158 | without $end-boundary-line { 159 | die "Missing line terminator after multipart/form-data boundary"; 160 | } 161 | if $end-boundary-line != 0 { 162 | if $payload.substr(0, $end-boundary-line) !~~ /\h+/ { 163 | die "Unexpected text after multpart/form-data boundary " ~ 164 | "('$end-boundary-line')"; 165 | } 166 | } 167 | 168 | my $next-boundary = $payload.index($search); 169 | without $next-boundary { 170 | die "Unable to find boundary after part in multipart/form-data"; 171 | } 172 | my $start = $end-boundary-line + 1; 173 | @part-strs.push($payload.substr($start, $next-boundary - $start)); 174 | $payload .= substr($next-boundary + $search.chars); 175 | } 176 | 177 | my %parts; 178 | for @part-strs -> $part { 179 | my ($header, $body-str) = $part.split("\r\n\r\n", 2); 180 | my %headers = decode-headers($header.split("\r\n", :skip-empty)); 181 | with %headers { 182 | my $param-start = .index(';'); 183 | my $parameters = $param-start ?? .substr($param-start) !! Str; 184 | without $parameters { 185 | die "Missing content-disposition parameters in multipart/form-data part"; 186 | } 187 | 188 | my $name = $parameters.match(/'name="'<(<[a..z A..Z 0..9 \- _ : \.]>+)>'";'?.*/).Str; 189 | my $filename-param = $parameters.match(/.*'filename="'<(<[a..z A..Z 0..9 \- _ : \.]>+)>'";'?.*/); 190 | my $filename = $filename-param ?? $filename-param.Str !! Str; 191 | %parts{$name} = { 192 | :%headers, 193 | $filename ?? :$filename !! (), 194 | body => Buf.new($body-str.encode('latin-1')) 195 | }; 196 | } 197 | else { 198 | die "Missing content-disposition header in multipart/form-data part"; 199 | } 200 | } 201 | 202 | $!content := %parts; 203 | } 204 | 205 | return $!content; 206 | } 207 | 208 | $!content = Map.new; 209 | } 210 | 211 | method param(Str:D $param --> Str) { 212 | return Nil without %!params{$param}; 213 | %!params{$param}; 214 | } 215 | 216 | method queries { 217 | return %!query; 218 | } 219 | 220 | multi method query { 221 | return %!query; 222 | } 223 | multi method query(Str:D $query_param --> Str) { 224 | return Nil without %!query{$query_param}; 225 | %!query{$query_param}; 226 | } 227 | 228 | multi submethod decode(Str:D $payload --> Request:D) { 229 | return Request.decode(Buf.new($payload.encode)); 230 | } 231 | multi submethod decode(Buf:D $payload --> Request:D) { 232 | my $binary-str = $payload.decode('latin-1'); 233 | my $idx = 0; 234 | 235 | loop { 236 | $idx++; 237 | last if (($payload[$idx] == $rn[0] 238 | && $payload[$idx + 1] == $rn[1]) 239 | || $idx > ($payload.bytes + 1)); 240 | } 241 | my ($method_raw, $path, $version) = $payload.subbuf(0, $idx).decode.chomp.split(/\s/, 3, :skip-empty); 242 | 243 | my $method = http-method-of-str($method_raw); 244 | 245 | # Find query params 246 | my %query; 247 | if uri_decode_component($path) ~~ m:g /\w+"="(<-[&]>+)/ { 248 | %query = Map.new($<>.map({ .split('=', 2, :skip-empty) }).flat); 249 | $path = $path.split('?', 2)[0]; 250 | } 251 | 252 | $idx += 2; 253 | my $header-marker = $idx; 254 | loop { 255 | $idx++; 256 | last if (($payload[$idx] == $rnrn[0] 257 | && $payload[$idx + 1] == $rnrn[1] 258 | && $payload[$idx + 2] == $rnrn[2] 259 | && $payload[$idx + 3] == $rnrn[3]) 260 | || $idx > ($payload.bytes + 3)); 261 | } 262 | 263 | my $header-section = $payload.subbuf($header-marker, $idx); 264 | 265 | # Lose the request line and parse an assoc list of headers. 266 | my %headers = decode-headers($header-section.decode('latin-1').split("\r\n", :skip-empty)); 267 | 268 | $idx += 4; 269 | # Body should only exist if either of these headers are present. 270 | my $body; 271 | with %headers { 272 | if ($idx + 1 < $payload.bytes) { 273 | my $len = +%headers; 274 | $body = Buf.new: $payload[$idx..($payload.bytes - 1)].Slip; 275 | } 276 | } 277 | 278 | $body //= Buf.new; 279 | 280 | # Absolute uris need their path encoded differently. 281 | without %headers { 282 | my $abs-uri = $path; 283 | $path = $abs-uri.match(/^'http' 's'? '://' <[A..Z a..z \w \. \- \_ 0..9]>+ <('/'.*)>? $/).Str; 284 | %headers = $abs-uri.match(/^'http''s'?'://'(<-[/]>+)'/'?.* $/)[0].Str; 285 | } 286 | 287 | my %cookies; 288 | # Parse cookies 289 | with %headers { 290 | %cookies := Cookie.decode(%headers); 291 | } 292 | 293 | my $context-id = rand.Str.subst('0.', '').substr: 0, 5; 294 | 295 | Request.new(:$path, :$method, :$version, :%query, :$body, :%headers, :%cookies, :$context-id); 296 | } 297 | } 298 | 299 | class Response is HTTPAction is export { 300 | has HTTP::Status $.status = HTTP::Status(200); 301 | has Request:D $.initiator is required handles ; 302 | 303 | proto method cookie(|) {*} 304 | multi method cookie(Str:D $name, Cookie:D $value) { 305 | %.cookies{$name} = $value; 306 | self; 307 | } 308 | multi method cookie(Str:D $name, Str:D $value, DateTime:D $expires) { 309 | # Default 310 | my $cookie = Cookie.new(:$name, :$value, :$expires); 311 | %.cookies{$name} = $cookie; 312 | self; 313 | } 314 | multi method cookie(Str:D $name, Str:D $value, :$expires, :$secure) { 315 | my $cookie = Cookie.new(:$name, :$value, :$expires, :$secure); 316 | %.cookies{$name} = $cookie; 317 | self; 318 | } 319 | 320 | proto method status(|) {*} 321 | multi method status(--> HTTP::Status) { $!status } 322 | multi method status(Int:D $status --> Response:D) { 323 | $!status = HTTP::Status($status); 324 | self; 325 | } 326 | multi method status(HTTP::Status:D $status --> Response:D) { 327 | $!status = $status; 328 | self; 329 | } 330 | 331 | # Redirect to a given URI, :$permanent allows for a 308 status code vs a 307 332 | method redirect(Str:D $to, :$permanent, :$temporary) { 333 | self.header('Location', $to); 334 | self.status(303); 335 | 336 | self.status(307) if $temporary; 337 | self.status(308) if $permanent; 338 | 339 | self; 340 | } 341 | 342 | method html(Str:D $body --> Response:D) { 343 | $.write($body, 'text/html'); 344 | self; 345 | } 346 | 347 | # Write a JSON string to the body of the request 348 | method json(Str:D $body --> Response:D) { 349 | $.write($body, 'application/json'); 350 | self; 351 | } 352 | 353 | # Set a file to output. 354 | method file(Str:D $file --> Response:D) { 355 | my $text = $file.IO.slurp(:bin); 356 | my $mime-type = $mime.type($file.IO.extension) // 'text/plain'; 357 | try { 358 | CATCH { 359 | $mime-type = 'application/octet-stream' if $mime-type eq 'text/plain'; 360 | return $.blob($text, $mime-type); 361 | } 362 | # Decode will fail if it's a binary file 363 | $.write($text.decode, $mime-type); 364 | } 365 | self; 366 | } 367 | 368 | # Write a blob or buffer 369 | method blob(Buf:D $body, Str:D $content-type = 'application/octet-stream', --> Response:D) { 370 | $.body = $body; 371 | self.header('Content-Type', $content-type); 372 | self; 373 | } 374 | # Alias for blob 375 | multi method write(Buf:D $body, Str:D $content-type = 'application/octet-stream', --> Response:D) { 376 | self.blob($body, $content-type); 377 | } 378 | 379 | # Write a string to the body of the response, optionally provide a content type 380 | multi method write(Str:D $body, Str:D $content-type = 'text/plain', --> Response:D) { 381 | self.write(Buf.new($body.encode), $content-type); 382 | self; 383 | } 384 | multi method write(Failure $body, Str:D $content-type = 'text/plain', --> Response:D) { 385 | self.write(Buf.new(($body.Str ~ "\n" ~ $body.backtrace).encode), $content-type); 386 | self.status(500); 387 | self; 388 | } 389 | 390 | # Set content type of the response 391 | method content-type(Str:D $type --> Response) { 392 | self.header('Content-Type', $type); 393 | self; 394 | } 395 | 396 | # $with_body is for HEAD requests. 397 | method encode(Bool:D $with-body = True --> Buf:D) { 398 | state @special-content-types = ( 399 | 'application/json', 400 | 'application/xml', 401 | 'application/rss+xml', 402 | 'application/yaml' 403 | ); 404 | my $out = sprintf("HTTP/1.1 %d $!status\r\n", $!status.code); 405 | my $body-size = $.body.bytes; 406 | 407 | if (($body-size > 0) 408 | && (@special-content-types.first(* eq self.header("Content-Type")) 409 | || self.header('Content-Type').starts-with("text/"))) 410 | { 411 | %.headers ~= '; charset=utf-8'; 412 | } 413 | 414 | $out ~= sprintf("Content-Length: %d\r\n", $body-size); 415 | $out ~= sprintf("Date: %s\r\n", now-rfc2822); 416 | $out ~= "X-Server: Humming-Bird (Raku)\r\n"; 417 | 418 | for %.headers.pairs { 419 | $out ~= sprintf("%s: %s\r\n", .key, .value); 420 | } 421 | 422 | for %.cookies.values { 423 | $out ~= sprintf("Set-Cookie: %s\r\n", .encode); 424 | } 425 | 426 | $out ~= "\r\n"; 427 | 428 | return Buf.new($out.encode).append: $.body if $with-body; 429 | return $out; 430 | } 431 | } 432 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Middleware.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | use Humming-Bird::Core; 4 | use Humming-Bird::Glue; 5 | use ULID; 6 | 7 | unit module Humming-Bird::Middleware; 8 | 9 | my constant $SESSION-NAME = 'HB_SESSION'; 10 | 11 | sub middleware-logger(Request:D $request, Response:D $response, &next) is export { 12 | $request.log(sprintf("%s | %s | %s | %s", $request.method.Str, $request.path, $request.version, $request.header('User-Agent') || 'Unknown Agent')); 13 | &next(); 14 | } 15 | 16 | # Defaults to 24 hour sessions 17 | sub middleware-session(Int:D :$ttl = (3600 * 24), Bool:D :$secure = False) is export { 18 | class Session { 19 | has Str:D $.id = ulid(); 20 | has Instant:D $.expires is required; 21 | has %!stash handles ; 22 | } 23 | 24 | state Lock $lock .= new; 25 | state %sessions; 26 | 27 | sub aux(Request:D $request, Response:D $response, &next) is export { 28 | my $session-id = $request.cookie($SESSION-NAME).?value; 29 | if $session-id and %sessions{$session-id}:exists { 30 | $lock.protect({ $request.stash := %sessions{$session-id} }); 31 | } else { 32 | my $session = Session.new(expires => now + $ttl); 33 | $request.stash := $session; 34 | $response.cookie($SESSION-NAME, $session.id, expires => DateTime.new($session.expires), :$secure); 35 | $lock.protect({ %sessions{$session.id} = $session }); 36 | } 37 | 38 | &next(); 39 | } 40 | 41 | start { 42 | react whenever Supply.interval(1) { 43 | $lock.protect({ %sessions = %sessions.grep({ ($_.value.expires - now) > 0 }) }); 44 | } 45 | }; 46 | 47 | &aux; 48 | } 49 | 50 | # vim: expandtab shiftwidth=4 51 | 52 | =begin pod 53 | =head1 Humming-Bird::Middleware 54 | 55 | Simple middleware for the Humming-Bird web-framework. 56 | 57 | =head2 Exported middlewares 58 | 59 | =head3 middleware-logger 60 | 61 | =for code 62 | use Humming-Bird::Core; 63 | use Humming-Bird::Middleware; 64 | get('/', -> $request, $response { 65 | $response.html('

Hello World!

'); 66 | }, [ &middleware-logger ]); 67 | 68 | This middleware will concisely log all traffic heading for this route. 69 | 70 | =head3 middleware-session 71 | 72 | = for code 73 | use Humming-Bird::Core; 74 | use Humming-Bird::Middleware; 75 | get('/', -> $request, $response { 76 | $response.html('

Hello World!

'); 77 | }, [ middleware-logger(expiry => 4500, :secure) ]); 78 | 79 | This middleware allows a route to access the users session 80 | 81 | =end pod 82 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Plugin.rakumod: -------------------------------------------------------------------------------- 1 | unit role Humming-Bird::Plugin; 2 | 3 | method register { ... } 4 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Plugin/Config.rakumod: -------------------------------------------------------------------------------- 1 | use JSON::Fast; 2 | use Humming-Bird::Plugin; 3 | use Humming-Bird::Core; 4 | 5 | unit class Humming-Bird::Plugin::Config does Humming-Bird::Plugin; 6 | 7 | method register($server, %routes, @middleware, @advice, **@args) { 8 | my $filename = @args[0] // '.humming-bird.json'; 9 | my %config = from-json($filename.IO.slurp // '{}'); 10 | 11 | return %( 12 | config => sub (Humming-Bird::Glue::HTTPAction $a) { %config } 13 | ); 14 | 15 | CATCH { 16 | default { 17 | warn 'Failed to find or parse your ".humming-bird.json" configuration. Ensure your file is well formed, and does exist.'; 18 | } 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Plugin/DBIish.rakumod: -------------------------------------------------------------------------------- 1 | use MONKEY; 2 | use Humming-Bird::Plugin; 3 | use Humming-Bird::Core; 4 | 5 | unit class Humming-Bird::Plugin::DBIish does Humming-Bird::Plugin; 6 | 7 | my %databases; 8 | 9 | method register($server, %routes, @middleware, @advice, **@args) { 10 | my $dbiish = try "use DBIish; DBIish".EVAL; 11 | 12 | if $dbiish ~~ Nil { 13 | die 'You do not have DBIish installed, please install DBIish to use Humming-Bird::Plugin::DBIish.'; 14 | } 15 | 16 | if @args.elems < 1 { 17 | die "Invalid configuration for Humming-Bird::Plugin::DBIish, please provide more arguments.\n\nExample: `plugin 'DBIish', ['SQLite', 'mydb.db']`"; 18 | } 19 | 20 | my $database-name = 'default'; 21 | my @database-args; 22 | 23 | if @args.elems == 1 { 24 | if @args[0].isa(Array) || @args[0].isa(List) { 25 | @database-args = |@args[0]; 26 | } else { 27 | $database-name = @args[0]; 28 | } 29 | } else { 30 | $database-name = @args[0]; 31 | @database-args = |@args[1]; 32 | } 33 | 34 | my %ret; 35 | if (%databases.keys.elems == 0) { 36 | %ret = ( 37 | db => sub db(Humming-Bird::Glue::HTTPAction $a, Str $database = 'default') { 38 | %databases{$database}; 39 | } 40 | ); 41 | } 42 | 43 | my $dh = $dbiish.install-driver(shift @database-args); 44 | 45 | %databases{$database-name} = $dh.connect(|%(|@database-args)); 46 | 47 | return %ret; 48 | 49 | CATCH { 50 | default { 51 | die "Failed to setup Humming-Bird::Plugin::DBIish cause:\n\n$_"; 52 | } 53 | } 54 | } 55 | 56 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Plugin/HotReload.rakumod: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Plugin; 2 | use Humming-Bird::Core; 3 | use Humming-Bird::Backend; 4 | use File::Find; 5 | 6 | unit class Humming-Bird::Plugin::HotReload does Humming-Bird::Plugin; 7 | 8 | my $temp-file = $*KERNEL eq 'linux' 9 | ?? '/tmp/.humming-bird.hotreload' 10 | !! $*CWD ~ '/.humming-bird.hotreload'; 11 | 12 | my sub find-dirs(IO::Path:D $dir) { 13 | slip $dir.IO, slip find :$dir, :type 14 | } 15 | 16 | # Credits to: https://github.com/raku-community-modules/IO-Notification-Recursive 17 | sub watch-recursive(IO(Cool) $start, Bool :$update) is export { 18 | supply { 19 | my sub watch-it(IO::Path:D $io) { 20 | whenever $io.watch -> $e { 21 | if $update { 22 | if $e.event ~~ FileRenamed && $e.path.d { 23 | watch-it($_) for find-dirs $e.path; 24 | } 25 | } 26 | emit $e; 27 | } 28 | } 29 | watch-it($_) for find-dirs $start; 30 | } 31 | } 32 | 33 | class Humming-Bird::Backend::HotReload does Humming-Bird::Backend { 34 | has $!should-refresh = False; 35 | has $!proc; 36 | 37 | method listen(&handler) { 38 | self!observe(); 39 | self!start-server(); 40 | 41 | my $reload-message = "\n" ~ 'Humming-Bird HotReload PID: ' ~ (await $!proc.pid) ~ "\n"; 42 | 43 | react { 44 | whenever signal(SIGINT) { $temp-file.IO.unlink; exit; } 45 | whenever Supply.interval(1, 2) { 46 | if ($!should-refresh) { 47 | self!kill-server(); 48 | self!start-server(); 49 | say $reload-message; 50 | say 'File change detected, refreshing Humming-Bird...'; 51 | $!should-refresh = False; 52 | } 53 | } 54 | } 55 | } 56 | 57 | method !kill-server { 58 | $!proc.kill(9); 59 | } 60 | 61 | method !start-server { 62 | # Devious, evil, dangerous, hack for HotReload.... :) 63 | my $contents = $*PROGRAM-NAME.IO.slurp; 64 | $contents = $contents.subst(/plugin\s\'?\"?HotReload\'?\"?';'?/, '', :g); 65 | 66 | try shell 'reset'; 67 | 68 | $temp-file.IO.spurt: $contents; 69 | $!proc = Proc::Async.new('raku', $temp-file); 70 | $!proc.bind-stdout($*OUT); 71 | $!proc.bind-stderr($*ERR); 72 | $!proc.start; 73 | } 74 | 75 | method !observe { 76 | my $observer = watch-recursive('.'); 77 | $observer.tap({ 78 | Lock.new.protect({ $!should-refresh = True; }) unless $^file.path.ends-with($temp-file); 79 | }); 80 | } 81 | } 82 | 83 | method register($server is rw, %routes, @middleware, @advice, **@args) { 84 | $server = Humming-Bird::Backend::HotReload.new(timeout => 1); 85 | } 86 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Plugin/Logger.rakumod: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Plugin; 2 | use Humming-Bird::Middleware; 3 | use Humming-Bird::Advice; 4 | 5 | unit class Humming-Bird::Plugin::Logger does Humming-Bird::Plugin; 6 | 7 | sub pre-logger($file, $request, $response, &next) { 8 | $request.log(sprintf("%s | %s | %s | %s", $request.method.Str, $request.path, $request.version, $request.header('User-Agent') || 'Unknown Agent'), :$file); 9 | &next(); 10 | } 11 | 12 | sub post-logger($file, $response) { 13 | my $log = "{ $response.status.Int } { $response.status } | { $response.initiator.path } | "; 14 | $log ~= $response.header('Content-Type') ?? $response.header('Content-Type') !! "No Content"; 15 | $response.log: $log; 16 | } 17 | 18 | method register($server, %routes, @middleware, @advice, **@args) { 19 | my $file = @args[0] ?? @args[0].IO !! $*OUT; 20 | @middleware.prepend: &pre-logger.assuming($file); 21 | @advice.prepend: &post-logger.assuming($file); 22 | } 23 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Plugin/Session.rakumod: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Plugin; 2 | use Humming-Bird::Middleware; 3 | use Humming-Bird::Advice; 4 | 5 | unit class Humming-Bird::Plugin::Session does Humming-Bird::Plugin; 6 | 7 | method register($server, %routes, @middleware, @advice, **@args) { 8 | @middleware.push: &middleware-session; 9 | } 10 | -------------------------------------------------------------------------------- /lib/Humming-Bird/Plugin/SlapbirdAPM.rakumod: -------------------------------------------------------------------------------- 1 | use Humming-Bird::Plugin; 2 | use Humming-Bird::Core; 3 | use Cro::HTTP::Client; 4 | 5 | unit class Humming-Bird::Plugin::SlapbirdAPM does Humming-Bird::Plugin; 6 | 7 | has Channel:D $.channel .= new; 8 | has $.lockout = False; 9 | has DateTime $.last_lockout; 10 | 11 | method register($server, %routes, @middleware, @advice, **@args) { 12 | my $key = @args[0] // %*ENV; 13 | my $base-uri = %*ENV // 'https://slapbirdapm.com'; 14 | 15 | if (!$key) { 16 | die 'No SlapbirdAPM key set, either pass it or use the SLAPBIRDAPM_KEY environment variable!'; 17 | } 18 | 19 | my $http = Cro::HTTP::Client.new: :$base-uri, headers => [ x-slapbird-apm => $key ]; 20 | 21 | start react { 22 | whenever $.channel { 23 | CATCH { default { warn $_ } } 24 | my $request = $_; 25 | my $response = $_; 26 | my $start_time = $_; 27 | my $end_time = $_; 28 | my $error = $_; 29 | 30 | my %json = ( 31 | type => 'raku', 32 | method => $request.method, 33 | end_point => $request.path, 34 | start_time => $start_time, 35 | end_time => $end_time, 36 | response_code => $response.status.code, 37 | response_size => $response.body.bytes, 38 | response_headers => $response.headers, 39 | request_id => $request.context-id, 40 | request_size => $request.body.bytes, 41 | request_headers => $request.headers, 42 | error => $error, 43 | requestor => $request.headers // 'UNKNOWN', 44 | handler => 'Humming-Bird', 45 | stack => [], 46 | queries => [], 47 | num_queries => 0, 48 | os => $*VM.osname(), 49 | ); 50 | 51 | my $r = await $http.post('/apm', 52 | content-type => "application/json", 53 | body => %json); 54 | 55 | if ($r.status == 429) { 56 | say "You have maxxed out your SlapbirdAPM plan, please upgrade to continue, or wait 30 days."; 57 | $.lockout = True; 58 | $.last_lockout = DateTime.now().Instant * 1_000; 59 | } 60 | elsif ($r.status != 201) { 61 | say "Got weird response from SlapbirdAPM? Is it down? " ~ $r.status; 62 | } 63 | } 64 | } 65 | 66 | @middleware.push(sub ($request, $response, &next) { 67 | my ($start_time, $f) = DateTime.now().Instant.to-posix; 68 | $response.stash = $start_time * 1_000; 69 | $response.stash = $request; 70 | &next(); 71 | }); 72 | 73 | @advice.push(sub ($response) { 74 | if ($.lockout) { 75 | my $curr = DateTime.now().Instant * 1_000; 76 | 77 | if ($curr - $.last_lockout > 3_600_000) { 78 | $.lockout = False; 79 | } 80 | } 81 | 82 | if (!$.lockout) { 83 | my ($end_time, $f) = DateTime.now().Instant.to-posix; 84 | $.channel.send: %( 85 | request => $response.stash, 86 | response => $response, 87 | start_time => $response.stash, 88 | end_time => $end_time * 1_000, 89 | error => $response.stash 90 | ); 91 | } 92 | 93 | return $response; 94 | }); 95 | } 96 | -------------------------------------------------------------------------------- /sparrow.yaml: -------------------------------------------------------------------------------- 1 | tasks: 2 | - 3 | name: zef-build 4 | language: Bash 5 | default: true 6 | code: | 7 | set -e 8 | cd source/ 9 | zef install . --force-install 10 | zef install App::Prove6 --force-install 11 | prove6 -I. t/ it/ 12 | -------------------------------------------------------------------------------- /t/01-basic.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | use strict; 4 | use Test; 5 | use Humming-Bird::Core; 6 | use Humming-Bird::Glue; 7 | use lib 't/lib'; 8 | use Humming-Bird::Test; 9 | 10 | plan 8; 11 | 12 | my &cb = sub (Request $request, Response $response --> Response) { 13 | $response.html('Hello World'); 14 | } 15 | 16 | get('/', &cb); 17 | 18 | is routes{'/'}{GET}.path, '/', 'Is route path OK?'; 19 | is routes{'/'}{GET}.callback.raku, &cb.raku, 'Is callback OK?'; 20 | 21 | my @context = get-context(path => '/', method => GET, version => 'HTTP/1.1'); 22 | is routes{'/'}{GET}(|@context).header('Content-Type'), 'text/html', 'Is response header content type OK?'; 23 | is routes{'/'}{GET}(|@context).body.decode, 'Hello World', 'Is response body OK?'; 24 | 25 | post('/', &cb); 26 | is routes{'/'}{POST}.path, '/', 'Is route path OK?'; 27 | is routes{'/'}{POST}.callback.raku, &cb.raku, 'Is callback OK?'; 28 | 29 | @context = get-context(path => '/', method => POST, version => 'HTTP/1.1'); 30 | is routes{'/'}{POST}(|@context).header('Content-Type'), 'text/html', 'Is response header content type OK?'; 31 | is routes{'/'}{POST}(|@context).body.decode, 'Hello World', 'Is response body OK?'; 32 | 33 | # vim: expandtab shiftwidth=4 34 | -------------------------------------------------------------------------------- /t/02-request_encoding.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use strict; 3 | use lib 'lib'; 4 | 5 | use Test; 6 | use Humming-Bird::Core; 7 | use Humming-Bird::Glue; 8 | 9 | plan 22; 10 | 11 | my $simple_raw_request = "GET / HTTP/1.1\r\nHost: bob.com\r\n"; 12 | my $simple_request = Request.decode($simple_raw_request); 13 | 14 | ok $simple_request.method === GET, 'Is method OK?'; 15 | is $simple_request.version, 'HTTP/1.1', 'Is version OK?'; 16 | is $simple_request.path, '/', 'Is path OK?'; 17 | 18 | my $simple_header_raw_request = "GET /bob HTTP/1.1\r\nAccepted-Encoding: utf-8\r\nHost: bob.com\r\n\r\n"; 19 | my $simple_header_request = Request.decode($simple_header_raw_request); 20 | 21 | ok $simple_header_request.method === GET, 'Is method for header request OK?'; 22 | is $simple_header_request.header('Accepted-Encoding'), 'utf-8', 'Is header OK?'; 23 | 24 | my $many_header_raw_request = "GET /bob HTTP/1.1\r\nAccepted-Encoding: utf-8\r\nAccept-Language: en-US\r\nConnection: keep-alive\r\nHost: bob.com\r\n\r\n"; 25 | my $many_header_request = Request.decode($many_header_raw_request); 26 | 27 | is $many_header_request.header('Accepted-Encoding'), 'utf-8', 'Is header 1 OK?'; 28 | is $many_header_request.header('Accept-Language'), 'en-US', 'Is header 2 OK?'; 29 | is $many_header_request.header('Connection'), 'keep-alive', 'Is header 3 OK?'; 30 | 31 | dies-ok({ Request.decode: 'POST / HTTP/1.1\r\nHost: bob.com\r\nContent-Type: application/json\r\nChunked-Encoding: yes\r\n\r\n123' }, 'Does chunked encoding die?'); 32 | 33 | my $body = 'aaaaaaaaaa'; 34 | my $simple_post_raw_request = "POST / HTTP/1.1\r\nHost: bob.com\r\nContent-Type: application/json\r\nContent-Length: { $body.chars }\r\n\r\n$body"; 35 | my $simple_post_request = Request.decode($simple_post_raw_request); 36 | 37 | is $simple_post_request.header('Host'), 'bob.com'; 38 | is $simple_post_request.header('Content-Type'), 'application/json'; 39 | is $simple_post_request.header('Content-Length'), $body.chars; 40 | is $simple_post_request.method, POST; 41 | 42 | is $simple_post_request.body.decode('latin-1'), $body, 'Is post body OK?'; 43 | 44 | my $simple_post_empty_raw_request = "POST / HTTP/1.1\r\nContent-Type: application/json\r\nContent-Length: 0\r\nHost: bob.com\r\n\r\n"; 45 | my $simple_post_empty_request = Request.decode($simple_post_empty_raw_request); 46 | 47 | is $simple_post_empty_request.body.decode, '', 'Is empty post body OK?'; 48 | 49 | my $simple-absolute-uri-raw-request = "POST http://localhost/ HTTP/1.1\r\nContent-Type: application/json\r\nContent-Length: { $body.chars }\r\n\r\n$body"; 50 | my $simple-absolute-uri-request = Request.decode($simple-absolute-uri-raw-request); 51 | is $simple-absolute-uri-request.body.decode, $body, 'Is absolute URI body OK?'; 52 | is $simple-absolute-uri-request.header('Host'), 'localhost', 'Is absolute URI host header OK?'; 53 | is $simple-absolute-uri-request.path, '/', 'Is absolute URI path OK?'; 54 | 55 | my $complex-absolute-uri-raw-request = "POST http://localhost/name/person?bob=123 HTTP/1.1\r\nContent-Type: application/json\r\nContent-Length: { $body.chars }\r\n\r\n$body"; 56 | my $complex-absolute-uri-request = Request.decode($complex-absolute-uri-raw-request); 57 | is $complex-absolute-uri-request.body.decode, $body, 'Is absolute URI body OK?'; 58 | is $complex-absolute-uri-request.header('Host'), 'localhost', 'Is absolute URI host header OK?'; 59 | is $complex-absolute-uri-request.path, '/name/person', 'Is absolute URI path OK?'; 60 | is $complex-absolute-uri-request.query('bob'), '123', 'Is query param OK?'; 61 | -------------------------------------------------------------------------------- /t/03-response_decoding.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use strict; 3 | use lib 'lib'; 4 | 5 | use Test; 6 | use Humming-Bird::Core; 7 | use Humming-Bird::Glue; 8 | use HTTP::Status; 9 | 10 | plan 6; 11 | 12 | my $initiator = Request.new(path => '/', method => GET, version => 'HTTP/1.1'); 13 | my $simple_response = Response.new(:$initiator, status => HTTP::Status(200)); 14 | 15 | $simple_response.write('Foo'); 16 | $simple_response.header('Content-Type', 'text/plain'); 17 | 18 | ok my $simple_response_str = $simple_response.encode, 'Does decode not die?'; 19 | 20 | my $simple_response_headers = Response.new(:$initiator, status => HTTP::Status(200)); 21 | 22 | $simple_response_headers.header('Content-Length', 10.Str).header('Encoding', 'utf-8'); 23 | 24 | ok $simple_response_headers.header('encoding'); 25 | ok $simple_response_headers.header('content-LENGTH'); 26 | 27 | ok $simple_response_headers.encode, 'Does encode with headers not die?'; 28 | $simple_response_headers.write('abc'); 29 | is $simple_response_headers.encode.subbuf(*-3), Buf.new(.ords); 30 | 31 | ok $simple_response_str.decode.contains('content-type: text/plain; charset=utf-8'); 32 | 33 | done-testing; 34 | -------------------------------------------------------------------------------- /t/04-middleware.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | 4 | use Test; 5 | 6 | use Humming-Bird::Core; 7 | use Humming-Bird::Glue; 8 | use lib 't/lib'; 9 | use Humming-Bird::Test; 10 | 11 | plan 6; 12 | 13 | use-ok 'Humming-Bird::Middleware'; 14 | 15 | use Humming-Bird::Middleware; 16 | 17 | get('/', -> $request, $response { 18 | $response.html('Hello World!'); 19 | }, [ &middleware-logger ]); 20 | 21 | is routes{'/'}{GET}.middlewares[0].raku, &middleware-logger.raku, 'Is middleware properly assigned?'; 22 | is routes{'/'}{GET}.middlewares[0].elems, 1, 'Is proper number of middleware inside of route?'; 23 | 24 | group(( 25 | &get.assuming('/hello', -> $request, $response { 26 | $response.html('Hello!'); 27 | }), 28 | &get.assuming('/hello/world', -> $request, $response { 29 | $response.html('Hello World!'); 30 | }) 31 | ), [ &middleware-logger ]); 32 | 33 | is routes{'/'}{'hello'}{GET}.middlewares[0].raku, &middleware-logger.raku, 'Is middleware of group properly assigned?'; 34 | is routes{'/'}{'hello'}{'world'}{GET}.middlewares[0].raku, &middleware-logger.raku, 'Is middleware of group properly assigned?'; 35 | 36 | middleware(sub ($request, $response, &next) { $response.html('Foo Bar') }); 37 | get('/foobar', -> $request, $response { $response.write('YOU CANT SEE ME') }); 38 | my @context = get-context(path => '/foobar', method => GET, version => 'HTTP/1.1'); 39 | is routes{'/'}{'foobar'}{GET}(|@context).body, Buf.new('Foo Bar'.encode), 'Is global middleware OK?'; 40 | 41 | done-testing; 42 | -------------------------------------------------------------------------------- /t/05-cookie.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | 4 | use Test; 5 | 6 | use Humming-Bird::Core; 7 | use Humming-Bird::Glue; 8 | use lib 't/lib'; 9 | use Humming-Bird::Test; 10 | 11 | plan 5; 12 | 13 | my $cookie-request = "GET /bob HTTP/1.1\r\nAccepted-Encoding: utf-8\r\nAccept-Language: en-US\r\nConnection: keep-alive\r\nHost: bob.com\r\nCookie: bob=123\r\n"; 14 | 15 | is Request.decode($cookie-request).cookies.name, 'bob', 'Did request encode, create proper cookie name?'; 16 | is Request.decode($cookie-request).cookies.value, '123', 'Did request encode, create proper cookie value?'; 17 | 18 | get('/', -> $request, $response { 19 | # Create 1 hour cookie named bob with value 123 20 | $response.cookie('bob', '123', DateTime.now + Duration.new(3600)).html('Hello World'); 21 | }); 22 | 23 | ok defined(routes{'/'}{GET}(Request.decode($cookie-request)).cookies), 'Did cookie get added to response?'; 24 | is routes{'/'}{GET}(Request.decode($cookie-request)).cookies.name, 'bob', 'Did cookie name get correctly added to response?'; 25 | is routes{'/'}{GET}(Request.decode($cookie-request)).cookies.value, '123', 'Did cookie value get properly added to response?'; 26 | 27 | done-testing; 28 | -------------------------------------------------------------------------------- /t/06-redirect.rakutest: -------------------------------------------------------------------------------- 1 | use lib 'lib'; 2 | 3 | use Test; 4 | use Humming-Bird::Core; 5 | use Humming-Bird::Glue; 6 | use HTTP::Status; 7 | 8 | plan 6; 9 | 10 | my $req = Request.new(path => '/', method => GET, version => 'HTTP/1.1'); 11 | 12 | get('/john', sub ($request, $response) { $response.redirect('/home') }); 13 | 14 | is routes{'/'}{'john'}{GET}($req).header('Location'), '/home', 'Is redirect location OK?'; 15 | is routes{'/'}{'john'}{GET}($req).status, HTTP::Status(303), 'Is redirect status OK?'; 16 | 17 | get('/bob', -> $request, $response { 18 | $response.redirect('/home', :temporary); 19 | }); 20 | 21 | is routes{'/'}{'bob'}{GET}($req).header('Location'), '/home', 'Is temporary redirect location OK?'; 22 | is routes{'/'}{'bob'}{GET}($req).status, HTTP::Status(307), 'Is temporary redirect status OK?'; 23 | 24 | get('/toby', -> $request, $response { 25 | $response.redirect('/home', :permanent); 26 | }); 27 | 28 | is routes{'/'}{'toby'}{GET}($req).header('Location'), '/home', 'Is permanent redirect location OK?'; 29 | is routes{'/'}{'toby'}{GET}($req).status, HTTP::Status(308), 'Is permanent redirect status OK?'; 30 | -------------------------------------------------------------------------------- /t/07-advice.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | use Test; 4 | 5 | use Humming-Bird::Core; 6 | use Humming-Bird::Glue; 7 | 8 | plan 3; 9 | 10 | sub custom-advice($response) { 11 | return $response.write('abc'); 12 | } 13 | 14 | get('/abc', -> $request, $response { 15 | $response.status(204); 16 | }); 17 | 18 | advice(&custom-advice); 19 | 20 | # [1] because the identity function is the root advice. 21 | is advice()[1].raku, &custom-advice.raku, 'Is advice set properly?'; 22 | 23 | my $dumby-request = Request.new(path => '/abc', method => GET, version => 'HTTP/1.1'); 24 | my $response = routes{'/'}{'abc'}{GET}($dumby-request); 25 | my @advice = advice(); 26 | for @advice -> &advice { 27 | &advice($response); 28 | } 29 | 30 | is $response.body.decode, 'abc', 'Is body set correctly by Advice?'; 31 | is $response.status.Int, 204, 'Does response still have old values after advice?'; 32 | 33 | done-testing; 34 | -------------------------------------------------------------------------------- /t/08-static.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | use Test; 4 | 5 | use Humming-Bird::Core; 6 | use Humming-Bird::Glue; 7 | use HTTP::Status; 8 | 9 | plan 6; 10 | 11 | static('/static', 't/static'); 12 | 13 | ok routes{'/'}{'static'}, 'Is route OK?'; 14 | ok routes{'/'}{'static'}{GET}, 'Is route method OK?'; 15 | is routes{'/'}{'static'}{GET}(Request.new(path => 't/static/test.css', method => GET, version => 'HTTP/1.1')).status, HTTP::Status(200), 'Is response status OK?'; 16 | is routes{'/'}{'static'}{GET}(Request.new(path => 't/static/test.css', method => GET, version => 'HTTP/1.1')).body.decode.chomp, q, 'Is response body OK?'; 17 | is routes{'/'}{'static'}{GET}(Request.new(path => 't/static/test.css', method => GET, version => 'HTTP/1.1')).header('Content-Type'), 'text/css', 'Is content-type OK?'; 18 | is routes{'/'}{'static'}{GET}(Request.new(path => 't/static/test.css.bob', method => GET, version => 'HTTP/1.1')).status, HTTP::Status(404), 'Is missing response status OK?'; 19 | 20 | done-testing; 21 | -------------------------------------------------------------------------------- /t/09-routers.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | use Humming-Bird::Core; 4 | use Humming-Bird::Glue; 5 | use HTTP::Status; 6 | use Test; 7 | 8 | plan 9; 9 | 10 | my $router = Router.new(root => '/home'); 11 | 12 | ok $router.advice(-> $response { $response.header('X-Test', 'abc') }); 13 | ok $router.middleware(-> $request, $response, &next { $response.header('X-Middleware', '123'); &next() }); 14 | ok $router.get('/abc', -> $request, $response { $response.write('abc') }); 15 | ok $router.get(-> $request, $response { $response.write('123') }); 16 | 17 | is routes{'/'}{'home'}{GET}(Request.new(path => '/home', method => GET, version => 'HTTP/1.1')).body.decode, '123', 'Is root response body OK?'; 18 | is routes{'/'}{'home'}{'abc'}{GET}(Request.new(path => '/home/abc', method => GET, version => 'HTTP/1.1')).status, HTTP::Status(200), 'Is response status OK?'; 19 | is routes{'/'}{'home'}{'abc'}{GET}(Request.new(path => '/home/abc', method => GET, version => 'HTTP/1.1')).body.decode, 'abc', 'Is response body OK?'; 20 | is routes{'/'}{'home'}{'abc'}{GET}(Request.new(path => '/home/abc', method => GET, version => 'HTTP/1.1')).header('X-Test'), 'abc', 'Is advice working?'; 21 | is routes{'/'}{'home'}{'abc'}{GET}(Request.new(path => '/home/abc', method => GET, version => 'HTTP/1.1')).header('X-Middleware'), '123', 'Is middleware working?'; 22 | 23 | done-testing; 24 | -------------------------------------------------------------------------------- /t/10-content-guessing.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Humming-Bird::Core; 3 | use Humming-Bird::Glue; 4 | use Test; 5 | 6 | plan 7; 7 | 8 | my $request = Request.new(body => Buf.new('{ "foo": "bar" }'.encode), path => '/home', method => GET, version => 'HTTP/1.1'); 9 | $request.header('Content-Type', 'application/json'); 10 | 11 | is $request.content, { foo => 'bar' }, 'Is JSON content decoding OK?'; 12 | 13 | $request = Request.new(body => Buf.new('bob=123&john=abc'.encode), path => '/home', method => GET, version => 'HTTP/1.1'); 14 | $request.header('Content-Type', 'application/urlencoded'); 15 | 16 | is $request.content, Map.new('bob', '123', 'john', 'abc'), 'Is urlencoded content decoding OK?'; 17 | 18 | $request.body = Buf.new('tom=abc&bob=123,456,789&john=abc'.encode); 19 | 20 | is $request.content, Map.new('tom', 'abc', 'bob' => (123,456,789), 'john', 'abc'), 'Is complex urlencoded content decoding OK?'; 21 | 22 | $request.body = Buf.new('tom=abc&lob=123'.encode); 23 | 24 | is $request.content, '123', 'Is urlencoded re-evaluated on change?'; 25 | is $request.content, 'abc', 'Is urlencoded re-evaluated on change?'; 26 | 27 | $request.body = Buf.new('hyperlink=https%3A%2F%2Fyoutube.com%2Fwatch%3Fv%3DxvFZjo5PgG0'.encode); 28 | 29 | lives-ok sub { $request.content }; 30 | is $request.content, 'https://youtube.com/watch?v=xvFZjo5PgG0'; 31 | 32 | done-testing; 33 | -------------------------------------------------------------------------------- /t/11-advanced-query.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use strict; 3 | use lib 'lib'; 4 | 5 | use Test; 6 | use Humming-Bird::Core; 7 | use Humming-Bird::Glue; 8 | 9 | plan 12; 10 | 11 | my $simple_raw_request = "GET /?foo=bar%40baz HTTP/1.1\r\nHost: bob.com\r\n"; 12 | my $simple_request = Request.decode($simple_raw_request); 13 | 14 | ok $simple_request.method === GET, 'Is method OK?'; 15 | is $simple_request.version, 'HTTP/1.1', 'Is version OK?'; 16 | is $simple_request.path, '/', 'Is path OK?'; 17 | is $simple_request.query('foo'), 'bar@baz', 'Is query param correct?'; 18 | 19 | my $advanced_raw_request = "GET /?foo=bar%40baz&j=123%40abc HTTP/1.1\r\nHost: bob.com\r\n"; 20 | my $advanced_request = Request.decode: $advanced_raw_request; 21 | 22 | ok $advanced_request.method === GET, 'Is method OK?'; 23 | is $advanced_request.version, 'HTTP/1.1', 'Is version OK?'; 24 | is $advanced_request.path, '/', 'Is path OK?'; 25 | is $advanced_request.query('foo'), 'bar@baz', 'Is first of query params correct?'; 26 | is $advanced_request.query('j'), '123@abc', 'Is second of query params correct?'; 27 | is $advanced_request.queries, { j => '123@abc', foo => 'bar@baz' }, 'Is queries hash correct?'; 28 | 29 | my $weird_raw_request = "GET /?foo=foo%3Fbar%3D123%3D23 HTTP/1.1\r\nHost: bob.com\r\n"; 30 | my $weird_request = Request.decode: $weird_raw_request; 31 | 32 | ok $weird_request.method === GET, 'Is method OK?'; 33 | is $weird_request.query('foo'), 'foo?bar=123=23', 'Is query decoded correctly?'; 34 | 35 | done-testing; 36 | -------------------------------------------------------------------------------- /t/12-headers.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | use strict; 4 | use Test; 5 | use Humming-Bird::Core; 6 | use Humming-Bird::Glue; 7 | 8 | plan 4; 9 | 10 | my $req = Request.new(path => '/', method => GET, version => 'HTTP/1.1'); 11 | 12 | ok $req.header('Foo', 'bar'), 'Does add ok?'; 13 | ok $req.header('Bar', 'foo'), 'Does add ok?'; 14 | 15 | is $req.header('foo'), 'bar', 'Does get case insensitive?'; 16 | is $req.header('BaR'), 'foo', 'Does get case insensitive?'; 17 | 18 | done-testing; 19 | -------------------------------------------------------------------------------- /t/13-plugin.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | use Test; 4 | use Humming-Bird::Core; 5 | use Humming-Bird::Glue; 6 | use Humming-Bird::Backend; 7 | use Humming-Bird::Middleware; 8 | use Humming-Bird::Advice; 9 | 10 | plan 8; 11 | 12 | class TestBackend does Humming-Bird::Backend { 13 | method listen(&handler) { 14 | return; # Does nothing 15 | } 16 | } 17 | 18 | lives-ok sub { plugin('Config', 't/static/.humming-bird.json'); }, 'Does Config plugin not die?'; 19 | lives-ok sub { plugin 'Logger'; }, 'Does Logger plugin not die?'; 20 | lives-ok sub { plugin 'Session'; }, 'Does Session plugin not die?'; 21 | lives-ok sub { listen(8080, :backend(TestBackend)); }, 'Does plugin register ok?'; 22 | ok Humming-Bird::Glue::HTTPAction.^can('config'), 'Did plugin properly run?'; 23 | 24 | my $action = Humming-Bird::Glue::HTTPAction.new; 25 | 26 | ok $action.config eq 'foo', 'Did config parse properly?'; 27 | is middleware().elems, 2, 'Did logger properly setup middleware?'; 28 | is advice().elems, 2, 'Did logger properly setup advice?'; # This has to be 2 because of the identity function that implicity exists 29 | 30 | done-testing; 31 | -------------------------------------------------------------------------------- /t/14-hotreload.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | use Test; 4 | use Humming-Bird::Core; 5 | use Humming-Bird::Glue; 6 | use Humming-Bird::Backend; 7 | use Humming-Bird::Middleware; 8 | use Humming-Bird::Advice; 9 | 10 | plan 1; 11 | 12 | lives-ok { plugin 'HotReload' }, 'Does HotReload plugin live ok?'; 13 | -------------------------------------------------------------------------------- /t/lib/Humming-Bird/Test.rakumod: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | unit module Humming-Bird::Test; 4 | 5 | use Humming-Bird::Glue; 6 | use HTTP::Status; 7 | 8 | sub get-context(*%args) is export { 9 | my $req = Request.new(|%args); 10 | return [$req, Response.new(initiator => $req, status => HTTP::Status(200))]; 11 | } 12 | -------------------------------------------------------------------------------- /t/opt/plugin-dbiish-sad.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | use Test; 4 | use Humming-Bird::Core; 5 | use Humming-Bird::Glue; 6 | use Humming-Bird::Backend; 7 | use Humming-Bird::Middleware; 8 | use Humming-Bird::Advice; 9 | use Humming-Bird::Plugin::DBIish; 10 | 11 | plan 2; 12 | 13 | my \DBIish = try "use DBIish; DBIish".EVAL; 14 | 15 | if DBIish ~~ Nil { 16 | skip-rest; 17 | exit; 18 | } 19 | 20 | class TestBackend does Humming-Bird::Backend { 21 | method listen(&handler) { 22 | return; # Does nothing 23 | } 24 | } 25 | 26 | lives-ok sub { plugin('DBIish'); }, 'Does plugin not die?'; 27 | dies-ok sub { listen(8080, :backend(TestBackend)); }, 'Does plugin register die?'; 28 | 29 | done-testing; 30 | -------------------------------------------------------------------------------- /t/opt/plugin-dbiish.rakutest: -------------------------------------------------------------------------------- 1 | use v6; 2 | use lib 'lib'; 3 | use Test; 4 | use Humming-Bird::Core; 5 | use Humming-Bird::Glue; 6 | use Humming-Bird::Backend; 7 | use Humming-Bird::Middleware; 8 | use Humming-Bird::Advice; 9 | 10 | my \DBIish = try "use DBIish; DBIish".EVAL; 11 | 12 | plan 9; 13 | 14 | if DBIish ~~ Nil { 15 | skip-rest; 16 | exit; 17 | } 18 | 19 | class TestBackend does Humming-Bird::Backend { 20 | method listen(&handler) { 21 | return; # Does nothing 22 | } 23 | } 24 | 25 | use-ok "Humming-Bird::Plugin::DBIish", 'Does use ok? (not that you should :P)'; 26 | lives-ok sub { plugin('DBIish', ['TestMock']); }, 'Does default plugin not die?'; 27 | lives-ok sub { plugin('DBIish', 'other-db', ['TestMock']); }, 'Does other-db plugin not die?'; 28 | lives-ok sub { listen(8080, :backend(TestBackend)); }, 'Does plugin register ok?'; 29 | ok Humming-Bird::Glue::HTTPAction.^can('db'), 'Did plugin properly run?'; 30 | my $action = Humming-Bird::Glue::HTTPAction.new; 31 | ok $action.^can('db')[0].($action), 'Is default DB accessible?'; 32 | ok $action.^can('db')[0].($action, 'other-db'), 'Is other db accessible?'; 33 | is $action.^can('db')[0].($action).^name.Str, "DBDish::TestMock::Connection", 'Is default db correct type?'; 34 | is $action.^can('db')[0].($action, 'other-db').^name.Str, "DBDish::TestMock::Connection", 'Is other db correct type?'; 35 | 36 | done-testing; 37 | -------------------------------------------------------------------------------- /t/static/.humming-bird.json: -------------------------------------------------------------------------------- 1 | { 2 | "database_url": "foo" 3 | } 4 | -------------------------------------------------------------------------------- /t/static/baobao.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rawleyfowler/Humming-Bird/2bb90e83a4aee1ffc36270d0f1c7041eb9b27567/t/static/baobao.jpg -------------------------------------------------------------------------------- /t/static/test.css: -------------------------------------------------------------------------------- 1 | img { color: 'blue'; } 2 | --------------------------------------------------------------------------------