I have the following Program.fs:
let webApp = choose [ setStatusCode 404 >=> text "Not Found" ]
let errorHandler (ex : Exception) (logger : ILogger) =
logger.LogError(ex, "An unhandled exception has occurred while executing the request.")
clearResponse >=> setStatusCode 500 >=> text ex.Message
let configureApp (app : IApplicationBuilder) =
app.UseHealthChecks(PathString("/health")) |> ignore
let env = app.ApplicationServices.GetService<IHostingEnvironment>()
(match env.IsDevelopment() with
| true -> app.UseDeveloperExceptionPage()
| false -> app.UseGiraffeErrorHandler errorHandler)
.UseHttpsRedirection()
.UseStaticFiles()
.UseGiraffe(webApp)
let configureServices (services : IServiceCollection) =
services.AddHealthChecks() |> ignore
services.AddCors() |> ignore
services.AddGiraffe() |> ignore
let configureLogging (builder : ILoggingBuilder) =
builder.AddFilter(fun l -> l.Equals LogLevel.Error)
.AddConsole()
.AddDebug() |> ignore
[<EntryPoint>]
let main _ =
let contentRoot = Directory.GetCurrentDirectory()
let webRoot = Path.Combine(contentRoot, "WebRoot")
WebHostBuilder()
.UseKestrel()
.UseContentRoot(contentRoot)
.UseIISIntegration()
.UseWebRoot(webRoot)
.Configure(Action<IApplicationBuilder> configureApp)
.ConfigureServices(configureServices)
.ConfigureLogging(configureLogging)
.Build()
.Run()
0
I would like that the default endpoint target the health check (ie. /health), how is that possible using F# Giraffe?
I followed the article given in comment: https://github.com/giraffe-fsharp/Giraffe/blob/master/DOCUMENTATION.md#redirection
and ended up on the following choose:
let webApp = choose [
GET >=>
choose [
route "/" >=> redirectTo false "/health"
]
setStatusCode 404 >=> text "Not Found" ]
Related
I am quite new to using WebSharper and I might be doing things the wrong way.
My goal is to be able to update the contents of my page as a result of user actions by updating a Var<Doc> variable representing a portion of the page to be updated. I'd be happy to know if I could update a Var<Doc> from server-side code and have it reflect in the user's browser.
Below is a quick example:
let TestPage ctx =
let clientPart = Var.Create <| Doc.Empty
clientPart .Value <- div [] [ text "This content is dynamically inserted" ]
Templating.Main ctx EndPoint.Home "Home" [
h1 [] [text "Below is a dynamically inserted content:"]
div [] [ client <# clientPart .View |> Doc.EmbedView #> ]
]
The error I receive is:
System.Exception: Error during RPC JSON conversion ---> System.Exception: Failed to look up translated field name for write' in type WebSharper.UI.Elt with fields: docNode, elt, rvUpdates, updates
The WebSharper 4 documentation regarding Views also states:
It will only be run while the resulting View is included in the document using one of these methods:
Doc.BindView
Doc.EmbedView
textView
and etc.
A similar error is produced if I try this instead:
type SomeTemplate = Template<"SomeTemplate.html">
clientDoc.Value <- SomeTemplate().Doc()
In the above code, Templating.Main is the same as in the default WebSharper project:
module Templating =
...
let Main ctx action (title: string) (body: Doc list) =
let t = MainTemplate().Title(title).MenuBar(MenuBar ctx action).With("Body", body)
let doc : Doc = t.Doc()
doc |> Content.Page
Here is an example calling an RPC on the server side and storing it into a client Var<>:
module ServerFunctions =
let mutable ServerState = ("Zero", 0)
let [< Rpc >] addToState n = async {
let state, counter = ServerState
let newCounter = counter + n
let newState = if newCounter = 0 then "Zero" else "NonZero"
ServerState <- newState, newCounter
return newState
}
[< JavaScript >]
module ClientFunctions =
open WebSharper
open WebSharper.UI
open WebSharper.UI.Html
open ServerFunctions
let zeroState = Var.Create "do not know"
let clientDoc() =
div [] [
h1 [] [ text "State of zero on server:" ]
h2 [] [ text zeroState.V ]
Doc.Button "increment" [] (fun () -> async { let! state = addToState 1
zeroState.Set state
} |> Async.Start)
Doc.Button "decrement" [] (fun () -> async { let! state = addToState -1
zeroState.Set state
} |> Async.Start)
]
module Server =
open global.Owin
open Microsoft.Owin.Hosting
open Microsoft.Owin.StaticFiles
open Microsoft.Owin.FileSystems
open WebSharper.Owin
open WebSharper.UI.Server
open WebSharper.UI.Html
type EndPointServer =
| [< EndPoint "/" >] Hello
| About
let url = "http://localhost:9006/"
let rootdir = #"..\website"
let site() = WebSharper.Application.MultiPage(fun context (s:EndPointServer) ->
printfn "Serving page: %A" s
Content.Page(
Title= ( sprintf "Test %A" s)
, Body = [ h1 [] [ text <| sprintf "%A" s ]
Html.client <# ClientFunctions.clientDoc() #> ])
)
I want to build a simple counter with Suave.
[<EntryPoint>]
let main argv =
let mutable counter = 0;
let app =
choose
[
GET
>=> choose
[
path "/" >=> OK "Hello, world. ";
path "/count" >=> OK (string counter)
]
POST
>=> choose
[
path "/increment"
>=> (fun context -> async {
counter <- counter + 1
return Some context
})
]
]
startWebServer defaultConfig app
0
However, with my current solution, the count at /count never updates.
I think this is because the WebPart is computed when the app is launched, instead of for each request.
What is the best way to achieve this in Suave?
You are right in the assumption that Webparts are values, so computed once. (See this).
You need to use a closure to get what you want:
path "/count" >=> (fun ctx ->
async {
let c = counter in return! OK (string c) ctx
})
I have the following code
let getHtml location =
let request (url:string) =
let response = httpRequest (getFullUri url)
response.Headers.TryFind "Location"
request location
|> Option.bind (fun x -> request x)
|> Option.bind (fun x -> request x) // need the return of httpRequest inside request
I want the code return the last call of httpRequest. Not the return of request.
Update: tried the following code. Error on the last snd. I think I can use a mutable variable to implement it. But is it F# idiomatic?
let getHtml location =
let request (url:string) =
let response = httpRequest (getFullUri url)
match response.Headers.TryFind "Location" with
| Some location -> Some location, response
| None -> None, response
request location |> fst
|> Option.bind (fun x -> request x |> fst)
|> Option.bind (fun x -> request x |> snd) // Error on snd
Use mutable variable?
let getHtml location =
let mutable resp : FSharp.Data.HttpResponse = ???
let request (url:string) =
let response = httpRequest (getFullUri url)
resp <- response
response.Headers.TryFind "Location"
request location
|> Option.bind (fun x -> request x)
|> Option.bind (fun x -> request x)
if not (resp = null) then Some resp else None
I think want you want to do is actually make getHtml recursive, so that when an HTTP request returns a 201 or a 300-level response code, you follow the Location header to the redirected page and return the correct HTML. You could do that with a simple pattern match on the response.StatusCode and the location header, as follows:
open FSharp.Data
// stub
let getFullUri (url: string) =
sprintf "%A" <| System.UriBuilder(url)
// stub
let httpRequest = Http.Request
// fetches the requested URL, following redirects as necessary
let rec getHtml location =
let response = httpRequest (getFullUri location)
match response.StatusCode, response.Headers |> Map.tryFind "Location" with
| (status, Some redirectUrl) when status = 201 || (status >= 300 && status < 400) ->
getHtml redirectUrl
| _ ->
response
Is that what you were going for? I tested it with the following URL that returns a 302, and it got the HTML for the page to which it was redirected: https://jigsaw.w3.org/HTTP/300/302.html
So I have my server set up very simply. If the path is of the form /article/something, it should serve up the static file something.html within the folder static. For some reason, the Files.file webpart is apparently returning None. I tacked on the OK "File Displayed" webpart to verify that this is the case. The OK never executes.
let app =
choose [
pathScan "/article/%s" (fun article ->
let name = sprintf "%s.html" article
Console.WriteLine name
Files.file name >=> OK "File Displayed")
]
let config =
{ defaultConfig with homeFolder = Some (Path.GetFullPath "./static") }
[<EntryPoint>]
let main args =
startWebServer config app
0
Interestingly enough, the Console.WriteLine name line executes perfectly and I see something.html in the console window when I execute this. It appears the problem is exclusively Files.file name returning None.
The file something.html definitely exists in the static folder, so that's not the problem .
Any ideas on what might be causing this?
Here are some parts to troubleshoot static file serving issues
let troubleShootExtensionPart extensionToCheck :WebPart =
fun ctx ->
match extensionToCheck with
| null | "" -> ServerErrors.INTERNAL_ERROR "Extension Error not supplied, part is not set up correctly"
| x when not <| x.StartsWith "." -> ServerErrors.INTERNAL_ERROR "Extensions start with a '.', part is not set up correctly"
| _ ->
let mtm = ctx.runtime.mimeTypesMap
match mtm extensionToCheck with
| None ->
sprintf "%s is not supported by the mime types map, compose your mime type with the `defaultMimeTypesMap`" extensionToCheck
|> RequestErrors.FORBIDDEN
| Some x ->
sprintf "%s is supported and uses '%s', compression on? : %A" extensionToCheck x.name x.compression
|> OK
|> fun wp -> wp ctx
example consumption with a wildcard so if no routes match you get some diagnostic info
#if DEBUG
pathScan "/checkExtension/%s" (fun name -> troubleShootExtensionPart name)
// catch all
(fun ctx -> sprintf "404, also homeFolder resolves to %s" (Path.GetFullPath ".") |> RequestErrors.NOT_FOUND |> fun wp -> wp ctx)
#endif
Not quite sure if it is ok to do this but, my question is: Is there something wrong with my code ? It doesn't go as fast as I would like, and since I am using lots of async workflows maybe I am doing something wrong. The goal here is to build something that can crawl 20 000 pages in less than an hour.
open System
open System.Text
open System.Net
open System.IO
open System.Text.RegularExpressions
open System.Collections.Generic
open System.ComponentModel
open Microsoft.FSharp
open System.Threading
//This is the Parallel.Fs file
type ComparableUri ( uri: string ) =
inherit System.Uri( uri )
let elts (uri:System.Uri) =
uri.Scheme, uri.Host, uri.Port, uri.Segments
interface System.IComparable with
member this.CompareTo( uri2 ) =
compare (elts this) (elts(uri2 :?> ComparableUri))
override this.Equals(uri2) =
compare this (uri2 :?> ComparableUri ) = 0
override this.GetHashCode() = 0
///////////////////////////////////////////////Functions to retrieve html string//////////////////////////////
let mutable error = Set.empty<ComparableUri>
let mutable visited = Set.empty<ComparableUri>
let getHtmlPrimitiveAsyncDelay (delay:int) (uri : ComparableUri) =
async{
try
let req = (WebRequest.Create(uri)) :?> HttpWebRequest
// 'use' is equivalent to ‘using’ in C# for an IDisposable
req.UserAgent<-"Mozilla"
//Console.WriteLine("Waiting")
do! Async.Sleep(delay * 250)
let! resp = (req.AsyncGetResponse())
Console.WriteLine(uri.AbsoluteUri+" got response after delay "+string delay)
use stream = resp.GetResponseStream()
use reader = new StreamReader(stream)
let html = reader.ReadToEnd()
return html
with
| _ as ex -> Console.WriteLine( ex.ToString() )
lock error (fun () -> error<- error.Add uri )
lock visited (fun () -> visited<-visited.Add uri )
return "BadUri"
}
///////////////////////////////////////////////Active Pattern Matching to retreive href//////////////////////////////
let (|Matches|_|) (pat:string) (inp:string) =
let m = Regex.Matches(inp, pat)
// Note the List.tl, since the first group is always the entirety of the matched string.
if m.Count > 0
then Some (List.tail [ for g in m -> g.Value ])
else None
let (|Match|_|) (pat:string) (inp:string) =
let m = Regex.Match(inp, pat)
// Note the List.tl, since the first group is always the entirety of the matched string.
if m.Success then
Some (List.tail [ for g in m.Groups -> g.Value ])
else
None
///////////////////////////////////////////////Find Bad href//////////////////////////////
let isEmail (link:string) =
link.Contains("#")
let isMailto (link:string) =
if Seq.length link >=6 then
link.[0..5] = "mailto"
else
false
let isJavascript (link:string) =
if Seq.length link >=10 then
link.[0..9] = "javascript"
else
false
let isBadUri (link:string) =
link="BadUri"
let isEmptyHttp (link:string) =
link="http://"
let isFile (link:string)=
if Seq.length link >=6 then
link.[0..5] = "file:/"
else
false
let containsPipe (link:string) =
link.Contains("|")
let isAdLink (link:string) =
if Seq.length link >=6 then
link.[0..5] = "adlink"
elif Seq.length link >=9 then
link.[0..8] = "http://adLink"
else
false
///////////////////////////////////////////////Find Bad href//////////////////////////////
let getHref (htmlString:string) =
let urlPat = "href=\"([^\"]+)"
match htmlString with
| Matches urlPat urls -> urls |> List.map( fun href -> match href with
| Match (urlPat) (link::[]) -> link
| _ -> failwith "The href was not in correct format, there was more than one match" )
| _ -> Console.WriteLine( "No links for this page" );[]
|> List.filter( fun link -> not(isEmail link) )
|> List.filter( fun link -> not(isMailto link) )
|> List.filter( fun link -> not(isJavascript link) )
|> List.filter( fun link -> not(isBadUri link) )
|> List.filter( fun link -> not(isEmptyHttp link) )
|> List.filter( fun link -> not(isFile link) )
|> List.filter( fun link -> not(containsPipe link) )
|> List.filter( fun link -> not(isAdLink link) )
let treatAjax (href:System.Uri) =
let link = href.ToString()
let firstPart = (link.Split([|"#"|],System.StringSplitOptions.None)).[0]
new Uri(firstPart)
//only follow pages with certain extnsion or ones with no exensions
let followHref (href:System.Uri) =
let valid2 = set[".py"]
let valid3 = set[".php";".htm";".asp"]
let valid4 = set[".php3";".php4";".php5";".html";".aspx"]
let arrLength = href.Segments |> Array.length
let lastExtension = (href.Segments).[arrLength-1]
let lengthLastExtension = Seq.length lastExtension
if (lengthLastExtension <= 3) then
not( lastExtension.Contains(".") )
else
//test for the 2 case
let last4 = lastExtension.[(lengthLastExtension-1)-3..(lengthLastExtension-1)]
let isValid2 = valid2|>Seq.exists(fun validEnd -> last4.EndsWith( validEnd) )
if isValid2 then
true
else
if lengthLastExtension <= 4 then
not( last4.Contains(".") )
else
let last5 = lastExtension.[(lengthLastExtension-1)-4..(lengthLastExtension-1)]
let isValid3 = valid3|>Seq.exists(fun validEnd -> last5.EndsWith( validEnd) )
if isValid3 then
true
else
if lengthLastExtension <= 5 then
not( last5.Contains(".") )
else
let last6 = lastExtension.[(lengthLastExtension-1)-5..(lengthLastExtension-1)]
let isValid4 = valid4|>Seq.exists(fun validEnd -> last6.EndsWith( validEnd) )
if isValid4 then
true
else
not( last6.Contains(".") ) && not(lastExtension.[0..5] = "mailto")
//Create the correct links / -> add the homepage , make then a comparabel Uri
let hrefLinksToUri ( uri:ComparableUri ) (hrefLinks:string list) =
hrefLinks
|> List.map( fun link -> try
if Seq.length link <4 then
Some(new Uri( uri, link ))
else
if link.[0..3] = "http" then
Some(new Uri(link))
else
Some(new Uri( uri, link ))
with
| _ as ex -> Console.WriteLine(link);
lock error (fun () ->error<-error.Add uri)
None
)
|> List.filter( fun link -> link.IsSome )
|> List.map( fun o -> o.Value)
|> List.map( fun uri -> new ComparableUri( string uri ) )
//Treat uri , removing ajax last part , and only following links specified b Benoit
let linksToFollow (hrefUris:ComparableUri list) =
hrefUris
|>List.map( treatAjax )
|>List.filter( fun link -> followHref link )
|>List.map( fun uri -> new ComparableUri( string uri ) )
|>Set.ofList
let needToVisit uri =
( lock visited (fun () -> not( visited.Contains uri) ) ) && (lock error (fun () -> not( error.Contains uri) ))
let getLinksToFollowAsyncDelay (delay:int) ( uri: ComparableUri ) =
//write
async{
let! links = getHtmlPrimitiveAsyncDelay delay uri
lock visited (fun () ->visited<-visited.Add uri)
let linksToFollow = getHref links
|> hrefLinksToUri uri
|> linksToFollow
|> Set.filter( needToVisit )
return linksToFollow
}
let getDelay(uri:ComparableUri) (authorityDelay:Dictionary<string,System.Diagnostics.Stopwatch >) =
let uriAuthority = uri.Authority
let hasAuthority,watch = authorityDelay.TryGetValue(uriAuthority)
if hasAuthority then
let elapsed = watch.Elapsed
let s = TimeSpan(0,0,0,0,500)-elapsed
if s.TotalMilliseconds < 0.0 then
0
else
int(s.TotalMilliseconds)
else
let temp = System.Diagnostics.Stopwatch()
temp.Start()
authorityDelay.Add(uriAuthority,temp)
0
let rec getLinksToFollowFromSetAsync maxIteration ( uris: seq<ComparableUri> ) =
let authorityDelay = Dictionary<string,System.Diagnostics.Stopwatch>()
if maxIteration = 100 then
Console.WriteLine("Finished")
else
//Unite by authority add delay for those we same authority others ignore
let stopwatch= System.Diagnostics.Stopwatch()
stopwatch.Start()
let newLinks = uris
|> Seq.map( fun uri -> let delay = lock authorityDelay (fun () -> getDelay uri authorityDelay )
getLinksToFollowAsyncDelay delay uri )
|> Async.Parallel
|> Async.RunSynchronously
|> Seq.concat
stopwatch.Stop()
Console.WriteLine("\n\n\n\n\n\n\nTimeElapse : "+string stopwatch.Elapsed+"\n\n\n\n\n\n\n\n\n")
getLinksToFollowFromSetAsync (maxIteration+1) newLinks
seq[set[ComparableUri( "http://rue89.com/" )]]
|>PSeq.ofSeq
|>PSeq.iter(getLinksToFollowFromSetAsync 0 )
getLinksToFollowFromSetAsync 0 (seq[ComparableUri( "http://twitter.com/" )])
Console.WriteLine("Finished")
Some feedBack would be great ! Thank you (note this is just something I am doing for fun)
I think the culprit is the line do! Async.Sleep(delay * 250) - you gradually wait longer and longer. What is the reason for it?