Skip to content

Instantly share code, notes, and snippets.

@nojaf
Last active May 10, 2017 06:34
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save nojaf/2b8eb64b4232558dbf5ba238c576bceb to your computer and use it in GitHub Desktop.
Save nojaf/2b8eb64b4232558dbf5ba238c576bceb to your computer and use it in GitHub Desktop.
Giraffe file upload
open Giraffe.HttpHandlers
open Microsoft.AspNetCore.WebUtilities
open System.IO
open System
let isMultipartContentType (contentType:string) =
not(String.IsNullOrEmpty(contentType)) &&
contentType.IndexOf("multipart/", StringComparison.OrdinalIgnoreCase) >= 0
let getBoundary (contentType : string) =
let boundary =
contentType.Split(' ')
|> Array.filter (fun entry -> entry.StartsWith("boundary=", StringComparison.InvariantCulture))
|> Array.head
|> (fun elem -> elem.Substring("boundary=".Length))
// Remove quotes
if boundary.Length >= 2 then
let firstChar = boundary.Chars 0
let lastChar = boundary.Chars (boundary.Length - 1)
if firstChar = '"' && lastChar = '"' then
boundary.Substring(1, boundary.Length - 2)
else
boundary
else
boundary
let getFileName (contentDisposition: string) =
contentDisposition.Split(';')
|> Array.filter(fun part -> part.Contains("filename"))
|> Array.head
|> (fun part -> part.Split('='))
|> Array.rev
|> Array.head
|> (fun name -> name.Trim('"'))
let upload (ctx: HttpHandlerContext) =
async {
let contentType = ctx.HttpContext.Request.ContentType
if not(isMultipartContentType contentType) then
return! ctx |> (setStatusCode 401 >=> text "contentType is not multipart content type")
else
let boundary = getBoundary contentType
let reader = new MultipartReader(boundary, ctx.HttpContext.Request.Body)
let mutable section:MultipartSection = reader.ReadNextSectionAsync() |> Async.AwaitTask |> Async.RunSynchronously
while section <> null do
let chunkSize = 1024
let mutable buffer: byte array = Array.zeroCreate chunkSize
let mutable bytesRead = 0
let fileName = getFileName section.ContentDisposition |> sprintf "%s-%s" (Guid.NewGuid().ToString())
using(new FileStream(fileName, FileMode.CreateNew))(fun stream ->
let readNext() =
bytesRead <- (section.Body.ReadAsync(buffer, 0, buffer.Length) |> Async.AwaitTask |> Async.RunSynchronously)
stream.Write(buffer, 0, bytesRead)
readNext()
while (bytesRead > 0) do
readNext()
)
section <- reader.ReadNextSectionAsync() |> Async.AwaitTask |> Async.RunSynchronously
IO.File.ReadAllText fileName
|> printf "uploaded %s"
return! ctx |> redirectTo false "/"
}
let webApp =
choose [
GET >=>
choose [
route "/" >=> View.get()
]
POST >=>
choose [
route "/upload" >=> upload
]
]
let myForm =
form ["action","/upload";"method","POST"; "enctype", "multipart/form-data"] [
div [c "field"] [
label [c "label"] (rawText "Select xml message")
p [c "control"] [
input ["type","file";"name","xml"]
]
input ["type","submit"; "value", "upload"]
]
]
let get() =
html [] [
head [] [
link ["rel","stylesheet"; "href","https://cdnjs.cloudflare.com/ajax/libs/bulma/0.4.1/css/bulma.min.css"]
]
body [] [
myForm
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment