Rebol [
    Title: "REST-Friendly HTTP Protocol"
    Author: "Christopher Ross-Gill"
    Date: 27-Jan-2018
    Home: http://www.ross-gill.com/page/REST_Protocol
    File: %rest.r
    Version: 0.2.0
    Purpose: {
        An elementary HTTP protocol allowing more versatility when developing Web
        Services clients.
    }
    Rights: http://opensource.org/licenses/Apache-2.0
    Type: module
    Name: rgchris.rest
    History: [
        27-Jan-2018 0.2.0 "Tolerance of HTTP/2 Requests; Added Multipart (inc. OAuth)"
        12-Jan-2017 0.1.4 "Tidy up of OAuth portion"
        30-Oct-2012 0.1.3 "Use CURL in place of native TCP; Added OAuth"
        21-Aug-2010 0.1.2 "Submitted to Rebol.org"
        09-Nov-2008 0.1.1 "Minor changes"
        15-Aug-2006 0.1.0 "Original REST Version"
    ]
]

do http://reb4.me/r/altwebform
do http://reb4.me/r/curl

unless in system/schemes 'rest [
    system/schemes: make system/schemes [REST: none]
]

system/schemes/rest: make system/standard/port [
    scheme: 'rest
    port-id: 80
    passive: none
    cache-size: 5
    proxy: make object! [host: port-id: user: pass: type: bypass: none]
]

