call-responder* ( path responder -- response )
Furnace framework » HTTP server » HTTP server responders

Next:

main-responder

Vocabulary
http.server

Inputs

path	a sequence of strings
responder	a responder

Outputs

response

a response

Generic word contract
Processes an HTTP request and returns a response.

Notes
When this word is called, various dynamic variables are set; see HTTP request variables.

Definition

IN: http.server

GENERIC: call-responder* ( path responder -- response )

Methods

USING: accessors combinators furnace.actions http http.server
http.server.responses kernel namespaces ;

M: action call-responder*
    [ init-action ] keep request get method>> {
        { "GET" [ handle-get ] }
        { "HEAD" [ handle-get ] }
        { "POST" [ handle-post ] }
        { "PUT" [ handle-put ] }
        { "PATCH" [ handle-patch ] }
        { "DELETE" [ handle-delete ] }
        [ 2drop <405> ]
    } case ;


USING: furnace.asides generic http.server kernel ;

M: asides call-responder*
    [ init-asides ]
    [ M\ asides call-responder* (call-next-method) ] bi ;


USING: accessors combinators furnace.boilerplate
furnace.utilities generic html.forms html.templates
html.templates.chloe http.server kernel ;

M:: boilerplate call-responder*
    ( path responder -- response )
    begin-form path responder M\ boilerplate call-responder*
    (call-next-method) responder init>> ( -- ) call-effect
    dup wrap-boilerplate? [
        clone [| body |
            [
                body responder template>> resolve-template-path
                <chloe> with-boilerplate
            ]
        ] change-body
    ] when ;


USING: accessors generic http.server http.server.static io.files
kernel namespaces sequences urls websites.concatenative ;

M: cgit call-responder*
    dup file-responder set over
    [ f ] [ "/" join serving-path file-exists? ] if-empty [
        url get rot "/" join "url" set-query-param
        "cgit.cgi" >>path drop { "cgit.cgi" } swap
    ] unless M\ cgit call-responder* (call-next-method) ;


USING: furnace.conversations generic http.server kernel
namespaces ;

M: conversations call-responder*
    [ init-conversations ] [ conversations set ]
    [ M\ conversations call-responder* (call-next-method) ] tri
    ;


USING: accessors db furnace.db generic http.server io.pools
kernel namespaces ;

M: db-persistence call-responder*
    [
        pool>> [ acquire-connection ] keep
        [ return-connection-later ] [ drop db-connection set ]
        2bi
    ] [ M\ db-persistence call-responder* (call-next-method) ]
    bi ;


USING: http.server http.server.dispatchers ;

M: dispatcher call-responder* find-responder call-responder ;


USING: http.server http.server.responses http.server.static
kernel namespaces sequences ;

M: file-responder call-responder*
    file-responder set ".." over member?
    [ drop <400> ] [ "/" join serve-object ] if ;


USING: accessors http.server http.server.filters ;

M: filter-responder call-responder* responder>> call-responder ;


USING: generic http.server kernel namespaces webapps.imagebin ;

M: imagebin call-responder*
    [ imagebin set ]
    [ M\ imagebin call-responder* (call-next-method) ] bi ;


USING: accessors furnace.mongodb generic http.server io.pools
kernel mongodb.connection namespaces ;

M: mdb-persistence call-responder*
    dup pool>> [
        mdb-connection set
        M\ mdb-persistence call-responder* (call-next-method)
    ] with-pooled-connection ;


USING: accessors furnace.auth generic http.server kernel
namespaces ;

M: protected call-responder*
    dup protected set dup capabilities>> have-capabilities?
    [ M\ protected call-responder* (call-next-method) ] [
        [ drop ] [ [ description>> ] [ capabilities>> ] bi ] bi*
        realm get login-required*
    ] if ;


USING: furnace.auth furnace.auth.providers generic http.server
kernel namespaces ;

M: realm call-responder*
    dup realm set logged-in? [
        dup init-realm dup logged-in-username dup
        [ users get-user ] when init-user
    ] unless M\ realm call-responder* (call-next-method) ;


USING: accessors furnace.recaptcha http.server kernel namespaces
;

M: recaptcha call-responder*
    dup recaptcha set responder>> call-responder ;


USING: accessors furnace.redirection http.server kernel ;

M: redirect-responder call-responder* nip to>> <redirect> ;


USING: accessors combinators furnace.referrer furnace.utilities
generic http.server http.server.responses kernel ;

M: referrer-check call-responder*
    referrer over quot>> ( referrer -- ? ) call-effect
    [ M\ referrer-check call-responder* (call-next-method) ]
    [ 2drop 403 "Bad referrer" <trivial-response> ] if ;


USING: accessors http.server http.server.rewrite kernel
sequences ;

M: rewrite call-responder*
    over empty?
    [ default>> ] [
        [ [ first ] [ param>> ] bi* set-param ]
        [ [ rest ] [ child>> ] bi* ] 2bi
    ] if call-responder* ;


USING: furnace.redirection generic http.server kernel ;

M: secure-only call-responder*
    [ M\ secure-only call-responder* (call-next-method) ] 2curry
    if-secure ;


USING: furnace.auth generic http.server kernel ;

M: secure-realm-only call-responder*
    [ M\ secure-realm-only call-responder* (call-next-method) ]
    2curry if-secure-realm ;


USING: furnace.sessions http.server kernel namespaces ;

M: sessions call-responder*
    sessions set request-session [ begin-session ] unless*
    existing-session put-session-cookie ;


USING: fastcgi http.server http.server.responses kernel ;

M: test-responder call-responder*
    2drop test-output <html-content> ;


USING: accessors http.server kernel ;

M: trivial-responder call-responder* nip response>> clone ;


USING: http.server http.server.dispatchers ;

M: vhost-dispatcher call-responder* find-vhost call-responder ;


USING: accessors http.server http.server.rewrite kernel
namespaces urls ;

M: vhost-rewrite call-responder*
    dup url get sub-domain?
    [ over param>> set-param child>> ] [ drop default>> ] if
    call-responder ;


USING: accessors combinators.short-circuit http.server
http.server.responses io.encodings.binary kernel math sequences
zim zim.server ;

M: zim-responder call-responder*
    [
        dup { [ length 1 > ] [ first length 1 = ] } 1&&
        [ unclip-slice first ] [ f ] if swap "/" join dup
        { "" "index.htm" "index.html" "main.htm" "main.html" }
        member? [ drop f ] when
    ] [
        zim>>
        [ over [ read-entry-url ] [ 2nip read-main-page ] if ]
        with-zim
    ] bi* 2dup and
    [ <content> binary >>content-encoding ] [ 2drop <404> ] if ;