suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Doc improvements and tutorial bug fix

Browse Source 
svn: r11297
This commit is contained in:
Jay McCarthy 2008-08-18 14:34:55 +00:00
parent 0dcee6d678
commit 4072ecbacc
6 changed files with 261 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/web-server/scribblings/faq.scrbl
View File

@ -65,7 +65,7 @@ Second, if you want to make your own Scheme start-up script, you can write:
(_start-server)
]
@section{How do I set up the server to use HTTPS?}
@section[#:tag "faq:https"]{How do I set up the server to use HTTPS?}
The essence of the solution to this problem is to use an SSL TCP implementation as provided by @schememodname[net/ssl-tcp-unit]. Many of the functions that start the Web Server are parameterized by a @scheme[tcp@] unit. If you pass an SSL unit, then the server will be serving HTTPS. However, to do this, you must write your own start up script. Here's a simple example:

3
collects/web-server/scribblings/running.scrbl
View File

@ -92,6 +92,8 @@ dispatcher. See @filepath{run.ss} for an example of such a script.
(-> void)]{
Constructs an appropriate @scheme[dispatch-config^], invokes the
@scheme[dispatch-server@], and calls its @scheme[serve] function.
The @scheme[#:tcp@] keyword is provided for building an SSL server. See @secref["faq:https"].
}
@; XXX Not the right `server' above.
@ -134,6 +136,7 @@ from a given path:
Calls @scheme[serve/ports] multiple times, once for each @scheme[ip], and returns
a function that shuts down all of the server instances.
}
@defproc[(do-not-return) void]{
This function does not return. If you are writing a script to load the @web-server

14
collects/web-server/scribblings/servlet.scrbl
View File

@ -210,6 +210,20 @@ HTTP responses.
As with @scheme[response/basic], except with @scheme[generator] as a function that is
called to generate the response body, by being given an @scheme[output-response] function
that outputs the content it is called with.
Here is a short example:
@schemeblock[
(make-response/incremental
200 "OK" (current-seconds)
#"application/octet-stream"
(list (make-header #"Content-Disposition"
#"attachement; filename=\"file\""))
(lambda (send/bytes)
(send/bytes #"Some content")
(send/bytes)
(send/bytes #"Even" #"more" #"content!")
(send/bytes "No we're done")))
]
}
@defproc[(response? [v any/c])

137
collects/web-server/scribblings/tutorial/examples/dummy-10.ss Normal file
View File

@ -0,0 +1,137 @@
#lang web-server/insta
(require "dummy-3.ss")
;; start: request -> html-response
;; Consumes a request and produces a page that displays
;; all of the web content.
(define (start request)
(render-blog-page
(initialize-blog!
(build-path (find-system-path 'home-dir)
"the-blog-data.sqlite"))
request))
;; render-blog-page: blog request -> html-response
;; Produces an html-response page of the content of the
;; blog.
(define (render-blog-page a-blog request)
(local [(define (response-generator make-url)
`(html (head (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts a-blog make-url)
(form ((action
,(make-url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit")))))))
(define (insert-post-handler request)
(define bindings (request-bindings request))
(blog-insert-post!
a-blog
(extract-binding/single 'title bindings)
(extract-binding/single 'body bindings))
(render-blog-page a-blog (redirect/get)))]
(send/suspend/dispatch response-generator)))
;; render-post-detail-page: post request -> html-response
;; Consumes a post and produces a detail page of the post.
;; The user will be able to either insert new comments
;; or go back to render-blog-page.
(define (render-post-detail-page a-blog a-post request)
(local [(define (response-generator make-url)
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ((action
,(make-url insert-comment-handler)))
(input ((name "comment")))
(input ((type "submit"))))
(a ((href ,(make-url back-handler)))
"Back to the blog"))))
(define (parse-comment bindings)
(extract-binding/single 'comment bindings))
(define (insert-comment-handler request)
(render-confirm-add-comment-page
a-blog
(parse-comment (request-bindings request))
a-post
request))
(define (back-handler request)
(render-blog-page a-blog request))]
(send/suspend/dispatch response-generator)))
;; render-confirm-add-comment-page :
;; blog comment post request -> html-response
;; Consumes a comment that we intend to add to a post, as well
;; as the request. If the user follows through, adds a comment
;; and goes back to the display page. Otherwise, goes back to
;; the detail page of the post.
(define (render-confirm-add-comment-page a-blog a-comment
a-post request)
(local [(define (response-generator make-url)
`(html (head (title "Add a Comment"))
(body
(h1 "Add a Comment")
"The comment: " (div (p ,a-comment))
"will be added to "
(div ,(post-title a-post))
(p (a ((href ,(make-url yes-handler)))
"Yes, add the comment."))
(p (a ((href ,(make-url cancel-handler)))
"No, I changed my mind!")))))
(define (yes-handler request)
(post-insert-comment! a-blog a-post a-comment)
(render-post-detail-page a-blog a-post (redirect/get)))
(define (cancel-handler request)
(render-post-detail-page a-blog a-post request))]
(send/suspend/dispatch response-generator)))
;; render-post: post (handler -> string) -> html-response
;; Consumes a post, produces an html-response fragment of the post.
;; The fragment contains a link to show a detailed view of the post.
(define (render-post a-blog a-post make-url)
(local [(define (view-post-handler request)
(render-post-detail-page a-blog a-post request))]
`(div ((class "post"))
(a ((href ,(make-url view-post-handler)))
,(post-title a-post))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)"))))
;; render-posts: blog (handler -> string) -> html-response
;; Consumes a make-url, produces an html-response fragment
;; of all its posts.
(define (render-posts a-blog make-url)
(local [(define (render-post/make-url a-post)
(render-post a-blog a-post make-url))]
`(div ((class "posts"))
,@(map render-post/make-url (blog-posts a-blog)))))
;; render-as-itemized-list: (listof html-response) -> html-response
;; Consumes a list of items, and produces a rendering as
;; an unorderered list.
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
;; render-as-item: html-response -> html-response
;; Consumes an html-response, and produces a rendering
;; as a list item.
(define (render-as-item a-fragment)
`(li ,a-fragment))

104
collects/web-server/scribblings/tutorial/examples/dummy-3.ss Normal file
View File

@ -0,0 +1,104 @@
#lang scheme
(require "../dummy-sqlite.ss")
;; A blog is a (make-blog db)
;; where db is an sqlite database handle
(define-struct blog (db))
;; A post is a (make-post blog id)
;; where blog is a blog and id is an integer?
(define-struct post (blog id))
;; initialize-blog! : path? -> blog?
;; Sets up a blog database (if it doesn't exist)
(define (initialize-blog! home)
(define db (sqlite:open home))
(define the-blog (make-blog db))
(with-handlers ([exn? void])
(sqlite:exec/ignore db
(string-append
"CREATE TABLE posts "
"(id INTEGER PRIMARY KEY,"
"title TEXT, body TEXT)"))
(blog-insert-post!
the-blog "First Post" "This is my first post")
(blog-insert-post!
the-blog "Second Post" "This is another post")
(sqlite:exec/ignore
db "CREATE TABLE comments (pid INTEGER, content TEXT)")
(post-insert-comment!
the-blog (first (blog-posts the-blog))
"First comment!"))
the-blog)
;; blog-posts : blog -> (listof post?)
;; Queries for the post ids
(define (blog-posts a-blog)
(local [(define (row->post a-row)
(make-post a-blog (string->number (vector-ref a-row 0))))
(define rows (sqlite:select
(blog-db a-blog)
"SELECT id FROM posts"))]
(cond [(empty? rows)
empty]
[else
(map row->post (rest rows))])))
;; post-title : post -> string?
;; Queries for the title
(define (post-title a-post)
(vector-ref
(second
(sqlite:select
(blog-db (post-blog a-post))
(format "SELECT title FROM posts WHERE id = '~a'"
(post-id a-post))))
0))
;; post-body : post -> string?
;; Queries for the body
(define (post-body p)
(vector-ref
(second
(sqlite:select
(blog-db (post-blog p))
(format "SELECT body FROM posts WHERE id = '~a'"
(post-id p))))
0))
;; post-comments : post -> (listof string?)
;; Queries for the comments
(define (post-comments p)
(local [(define (row->comment a-row)
(vector-ref a-row 0))
(define rows
(sqlite:select
(blog-db (post-blog p))
(format "SELECT content FROM comments WHERE pid = '~a'"
(post-id p))))]
(cond
[(empty? rows) empty]
[else (map row->comment (rest rows))])))
;; blog-insert-post!: blog? string? string? -> void
;; Consumes a blog and a post, adds the post at the top of the blog.
(define (blog-insert-post! a-blog title body)
(sqlite:insert
(blog-db a-blog)
(format "INSERT INTO posts (title, body) VALUES ('~a', '~a')"
title body)))
;; post-insert-comment!: blog? post string -> void
;; Consumes a blog, a post and a comment string. As a side-efect,
;; adds the comment to the bottom of the post's list of comments.
(define (post-insert-comment! a-blog p a-comment)
(sqlite:insert
(blog-db a-blog)
(format
"INSERT INTO comments (pid, content) VALUES ('~a', '~a')"
(post-id p) a-comment)))
(provide blog? blog-posts
post? post-title post-body post-comments
initialize-blog!
blog-insert-post! post-insert-comment!)

4
collects/web-server/scribblings/tutorial/tutorial.scrbl
View File

@ -940,8 +940,8 @@ grow, we will have to deal with concurrency issues, the lack of a simply query l
So, in the next section, we'll talk about how to use an SQL database to store our blog model.
@section{Using an SQL database}
@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-9
web-server/scribblings/tutorial/examples/model-2
@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/dummy-10
web-server/scribblings/tutorial/examples/dummy-3
web-server/scribblings/tutorial/dummy-sqlite)]
@(require (for-label web-server/scribblings/tutorial/dummy-sqlite))
@;@(require (prefix-in sqlite: (for-label (planet jaymccarthy/sqlite:3/sqlite))))