system/schemes/rest/handler: use [prepare transcribe execute][
    prepare: use [
        request-prototype header-prototype
        oauth-credentials oauth-prototype
        build-multipart
        sign
    ][
        request-prototype: context [
            version: 1.1
            action: "GET"
            headers: none
            query: none
            oauth: target: content: length: timeout: multipart: none
            type: 'application/x-www-form-urlencoded
        ]

        header-prototype: context [
            Expect: none
            Accept: "*/*"
            Connection: "close"
            User-Agent: rejoin ["Rebol/" system/product " " system/version]
            Content-Length: Content-Type: Authorization: Range: Transfer-Encoding: none
        ]

        oauth-credentials: context [
            consumer-key: consumer-secret:
            oauth-token: oauth-token-secret:
            oauth-callback: none
        ]

        oauth-prototype: context [
            oauth_callback: none
            oauth_consumer_key: none
            oauth_token: oauth_nonce: none
            oauth_signature_method: "HMAC-SHA1"
            oauth_timestamp: none
            oauth_version: 1.0
            oauth_verifier: oauth_signature: none
        ]

        compose-multipart-request: use [break-lines make-boundary prototype][
            break-lines: func [data [string!] /at size [integer!]] [
                size: any [size 72]

                rejoin remove collect [
                    while [not tail? data] [
                        keep "^/"
                        keep copy/part data size
                        data: skip data size
                    ]
                ]
            ]

            make-boundary: does [
                rejoin [
                    "--__Rebol__" form system/product "__" replace/all form system/version "." "_" "__"
                    enbase/base checksum/secure form now/precise 16 "__"
                ]
            ]

            prototype: make object! [
                Content-Disposition: Content-Type: Content-Transfer-Encoding: none
            ]

            func [
                "Compose a multipart body from a request object."
                request [object!] "The request object"
                /local key value ; file content boundary
            ][
                boundary: make-boundary

                request/headers/Content-Type: rejoin [
                    {multipart/form-data; boundary="} skip boundary 2 {"}
                ]

                request/content: rejoin remove collect [
                    ; keep "^M^/"

                    parse request/content [
                        some [
                            set key set-word! set value [none! | string! | file! | binary!] (
                                if switch type?/word value [
                                    string! [
                                        key: make prototype [
                                            Content-Disposition: rejoin [{form-data; name="} form key {"}]
                                        ]
                                    ]

                                    binary! [
                                        case [
                                            find/match value #{89504E470D0A1A0A} [
                                                type: "image/png"
                                                filename: "image.png"
                                            ]

                                            find/match value #{474946383761} [
                                                type: "image/gif"
                                                filename: "image.gif"
                                            ]

                                            find/match value #{474946383961} [
                                                type: "image/gif"
                                                filename: "image.gif"
                                            ]

                                            find/match value #{FFD8FF} [
                                                type: "image/jpeg"
                                                filename: "image.jpg"
                                            ]

                                            /else [
                                                type: "application/octet-stream"
                                                filename: "file.bin"
                                            ]
                                        ]

                                        key: make prototype [
                                            Content-Disposition: rejoin [{form-data; name="} form key {"; filename="} filename {"}]
                                            Content-Type: type
                                            ; Content-Transfer-Encoding: "base64"
                                            Content-Transfer-Encoding: "binary"
                                        ]

                                        ; value: break-lines enbase value
                                    ]
                                ][
                                    keep "^M^/"
                                    keep boundary
                                    keep "^M^/"
                                    keep replace/all net-utils/export key "^/" "^M^/"
                                    keep "^M^/"
                                    keep as-string value
                                ]
                            )
                            | skip
                        ]
                    ]

                    keep "^M^/"
                    keep boundary
                    keep "--^M^/"
                ]
            ]
        ]

        sign: func [request [object!] /local header params timestamp out][
            out: copy ""
            timestamp: now/precise

            header: make oauth-prototype [
                oauth_consumer_key: request/oauth/consumer-key
                oauth_token: request/oauth/oauth-token
                oauth_callback: request/oauth/oauth-callback
                oauth_nonce: enbase/base checksum/secure join timestamp oauth_consumer_key 64
                oauth_timestamp: form any [
                    attempt [to integer! difference timestamp 1-Jan-1970/0:0:0]
                    timestamp - 1-Jan-1970/0:0:0 * 86400.0
                ]
                clear find/last oauth_timestamp "."
            ]

            params: sort/skip collect [
                keep body-of header
                if all [
                    request/content
                    not request/multipart
                ][
                    keep request/content
                ]

            ] 2

            header/oauth_signature: enbase/base checksum/secure/key rejoin [
                uppercase form request/action "&" url-encode form request/url "&"
                url-encode replace/all to-webform params "+" "%20"
            ] rejoin [
                request/oauth/consumer-secret "&" any [request/oauth/oauth-token-secret ""]
            ] 64

            foreach [name value] body-of header [
                if value [
                    repend out [", " form name {="} url-encode form value {"}]
                ]
            ]

            if all [
                request/action = "GET"
                request/content
            ][
                request/url: join request/url to-webform/prefix request/content
                request/content: none
            ]

            request/headers/Authorization: join "OAuth" next out
        ]

        prepare: func [port [port!] /local request][
            port/locals/request: request: make request-prototype port/locals/request
            request/action: uppercase form request/action
            request/headers: make header-prototype any [request/headers []]
            request/content: any [port/state/custom request/content]

            either request/oauth [
                request/oauth: make oauth-credentials request/oauth
                sign request
            ][
                request/headers/Authorization: any [
                    request/headers/authorization
                    if all [port/user port/pass][
                        join "Basic " enbase join port/user [#":" port/pass]
                    ]
                ]
            ]

            if port/state/index > 0 [
                request/version: 1.1
                request/headers/Range: rejoin ["bytes=" port/state/index "-"]
            ]

            case/all [
                block? request/content [
                    either request/multipart [
                        request/type: 'multipart/form-data
                        compose-multipart-request request
                    ][
                        request/content: to-webform request/content
                    ]
                ]

                any [
                    string? request/content
                    binary? request/content
                ][
                    request/length: length? request/content
                    if request/length > 1024 [
                        request/headers/Expect: ""
                        ; request/headers/Transfer-Encoding: "chunked"
                        ; request/headers/Connection: "keep-alive"
                    ]
                    request/headers/Content-Length: form request/length
                    request/headers/Content-Type: any [
                        request/headers/Content-Type form request/type
                    ]
                ]
            ]

            port
        ]
    ]

    execute: func [port [port!]][
        curl/full/method/header/with/timeout/into ; url action headers content timeout response
            port/locals/request/url
            port/locals/request/action
            port/locals/request/headers
            port/locals/request/content
            port/locals/request/timeout
            port/locals/response
    ]

    transcribe: use [
        response-code header-feed header-name header-part
        response-prototype header-prototype
    ][
        response-code: use [digit][
            digit: charset "0123456789"
            [3 digit]
        ]

        header-feed: [newline | crlf]

        header-part: use [chars][
            chars: complement charset [#"^(00)" - #"^(1F)"]
            [some chars any [header-feed some " " some chars]]
        ]

        header-name: use [chars][
            chars: charset ["_-0123456789" #"a" - #"z" #"A" - #"Z"]
            [some chars]
        ]

        space: use [space][
            space: charset " ^-"
            [some space]
        ]

        response-prototype: context [
            status: message: http-headers: headers: content: binary: type: length: none
        ]

        header-prototype: context [
            date: server: last-modified: accept-ranges: content-encoding: content-type:
            content-length: location: expires: referer: connection: authorization: none
        ]

        transcribe: func [port [port!] /local response name value pos][
            port/locals/response: response: make response-prototype [
                unless parse/all port/locals/response [
                    "HTTP/" [
                        "1." ["0" | "1"] space copy status response-code
                        space copy message header-part
                        |
                        "2" space copy status response-code (message: "")
                        opt [space opt [copy message header-part]]
                    ] header-feed
                    (net-utils/net-log reform ["HTTP Response:" status message])
                    (
                        status: load status
                        headers: make block! []
                    )
                    some [
                        copy name header-name ":" any " "
                        copy value header-part header-feed
                        (repend headers [to set-word! name value])
                    ]
                    header-feed content: to end (
                        content: as-string binary: as-binary copy content
                    )
                ][
                    net-utils/net-log pos
                    make error! "Could Not Parse HTTP Response"
                ]

                headers: make header-prototype http-headers: new-line/skip headers true 2

                type: all [
                    path? type: attempt [load headers/Content-Type]
                    type
                ]

                length: any [attempt [headers/Content-Length: to integer! headers/Content-Length] 0]
            ]
        ]
    ]

    context [
        port-flags: system/standard/port-flags/pass-thru

        init: func [port [port!] spec [url! block!] /local url][
            port/locals: context [
                request: case/all [
                    url? spec [
                        spec: compose [url: (to url! replace form spec rest:// http://)]
                    ]

                    block? spec [
                        ; we don't alter SPEC here, just resolve and validate the URL value
                        case/all [
                            not url: find spec quote url: [
                                make error! "REST spec needs a URL"
                            ]

                            none? url: pick url 2 [
                                make error! "REST spec missing URL"
                            ]

                            get-word? :url [
                                url: get/any :url
                            ]

                            paren? :url [
                                url: do :url
                            ]

                            not url? :url [
                                make error! "REST spec needs a URL of type URL!"
                            ]

                            not parse/all url ["http" opt "s" "://" to end] [
                                make error! "REST Spec only works with HTTP(S) urls"
                            ]

                            :url [spec]
                        ]
                    ]
                ]

                response: make string! ""
            ]
        ]

        open: func [port [port!]][
            port/state/flags: port/state/flags or port-flags
            execute prepare port
        ]

        copy: :transcribe

        close: does []
    ]
]