In racket, how do you allow file upload to the web server? - file-upload

I'm trying to enable file upload to a web server using Racket's file-upload formlet (http://docs.racket-lang.org/web-server/formlets.html). The trouble is that formlet-process just returns the name of the file instead of its contents.
Here's what I have so far:
#lang web-server/insta
(require web-server/formlets
web-server/http
xml)
; start: request -> doesn't return
(define (start request)
(show-page request))
; show-page: request -> doesn't return
(define (show-page request)
; Response generator
(define (response-generator embed/url)
(response/xexpr
`(html
(head (title "File upload example"))
(body (h1 "File upload example"))
(form
([action ,(embed/url upload-handler)])
,#(formlet-display file-upload-formlet)
(input ([type "submit"] [value "Upload"]))))))
(define (upload-handler request)
(define a-file (formlet-process file-upload-formlet request))
(display a-file)
(response/xexpr
`(html
(head (title "File Uploaded"))
(body (h1 "File uploaded")
(p "Some text here to say file has been uploaded")))))
(send/suspend/dispatch response-generator))
; file-upload-formlet: formlet (binding?)
(define file-upload-formlet
(formlet
(div ,{(required (file-upload)) . => . a-file})
a-file))
In this case, a-file gets set to a byte string with the name of the file, instead of the contents of the file. How do I get the contents of the file so that I can write it to a file on the server?
Thanks in advance for your help!

OK, here's something that works, though I'm not sure it's the best way of doing things. Basically I had to
add method="POST" and enctype="multipart/form-data" to the form field html (yeah, schoolboy error to omit these, but I'm new to this stuff)
use binding:file-filename and binding:file-contents to extract the file name and contents from the binding returned by the file-upload formlet.
References that helped in figuring this out were
http://lists.racket-lang.org/users/archive/2009-August/034925.html
and
http://docs.racket-lang.org/web-server/http.html
So here's the working code. Obviously WORKINGDIR needs to be set to some working path.
#lang web-server/insta
(require web-server/formlets)
; start: request -> doesn't return
(define (start request)
(show-page request))
; show-page: request -> doesn't return
(define (show-page request)
; Response generator
(define (response-generator embed/url)
(response/xexpr
`(html
(head (title "File upload example"))
(body (h1 "File upload example"))
(form
([action ,(embed/url upload-handler)]
[method "POST"]
[enctype "multipart/form-data"])
,#(formlet-display file-upload-formlet)
(input ([type "submit"] [value "Upload"]))))))
(define (upload-handler request)
(define-values (fname fcontents)
(formlet-process file-upload-formlet request))
(define save-name (string-append "!uploaded-" fname))
(current-directory WORKINGDIR)
(display-to-file fcontents save-name #:exists 'replace)
(response/xexpr
`(html
(head (title "File Uploaded"))
(body (h2 "File uploaded")
(p ,fname)
(h2 "File size (bytes)")
(p ,(number->string (file-size save-name)))))))
(send/suspend/dispatch response-generator))
; file-upload-formlet: formlet (binding?)
(define file-upload-formlet
(formlet
(div ,{(file-upload) . => . binds})
; (formlet-process file-upload-formlet request)
; returns the file name and contents:
(let
([fname (bytes->string/utf-8 (binding:file-filename binds))]
[fcontents (binding:file-content binds)])
(values fname fcontents))))

Related

How to preview an image and filename for a file upload in Clojure?

I want to upload an image, show a preview of the image, and the associated filename, all in Clojure.
The example at http://jsfiddle.net/LvsYc/638/ demonstrates what I want to do, except I want it in Clojure/ClojureScript.
I have attempted to rewrite the code from the above link, and have managed to output the file-name to the console using (js/console.log). I have two global atoms in my file, one for the image name, and one for the image itself. My code below is my attempt so far.
What do I need to do to 1). get the name of the file from the console log and display it in the :span.file-name using these atoms, and 2), display a preview of the image?
(def image (atom "#"))
(def image-name (atom nil))
(def file-upload-selector
"Implements a file-upload button, allowing the user to
navigate to a file on their desktop and select it."
(let
[reader (js/FileReader.)
_ (set! (.-onload reader)
(fn [e]
(reset! image
(-> e .-target .-result ))))
read-url
(fn [input]
(reset! image-name (-> input .-target .-files (aget 0) .-name))
(js/console.log (-> input .-target .-files (aget 0) .-name))
(when-let [file-input (.-files input)]
(.readAsDataURL reader (aget file-input 0))))]
(fn []
[:div.file.has-name.is-boxed
[:label.file-label
[:input.file-input {:type "file"
:name "User_Photo"
:id "file"
:on-change read-url}]
[:span.file-cta
[:span.file-icon
[:i.fas.fa-upload]]
[:span.file-label "Upload profile picture" ]
][:img {:src image :alt "your image" }]
[:span.file-name {:id "filename" } image-name
]]])))
Found a solution that worked for me. After researching online, the following github link was what I needed.
https://github.com/jlangr/image-upload/blob/master/src/cljs/image_upload/core.cljs
Relevant code from #jlangr.
(let [file (first (array-seq (.. file-added-event -target -files)))
file-reader (js/FileReader.)]
(set! (.-onload file-reader)
(fn [file-load-event]
(reset! preview-src (-> file-load-event .-target .-result))
(let [img (.getElementById js/document img-id)]
(set! (.-onload img)
(fn [image-load]
(.log js/console "dimensions:" (.-width img) "x" (.-height img)))))))
(.readAsDataURL file-reader file)))
(defn image-upload-fn []
[:div [:h2 "image-upload"]
[:input {:type "file" :on-change load-image}]
[:img {:id img-id :src #preview-src}]])

Why this list has only void items in Racket

I tried to have user input function using code on this page: A simple Racket terminal interaction
(define entry_list (for/list ([line (in-lines)]
#:break (string=? line "done"))
(println line)))
(println entry_list)
Output is:
this
"this "
is
"is "
a
"a "
test
"test"
for testing only
"for testing only"
done
'(#<void> #<void> #<void> #<void> #<void>)
Why is the list consisting of only "void" items?
That is because the println function returns #<void>. If instead of println you put something that returned a different value for each line you would end up with a more interesting list.
For example, the following code should return a list with the lines that you typed in:
(define entry_list
(for/list ([line (in-lines)]
#:break (string=? line "done"))
line))
If you just want to print the lines then you could have used for instead of for/list, to avoid creating an useless list of voids at the end:

Elm read HTTP response body for non-200 response

How to read HTTP response body for a non 200 HTTP status
getJson : String -> String -> Effects Action
getJson url credentials =
Http.send Http.defaultSettings
{ verb = "GET"
, headers = [("Authorization", "Basic " ++ credentials)]
, url = url
, body = Http.empty
}
|> Http.fromJson decodeAccessToken
|> Task.toResult
|> Task.map UpdateAccessTokenFromServer
|> Effects.task
The above promotes the error from
Task.toResult : Task Http.Error a -> Task x (Result Http.Error a)
The value of which becomes
(BadResponse 400 ("Bad Request"))
My server responds with what is wrong with the request as a JSON payload in the response body. Please help me retrieve that from the Task x a into ServerResult below.
type alias ServerResult = { status : Int, message : String }
The Http package (v3.0.0) does not expose an easy way to treat HTTP codes outside of the 200 to 300 range as non-error responses. Looking at the source code, the handleResponse function is looking between the hardcoded 200 to 300 range
However, with a bit of copy and pasting from that Http package source code, you can create a custom function to replace Http.fromJson in order to handle HTTP status codes outside the normal "success" range.
Here's an example of the bare minimum you'll need to copy and paste to create a custom myFromJson function that acts the same as the Http package except for the fact it also treats a 400 as a success:
myFromJson : Json.Decoder a -> Task Http.RawError Http.Response -> Task Http.Error a
myFromJson decoder response =
let decode str =
case Json.decodeString decoder str of
Ok v -> Task.succeed v
Err msg -> Task.fail (Http.UnexpectedPayload msg)
in
Task.mapError promoteError response
`Task.andThen` myHandleResponse decode
myHandleResponse : (String -> Task Http.Error a) -> Http.Response -> Task Http.Error a
myHandleResponse handle response =
if (200 <= response.status && response.status < 300) || response.status == 400 then
case response.value of
Http.Text str ->
handle str
_ ->
Task.fail (Http.UnexpectedPayload "Response body is a blob, expecting a string.")
else
Task.fail (Http.BadResponse response.status response.statusText)
-- copied verbatim from Http package because it was not exposed
promoteError : Http.RawError -> Http.Error
promoteError rawError =
case rawError of
Http.RawTimeout -> Http.Timeout
Http.RawNetworkError -> Http.NetworkError
Again, that code snippet is almost entirely copy and pasted except for that 400 status check. Copying and pasting like that is usually a last resort, but because of the library restrictions, it seems to be one of your only options at this point.

How to filter a Signal on page load

For the sake of learning, I'm trying to load content only when I click on a button. So far I've managed to :
Reload the content when I click the button.
And Filter the Signal when I click (if the String I send is not "GETPERF")
But my problem is that the Ajax call is still triggered once the page loads.
Here's the code:
-- SIGNALS & MAILBOX
inbox : Signal.Mailbox String
inbox =
Signal.mailbox "SOME TEXT"
result : Signal.Mailbox String
result =
Signal.mailbox ""
-- VIEW
view : String -> Html
view msg =
div [] [
h1 [] [text "Mailbox3"],
p [] [text msg],
button
[onClick inbox.address "GETPERF"]
[text "click perf"],
]
main : Signal Html
main =
Signal.map view result.signal
-- TASK & EFFECTS
port fetchReadme : Signal (Task Http.Error ())
port fetchReadme =
inbox.signal
|> Signal.filter (\sig -> sig == "GETPERF" ) "boo"
|> Signal.map (\_ -> Http.getString "http://localhost:3000/dates" `andThen` report)
report : String -> Task x ()
report html =
Signal.send result.address html
Is there any way to prevent the first Ajax call on page load ? (Or some more idiomatic way of doing all this ?)
The reason you're getting an initial ajax request is that Signal.filter is still keeping that initial value of "boo" (See the Signal.filter documentation here). That value is ignored in the next Signal.map statement by your use of the underscore parameter, but the Http Task is still getting returned and that's why you see an initial ajax request on page load.
Instead of using Signal.filter, you could write a conditional that only sends the ajax request in the correct circumstances, when sig is "GETPERF". And if sig is not "GETPERF" (as in page load), you can, in essence, do nothing by returning Task.succeed (). Here is a refactored fetchReadme function with these changes:
port fetchReadme : Signal (Task Http.Error ())
port fetchReadme =
let
fetchAndReport sig =
if sig == "GETPERF" then
Http.getString "http://localhost:3000/dates"
`andThen` report
else
Task.succeed ()
in
Signal.map fetchAndReport inbox.signal

What is happening to my SQL connection in a for construct?

I'm working on a program that converts the USDA nutrition database files from ASCII into an sqlite database. Information about those files can be found at http://www.ars.usda.gov/Services/docs.htm?docid=8964 and amounts to something really awesome.
However, in the code below, I have my sql connection "disappearing" as soon as I enter a for construct in the function that does conversions.
(defn sanitize-field [field]
(cond
(= field "~~") ""
(= field "") 0
(and (.startsWith field "~") (.endsWith field "~"))
(.substring field 1 (- (.length field) 1))
:default (try
(Double. field)
(catch NumberFormatException n 0.0))))
(defn field-separator [line]
(.split line "\\^"))
(defn parse-file [file]
(map (fn [l] (map sanitize-field (field-separator l)))
(.split (slurp (.getCanonicalPath file)) "\r\n")))
(defn convert-food-description [source-dir]
(println (sql/connection))
(for [entry (parse-file (File. source-dir "FOOD_DES.txt"))]
(do
(println entry)
(println (sql/connection))
(sql/insert-rows "food_des" entry))))
(Class/forName "org.sqlite.JDBC")
(def db {:classname "com.sqlite.JDBC" :subprotocol "sqlite" :subname "nutrition.sqlite"})
(defn convert []
(sql/with-connection db
(convert-food-description (File. "/home/savanni/Downloads/nutrient_database"))))
When I run the convert operation, here is what I get:
user=> (convert)
(convert)
#<Conn org.sqlite.Conn#180e426>
((01001 0100 Butter, salted BUTTER,WITH SALT Y 0.0 6.38 4.27 8.79 3.87)
java.lang.Exception: no current database connection
So, my only println commands are in convert-food-description. It looks like the first one right after the function begins executes fine, printing out the connection that I created with the with-connection statement. But then the for loop begins, I print out the first line of data that I'm going to insert into the database, and then it throws an exception when trying to print the SQL connection again.
What could be causing the connection to disappear there? Is something else entirely happening?
UPDATE: the sql/ functions here all come from clojure.contrib.sql
for is lazy. Your connection handle is being opened and closed by with-connection before for in convert-food-description evaluates.
You have to force evaluation while the connection handle is still alive. Try changing for to doseq, for example.
user> (require '(clojure.contrib [sql :as sql]))
nil
user> (import 'org.sqlite.JDBC)
org.sqlite.JDBC
user> (def db {:classname "com.sqlite.JDBC"
:subprotocol "sqlite"
:subname "foo.sqlite"})
#'user/db
user> (sql/with-connection db (sql/create-table "foo" ["val" "int"]))
(0)
;; Bad
user> (defn foo []
(sql/with-connection db
(for [x (range 10)]
(sql/insert-records "foo" {:val x}))))
#'user/foo
user> (foo)
; Evaluation aborted.
;;java.lang.Exception: no current database connection
;; Good
user> (defn foo []
(sql/with-connection db
(doseq [x (range 10)]
(sql/insert-rows "foo" [x]))))
#'user/foo
user> (foo)
nil
First of all, your (println (sql/connection)) is not printing your current connection. Instead it creates new one and prints it.
Second, you have defined db as (def db {:classname "com.sqlite.JDBC" :subprotocol "sqlite" :subname "nutrition.sqlite"})
This doesn't open connection, this is just a connection description.
Third, you should pass db as a parameter to convert-food-description method, and use that for actual queries.