The sample sitelet project template shows how to protect a single, non-parameterized page. I've googled around a bit, perused WebSharper's website, etc and can't figure out how to protect multiple, parameterized pages. Could someone show me, or point me to, an example of how to do this?
This question recently came up on FPish once more. It appears that there is a simple solution that does not require a whole lot of refactoring. It requires one auxilary function though:
module Sitelet =
let Filter (ok: 'T -> bool) (sitelet: Sitelet<'T>) =
let route req =
match sitelet.Router.Route(req) with
| Some x when ok x -> Some x
| _ -> None
let link action =
if ok action then
sitelet.Router.Link(action)
else None
{ sitelet with Router = Router.New route link }
Suppose you have an Action type with several cases, some of them you want protected and some public:
type Action =
| Pub ..
| Priv ..
Filtering allows you to use the convenient Infer combinator on the complete type and then safely sum the protected and public parts. Since summed sitelets are tried left-to-right, protection will only apply where wanted:
let s1 =
Sitelet.Infer ..
|> Sitelet.Protect
|> Sitelet.Filter (function Priv _ -> true | _ -> false)
let s2 = Sitelet.Infer ..
Sitelet.Sum [s1; s2]
Without filtering, the protected sitelet would capture all requests. There are probably other solutions to this including refactoring and splitting your Action type into several sub-types, or writing a sitelet by hand without using Infer.
Related
I'm trying to write custom equality constraint to compare 2 objects.
open FsUnit
open NUnit.Framework.Constraints
type equalCompany(expected:Company) =
inherit Constraints.EqualConstraint(expected)
override this.ApplyTo (actual:Company option) =
//actual.IsSome |> should equal True
//actual.Value.Id |> should equal expected.Id
ConstraintResult(this, actual, true)
// example of usage:
actualCompany |> should equalCompany expectedCompany
It complains because the ApplyTo implementation matches multiple overloads and I can't find the right syntax.
Ideally I like to compare to Company option but still just Company is fine.
The types involved are the following:
type CompanyType =
| Bank
| Exchange
type Company = {
Id: string
Types: CompanyType list
}
and I'm trying to write my equality constraint because the simple existing equal does not work properly with Types (the list, also if sorted, appears always different)
How can I properly override the ApplyTo function?
I think the issue is that the ApplyTo method that you are trying to override is generic and needs to have a signature ApplyTo<'T> : 'T -> ConstraintResult.
If I understand your code correctly, you are trying to define a comparison between Company and Company option. To Do this, you would need to check (at runtime) that the value passed to ApplyTo is of the right type. Then you can cast it and implement whatever logic you need.
Here is a minimal sample that worked for me, written as an F# script file:
#r "nuget: nunit"
#r "nuget: fsunit"
type Company(s) =
member x.Name = s
open FsUnit
open NUnit.Framework.Constraints
type equalCompany(expected:Company) =
inherit EqualConstraint(expected)
override this.ApplyTo<'T>(actual:'T) =
match box actual with
| :? option<Company> as co ->
ConstraintResult(this, actual,
co.IsSome && co.Value.Name = expected.Name)
| _ ->
ConstraintResult(this, actual, false)
let actualCompany = Company("Test")
let expectedCompany = Company("Test")
// This passes, because it has the right type
Some actualCompany |> should equalCompany expectedCompany
// This does not, because the 'ApplyTo' logic does not handle this type
actualCompany |> should equalCompany expectedCompany
I'm trying to build a system that is similar to FsBolero (TryWebassembly), Fable Repl and many more that uses Fsharp.Compiler.Services.
So I expect it is feasible to achieve my goals but I encountered a problem that I hope is only a result of my lack of experience with that realm of software development
I'm implementing a service that gives user the power to write custom algorithms (DSL) in the context of the domain system.
The code to compile come as a plain raw string that is fully correct F# code.
Sample DSL algorithm looks like:
let code = """
module M
open Lifespace
open Lifespace.LocationPricing
let alg (pricing:LocationPricing) =
let x=pricing.LocationComparisions.CityLevel.Transportation
(8.*x.PublicTransportationStation.Data+ x.RailwayStation.Data+ 5.*x.MunicipalBikeStation.Data) / 14.
"""
that code compiles correctly via CompileToDynamicAssembly. I also provided proper reference to my domain *.dll via -r Fsc parameter.
And here comes my problems as next I have the generated dynamic assembly and want to invoke that algorithm.
I do it with reflection (is there any other way?) with
f.Invoke(null, [|arg|]) when arg is of type LocationPricing and comes from main/hosting project reference.
The Invoke doesn't work because I have error:
Cannot cast LocationPricing to LocationPricing
I had the same problem when tried to use F# interactive services, the error was similar:
Cannot cast [A]LocationPricing to [B]LocationPricing
I'm aware I have two same dlls in the context and F# does have extern alias syntax to solve it.
But other mentioned public systems somehow deals with that or I'm doing it wrongly.
I will look at code of Bolero and FableRepl but it will definately take some time to understand the pitfalls.
Update: Full code (Azure Function)
namespace AzureFunctionFSharp
open System.IO
open System.Text
open Microsoft.Azure.WebJobs
open Microsoft.Azure.WebJobs.Extensions.Http
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Mvc
open Microsoft.Extensions.Logging
open FSharp.Compiler.SourceCodeServices
open Lifespace.LocationPricing
module UserCodeEval =
type CalculationResult = {
Value:float
}
type Error = {
Message:string
}
[<FunctionName("UserCodeEvalSampleLocation")>]
let Run([<HttpTrigger(AuthorizationLevel.Anonymous, "get", "post", Route = null)>] req: HttpRequest, log: ILogger , [<Blob("ranks/short-ranks.json", FileAccess.Read)>] myBlob:Stream)=
log.LogInformation("F# HTTP trigger function processed a request.")
// confirm valid domain dll location
// for a in System.AppDomain.CurrentDomain.GetAssemblies() do
// if a.FullName.Contains("wrometr.lam.to.ranks") then log.LogInformation(a.Location)
// let code = req.Query.["code"].ToString()
// replaced just to show how the user algorithm can looks like
let code =
"""
module M
open Lifespace
open Lifespace.LocationPricing
open Math.MyStatistics
open MathNet.Numerics.Statistics
let alg (pricing:LocationPricing) =
let x= pricing.LocationComparisions.CityLevel.Transportation
(8.*x.PublicTransportationStation.Data+ x.RailwayStation.Data+ 5.*x.MunicipalBikeStation.Data) / 14.
"""
use reader = new StreamReader(myBlob, Encoding.UTF8)
let content = reader.ReadToEnd()
let encode x = LocationPricingStore.DecodeArrayUnpack x
let pricings = encode content
let checker = FSharpChecker.Create()
let fn = Path.GetTempFileName()
let fn2 = Path.ChangeExtension(fn, ".fsx")
let fn3 = Path.ChangeExtension(fn, ".dll")
File.WriteAllText(fn2, code)
let errors, exitCode, dynAssembly =
checker.CompileToDynamicAssembly(
[|
"-o"; fn3;
"-a"; fn2
"-r";#"C:\Users\longer\azure.functions.compiler\bin\Debug\netstandard2.0\bin\MathNet.Numerics.dll"
"-r";#"C:\Users\longer\azure.functions.compiler\bin\Debug\netstandard2.0\bin\Thoth.Json.Net.dll"
// below is crucial and obtained with AppDomain resolution on top, comes as a project reference
"-r";#"C:\Users\longer\azure.functions.compiler\bin\Debug\netstandard2.0\bin\wrometr.lam.to.ranks.dll"
|], execute=None)
|> Async.RunSynchronously
let assembly = dynAssembly.Value
// get one item to test the user algorithm works in the funtion context
let arg = pricings.[0].Data.[0]
let result =
match assembly.GetTypes() |> Array.tryFind (fun t -> t.Name = "M") with
| Some moduleType ->
moduleType.GetMethods()
|> Array.tryFind (fun f -> f.Name = "alg")
|>
function
| Some f -> f.Invoke(null, [|arg|]) |> unbox<float>
| None -> failwith "Function `f` not found"
| None -> failwith "Module `M` not found"
// end of azure function, not important in the problem context
let res = req.HttpContext.Response
match String.length code with
| 0 ->
res.StatusCode <- 400
ObjectResult({ Message = "No Good, Please provide valid encoded user code"})
| _ ->
res.StatusCode <-200
ObjectResult({ Value = result})
**Update: changing data flow **
To move forward I resigned to use domain types in both places. Instead I do all logic in domain assembly and only pass primitives (strings) to reflected invocation. I'm also suprised a lot that caching still works everytime I do compilation on each Azure Function call. I will experiment as well with FSI, in theory it should be faster than reflection but with additional burden to pass parameters to evaluations
In your example, the code that runs inside your dynamically compiled assembly and the code calling it need to share a type LocationPricing. The error you are seeing typically means that you somehow ended up with different assembly loaded in the process that is calling the dynamically compiled code and the code actually running the computation.
It is hard to say exactly why this happened, but you should be able to check whether this is indeed the case by looking at assemblies loaded in the current App Domain. Say that your shared assembly is MyAssembly. You can run:
for a in System.AppDomain.CurrentDomain.GetAssemblies() do
if a.FullName.Contains("MyAssembly") then printfn "%s" a.Location
If you were using F# Interactive Services, then a trick to fix this is to start an FSI session and then send an interaction to the service that loads the assembly from the right place. Something along those lines:
let myAsm = System.AppDomain.CurrentDomain.GetAssemblies() |> Seq.find (fun asm ->
asm.FullName.Contains("MyAssembly"))
fsi.EvalInteraction(sprintf "#r #\"%s\"" myAsm.Location)
I'm working on a side project and I'm using Hopac for the first time. I ran into an odd (to me) compilation issue that I haven't been able to grok. I suspect that I'm the problem here, and not Hopac.
The program is supposed to be a simple console app that consumes notifications from various services. Here's the problematic module:
module Provider
open System
open System.IO
open Hopac
open BitThicket.NotificationHelper.Core
open BitThicket.NotificationHelper.Providers
let defaultProviderTypes =
[| typeof<GitHub.GitHubNotificationProvider> |]
type Provider = {
getCh : Ch<Providers.INotification seq>
}
let giveLatest ch latest =
Ch.give
let start config logger (providerType:Type) = Job.delay <| fun () ->
let providerImpl = Activator.CreateInstance(providerType) :?> Providers.INotificationProvider
let p = { getCh = Ch() }
let rec server =
let latest = providerImpl.GetLatestNotificationsAsync(None) |> Job.fromAsync
latest >>= Ch.give p.getCh // error here
}
Job.start server
In this case, the compiler complains: Expecting a type supporting the operator '>>=' but given a function type. You may be missing an argument to a function.
Similarly, if I use a slightly different syntax:
// ...
let rec server =
let latest = providerImpl.GetLatestNotificationsAsync(None) |> Job.fromAsync
latest >>= fun l -> Ch.give p.getCh l // error here
// ...
In this case, the error is: This function takes too many arguments, or is used in a context where a function is not expected.
I asked haf about his in slack, and his suggestion was to check for alternative definitions of >>=. The tooling doesn't really do much to help me figure that one out, but the only namespace/module I have opened that defines >>= is Hopac (the BitThicket ones are just trivially simple namespaces with some type definitions in them).
What am I doing wrong here?
I'm looking at the source code, and I see that the bind operator is actually defined in Hopac.Infixes, not in Hopac.
I've started learning F# and Suave and I'm reading the book F# Applied.
One thing I'm struggling with is the warbler function. I know its something to do with deferring execution but I don't really understand why and when its needed.
Apparently we could also use the request function as an alternative to warbler.
Can anyone provide any more detail on why and when these functions are used.
The other answer already explained the warbler function and its relation to context and request functions. I'd like to show when do you want to use these.
When you start a Suave server, you need to provide it with the request processing pipeline of WebParts - routing, HTTP methods and the response-generating functions. This means that by the time you start the web server all the parameters provided to the partially applied WebPart functions have already been evaluated.
Imagine a minimalistic web app that prints the current server time:
let app = GET >=> path "/" >=> OK (string DateTime.Now)
If you start a web server using this app pipeline, you'll always see the same timestamp generated when the app value was created, no matter when you make the web requests retrieving it.
The warbler function and its specialized versions context and request not only defer the execution, but also enable the web server to call the provided function every time it needs its result.
In the example scenario this app will provide expected results:
let app = GET >=> path "/" >=> warbler (fun ctx -> OK (string DateTime.Now))
#adzdavies' comment shows an alternative approach where you don't necessarily need warbler. In the example you can also defer the parameter evaluation if you use anonymous function syntax instead of partially applying OK.
let app = GET >=> path "/" >=> (fun ctx -> OK (string DateTime.Now) ctx)
These three functions are related in the sense that request and context are specialized versions of warbler. They all do the same thing - they inspect (some aspect of) their argument and give you back a function to apply to that argument.
Remember that the basic "building block" of Suave, WebPart, is a function HttpContext -> Async<HttpContext option> rather than some concrete object. What this effectively means is that those three functions allow you to inspect this HttpContext and based on that compose a WebPart to use.
At its core, what warbler does is very simple:
let warbler f a = f a a
// ('t -> 't -> 'u) -> 't -> 'u
You give it a function f and argument a. Function f looks at a and gives you back a new function 't -> 'u which is then applied to a.
The thing about warbler is that it's entirely generic - you can use it anywhere you'd use context or request as long as the types align, but it doesn't know anything about the domain Suave is interested in.
That's why there are the specialized versions of it that "speak the domain language":
let request apply (a : HttpContext) = apply a.request a
// (HttpRequest -> HttpContext -> 'a) -> HttpContext -> 'a
let context apply (a : HttpContext) = apply a a
// (HttpContext -> HttpContext -> 'a) -> HttpContext -> 'a
Notice that they have the same "shape" as warbler - the only difference being that the HttpContext type is "hardcoded" - making it more convenient to use.
I found the prior explanation confusing (to me). This is my attempt at clarity...
warbler resolves a problem with optimized impure eager evaluated functional languages in which partially applied arguments are evaluated early and cached. This caching presents a problem when those applied arguments are dependent on side effects and it becomes desirable to have fresh values with each invocation. For example, the following query for the string representation of the current system's time will occur and be cached at the definition of g: string -> string. As such, it will return the same value for each subsequent call to g:
let g = sprintf "%s %s" (string DateTime.Now)
g "a" //"12/09/2020 18:33:32 a"
g "b" //"12/09/2020 18:33:32 b"
However, the warbler concept is unnecessary to resolve this reevaluation issue. It is enough to simply wrap the subject function inside an anonymous function that then fully applies the subject function each time, as follows:
let f = (fun x -> sprintf "%s %s" (string DateTime.Now) x)
f "c" //"12/09/2020 18:53:32 c"
f "d" //"12/09/2020 18:53:34 d"
What warbler is doing instead is using the above anonymous function as a function factory that produces the subject function when invoked. Then invoking that subject function with its second argument. It is incidental that warbler uses its second argument to invoke the factory function but it does present a point of misdirection. Conceivably, passing the argument to the factory can allow the factory to configure the subject function function or select alternative type compatible functions to return to the warbler. Still, that is not what the warbler is intended for.
let warbler f x = (f x) x
It should be noted that for reevaluation to work, f, must be an anonymous function at the point of call. Consequently, there seems to be no longer any utility for the warbler concept and the cool name should probably be deprecated and allowed to resurface for some other useful concept.
Incidentally, my encounter with warbler is with Giraffe.
Is it best (I'm aware of that there's no silver bullet, but there may be some advantage by using one over the other) - to log in the calling function, or the function calling it?
Examples:
Approach 1
module MongoDb =
let tryGetServer connectionString =
try
let server = new MongoClient(connectionString).GetServer()
server.Ping()
Some server
with _ -> None
Usage:
match MongoDb.tryGetServer Config.connectionString with
| None ->
logger.Information "Unable to connect to the database server."
// ... code ...
| Some srv ->
logger.Information "Successfully connected to the database server."
// ... code ...
Approach 2
module MongoDb =
let tryGetServer connectionString =
try
let server = new MongoClient(connectionString).GetServer()
server.Ping()
Some server
with _ -> None
let tryGetServerLogable connectionString logger =
match tryGetServer connectionString with
| None ->
logger.Information "Unable to connect to the database server."
None
| Some srv ->
logger.Information "Successfully connected to the database server."
Some srv
Usage:
match MongoDb.tryGetServerLogable Config.connectionString logger with
| None ->
// ... code ...
| Some srv ->
// ... code ...
Approach 2 is better. In general, logging is a Cross-Cutting Concern, so it's best decoupled from implementation details. Cross-Cutting Concerns are best addressed via Composition; in OOD, this can be done with Decorators or Interceptors. In FP, we can sometimes learn from OOD, because many of the principles translate from objects to closures.
However, instead of using Approach 2 above verbatim, I'd rather prefer something like this:
module MongoDb =
let tryGetServer connectionString =
try
let server = MongoClient(connectionString).GetServer()
server.Ping()
Some server
with _ -> None
Notice that the MongoDb module has no knowledge of logging. This follows the Single Responsibility Principle, which is also valuable in Functional Programming.
The tryGetServer function has this signature:
string -> MongoServer option
Now you can define a logging function, totally decoupled from the MongoDb module:
module XyzLog =
type Logger() =
member this.Information message = ()
let tryGetServer f (logger : Logger) connectionString =
match f connectionString with
| None ->
logger.Information "Unable to connect to the database server."
None
| Some srv ->
logger.Information "Successfully connected to the database server."
Some srv
Here, you can imagine that XyzLog is a placeholder for a particular logging module, utilising Serilog, Log4Net, NLog, your own custom logging framework, or similar...
The f argument is a function with the generic signature 'a -> 'b option, of which MongoDb.tryGetServer is a specialization.
This means that you can now define a partially applied function like this:
let tgs = XyzLog.tryGetServer MongoDb.tryGetServer (XyzLog.Logger())
The function tgs also has the signature
string -> MongoServer option
So any client that depends on a function with this signature can use MongoDb.tryGetServer or tgs interchangeably, without knowing the difference.
This enables you to change you mind or refactor both MongoDb.tryGetServer and your logging infrastructure independently of each other.
There is a more general way to implement cross-cutting concerns such as logging with a functional language. The example I have is from an async service library (think ASP.NET MVC and ActionFilters) but the same applies here as well. As stated by Mark, the function tryGetServer is of type string -> MongoServer option. Suppose we abstract it to:
type Service<'a, 'b> = 'a -> 'b option
Then suppose we also have a type as follows:
type Filter<'a, 'b> = 'a -> Service<'a, 'b> -> 'b option
A filter is a function which takes a value 'a and a Service<'a, 'b> and then returns a value of the same type as the Service<'a, 'b> function. The simplest filter is a function which simply passes the 'a it receives directly to the service and returns the value it gets from the service. A more interesting filter would be a function which prints a log message after receiving output from the service.
let loggingFilter (connStr:string) (tryGetServer:string -> MongoServer option) : Filter<string, MongoServer option> =
let server = tryGetServer connStr
match tryGetServer connStr with
| Some _ ->
logger.Information "Successfully connected to the database server."
server
| None ->
logger.Information "Unable to connect to the database server."
server
Then if you have the following defined:
type Continuation<'a,'r> = ('a -> 'r) -> 'r
module Continuation =
let bind (m:Continuation<'a, 'r>) k c = m (fun a -> k a c)
module Filter =
/// Composes two filters into one which calls the first one, then the second one.
let andThen (f2:Filter<_,,_>) (f1:Filter<_,_>) : Filter<_,_> = fun input -> Continuation.bind (f1 input) f2
/// Applies a filter to a service returning a filtered service.
let apply (service:Service<_,_>) (filter:Filter<_,_>) : Service<_,_> = fun input -> filter input service
/// The identity filter which passes the input directly to the service and propagates the output.
let identity : Filter<_,_> = fun (input:'Input) (service:Service<_,_>) -> service input
You can apply a filter to a service and get back the original service type but which now does logging:
let tryGetServerLogable = Filter.apply tryGetServer loggingFilter
Why bother? Well, now you can compose filters together. For example you may add a filter which measures the time it takes to create a connection and you can then combine them using Filter.andThen. The gist I originally made is here.
Another approach to consider is the use of a writer monad. With the writer monad, you can defer the actual printing of log messages until some well defined point, but still have similar composition characteristics.