Using user from OWIN context in Nancy - f#

I've got a Nancy project that is hosted with OWIN. Currently it has its own was of authenticating users. The plan is to change it and make my project compatible with an external authentication model - i.e. SAML-based; I've got a local Identity Provider and managed to handle communication between my service and the IdP. I achieved this by using the Kentor.AuthServices library (https://github.com/KentorIT/authservices)
let CreateSPOptions() : SPOptions =
let spOptions = new SPOptions()
spOptions.EntityId <- new EntityId("<my_service_ID>")
spOptions.ReturnUrl <- new Uri("http://localhost:5012/login")
spOptions.MinIncomingSigningAlgorithm <- "http://www.w3.org/2000/09/xmldsig#rsa-sha1"
spOptions
let ConfigureAuthOptions() : KentorAuthServicesAuthenticationOptions =
let spOptions = CreateSPOptions()
let authServicesOptions = new KentorAuthServicesAuthenticationOptions(false)
authServicesOptions.SPOptions <- spOptions
let idp = new IdentityProvider(new EntityId("<my_IdP_ID>"), spOptions)
idp.AllowUnsolicitedAuthnResponse <- true
idp.Binding <- Saml2BindingType.HttpRedirect
idp.MetadataLocation <- #"Metadata\provider.xml"
authServicesOptions.IdentityProviders.Add(idp);
authServicesOptions
let Configure (app : IAppBuilder) =
let cookieOptions = new CookieAuthenticationOptions()
cookieOptions.LoginPath <- new PathString("/Login")
cookieOptions.LogoutPath <- new PathString("/Logout")
cookieOptions.AuthenticationType <- "KentorAuthServices"
cookieOptions.AuthenticationMode <- AuthenticationMode.Active
cookieOptions.Provider <- new CookieAuthenticationProvider()
app.UseCookieAuthentication(cookieOptions) |> ignore
app.SetDefaultSignInAsAuthenticationType("KentorAuthServices")
app.UseKentorAuthServicesAuthentication(ConfigureAuthOptions()) |> ignore
app
However, as a result the user information is now stored in Owin Context, so I can't rely on this.Context.CurrentUser (where this refers to a current Nancy Module) and I can't secure my modules using:
type SecuredModule() as this =
inherit NancyModule()
do
this.RequiresAuthentication()
this.Get.["/"] <- ....
I know there's functionality provided in Nancy.MSOwinSecurity package that allows me to refer to OwinContext e.g.
type SecuredModule() as this =
inherit NancyModule()
do
this.RequiresMSOwinAuthentication()
this.Get.["/"] <- ...
But the thing is there are many tests associated with the project that assume the user info is stored in Nancy context. Vast majority of the tests is based on the mock object:
let createBrowser rootFolder =
let docStore = DocumentStore(rootFolder)
let config (w:ConfigurableBootstrapper.ConfigurableBootstrapperConfigurator) =
w.Module(new UnsecuredModule(docStore))
.Module(new SecuredModule(docStore))
.RequestStartup(fun _ _ (context: NancyContext) ->
context.CurrentUser <- new UserIdentity("MyServiceUnitTests", Seq.empty))
|> ignore
I've tried the same when handling a response from my IdP and manually overrode context.CurrentUser, but the information was lost after a redirection:
type LoginModule(userDatabase: UserDatabase) as this =
inherit NancyModule()
do
this.Get.["/login"] <-
fun _ ->
match this.Context.GetMSOwinUser() with
| null ->
let authenticationManager = this.Context.GetAuthenticationManager();
let properties = new AuthenticationProperties()
properties.RedirectUri <- "/Web.Documents/login"
authenticationManager.Challenge(properties, "KentorAuthServices")
HttpStatusCode.Unauthorized |> box
| user ->
let userName = user.Identity.Name
let ipAddress = this.Context.Request.UserHostAddress
Log.Info "{#user} {#ipaddress} logged in" [
"user" => userName
"ipaddress" => ipAddress
]
this.Context.CurrentUser <- new UserIdentity("MyServiceUnitTests", Seq.empty)
this.Context.GetRedirect("~/") |> box
Obviously, I don't want to make too many changes to my service. Ideally I'd like it to move somehow the user information to Nancy Context - then I'd be happy to go, as I don't need to adjust the ~50 tests as well. What's the best solution here ?

Related

F# SAFE how to deal with growth of message DU variants?

In F# SAFE stack there is a DU type, which defines all types of messages flowing between server and client. In sample application there are <10 of them, I looked on provided examples - all of them have not many possible types. But what if the application is not small - there will be hundreds of types in DU; which will become hard to maintain. So I decided to divide this type in sub-types and put logic in corresponding files.
Here is my simplified type:
type Msg2 =
| LoginMsg of LoginState
| RegisterMsg of RegisterState
| ViewUpdateMsg of ViewUpdateState
Login state is defined in another file:
type LoginState =
| Login
| LogInResult of LoginResult
Login module works with logins:
let workWithLogin (model: Model) (msg: LoginState) (todosApi: ITodosApi) : Model * Cmd<LoginState> =
match msg with
| LoginState.Login ->
let result =
Cmd.OfAsync.perform todosApi.login model.InputData LoginState.LogInResult
model, result
| LoginState.LogInResult data ->
{ model with
LoginState = getVal data.Message
Token = data.Token },
Cmd.none
Note that it returns Model * Cmd<LoginState>.
Now I need to fix my update function:
let update2 (msg: Msg2) (model: Model) : Model * Cmd<Msg2> =
match msg with
| LoginMsg n ->
let ret = workWithLogin model n todosApi
model, snd ret
| RegisterMsg n -> ...
| ViewUpdateMsg n -> ...
The problem here is that I get Cmd<LoginState> from login module and need to convert it to Cmd<Msg2> somehow.
So I either need to create new Msg2 type or convert DU variant LoginMsg of LoginState to Msg2. I dont understand how to get LogInResult data from Cmd<LoginState>.
How can I fix this? How the problem with many message types is solved in big projects?
What you've done with wrapping in "sub"-messages is the right way to go, and you should probably do the same thing with the model - i.e. let Login have it's own model. To convert between different Cmd<'msg> there is a Cmd.map. In your case you can:
let update2 (msg: Msg2) (model: Model) : Model * Cmd<Msg2> =
match msg with
| LoginMsg n ->
let (loginModel, loginCmd) = workWithLogin model n todosApi
{ model with Login = loginModel }, Cmd.map LoginMsg loginCmd
You can see some API description of Cmd here: https://elmish.github.io/elmish/cmd.html

F# .NET Core 2.1 simple crud app: controllers don't get registered

I am trying to use F# with .NET Core 2.1 to create a simple CRUD application but none of the controllers don't get registered. I see none of the controllers in Swagger and the controller themselves don't start.
I appreciate any help or hint.
Startup.fs
namespace SimpleCms
type Startup private () =
let mutable configuration : IConfigurationRoot = null
member this.Configuration
with get () = configuration
and private set (value) = configuration <- value
new(env : IHostingEnvironment) as this =
Startup()
then
let builder =
ConfigurationBuilder()
.SetBasePath(env.ContentRootPath)
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
.AddJsonFile(sprintf "appsettings.%s.json" env.EnvironmentName, optional = true)
.AddEnvironmentVariables()
this.Configuration <- builder.Build()
// This method gets called by the runtime. Use this method to add services to the container.
member this.ConfigureServices(services : IServiceCollection) =
services.AddLogging() |> ignore
services.AddSwaggerGen(fun x ->
x.SwaggerDoc("v1", new Info(Title = "SimpleCms", Version = "v1")) |> ignore)
|> ignore
services.AddMvcCore() |> ignore
services.AddMvc() |> ignore
let container =
new Container(fun opt ->
opt.Scan(fun x ->
x.AssemblyContainingType(typeof<Startup>)
x.Assembly("Dal")
x.Assembly("Logic")
x.WithDefaultConventions() |> ignore)
opt.For<LiteDatabase>().Use(new LiteDatabase("Filename=database.db")) |> ignore
opt.Populate(services) |> ignore)
container.GetInstance<IServiceProvider>()
// This method gets called by the runtime. Use this method to configure the HTTP request pipeline.
member this.Configure(app : IApplicationBuilder, env : IHostingEnvironment) =
app.UseSwagger() |> ignore
app.UseSwaggerUI(fun x ->
x.SwaggerEndpoint("/swagger/v1/swagger.json", "My API V1") |> ignore) |> ignore
app.UseMvc(fun x ->
x.MapRoute("default", "{controller=Home}/{action=Index}") |> ignore) |> ignore
HomeController.fs
namespace SimpleCms.Controllers
open Microsoft.AspNetCore.Mvc
[<Route("")>]
type HomeController() =
inherit Controller()
[<Route("")>]
[<HttpGet>]
member this.Index() =
Ok("Hello World!")
The complete code
Repo URL
Your problem is the IPostController interface. Remove that and Swagger will pick up the PostController.
For example:
[<Route("api/[controller]")>]
[<ApiController>]
type PostController(logic : IPostLogic) =
inherit Controller()
member this.logic = logic
[<Route("")>]
[<HttpGet>]
member this.GetAll() =
this.logic.GetAll()
//etc
Which makes Swagger show this:
Side Note: For ASP.NET Core 2.1 and above, you shouldn't be specifying the version of the Microsoft.AspNetCore.All package, your fsproj file should contain this instead:
<PackageReference Include="Microsoft.AspNetCore.All" />
Which in turn means you should be using version 2.1.1 of Microsoft.Extensions.Logging.Debug.
Finally, you are using a really old version of Swashbuckle.AspNetCore. I suggest you upgrade that too.

Populate list with Types

Im trying to populate list with my own type.
let getUsers =
use connection = openConnection()
let getString = "select * from Accounts"
use sqlCommand = new SqlCommand(getString, connection)
try
let usersList = [||]
use reader = sqlCommand.ExecuteReader()
while reader.Read() do
let floresID = reader.GetString 0
let exName = reader.GetString 1
let exPass = reader.GetString 2
let user = [floresID=floresID; exName=exName; exPass=exPass]
// what here?
()
with
| :? SqlException as e -> printfn "Došlo k chybě úrovni připojení:\n %s" e.Message
| _ -> printfn "Neznámá výjimka."
In C# I would just add new object into userList. How can I add new user into list? Or is it better approach to get some sort of list with data from database?
Easiest way to do this is with a type provider, so you can abstract away the database. You can use SqlDataConnection for SQLServer, SqlProvider for everything (incl. SQLServer), and also SQLClient for SQLServer.
Here is an example with postgres's dvdrental (sample) database for SQLProvider:
#r #"..\packages\SQLProvider.1.0.33\lib\FSharp.Data.SqlProvider.dll"
#r #"..\packages\Npgsql.3.1.8\lib\net451\Npgsql.dll"
open System
open FSharp.Data.Sql
open Npgsql
open NpgsqlTypes
open System.Linq
open System.Xml
open System.IO
open System.Data
let [<Literal>] dbVendor = Common.DatabaseProviderTypes.POSTGRESQL
let [<Literal>] connString1 = #"Server=localhost;Database=dvdrental;User Id=postgres;Password=root"
let [<Literal>] resPath = #"C:\Users\userName\Documents\Visual Studio 2015\Projects\Postgre2\packages\Npgsql.3.1.8\lib\net451"
let [<Literal>] indivAmount = 1000
let [<Literal>] useOptTypes = true
//create the type for the database, based on the connection string, etc. parameters
type sql = SqlDataProvider<dbVendor,connString1,"",resPath,indivAmount,useOptTypes>
//set up the datacontext, ideally you would use `use` here :-)
let ctx = sql.GetDataContext()
let actorTbl = ctx.Public.Actor //alias the table
//set up the type, in this case Records:
type ActorName = {
firstName:string
lastName:string}
//extract the data with a query expression, this gives you type safety and intellisense over SQL (but also see the SqlClient type provider above):
let qry = query {
for row in actorTbl do
select ({firstName=row.FirstName;lastName=row.LastName})
}
//seq is lazy so do all kinds of transformations if necessary then manifest it into a list or array:
qry |> Seq.toArray
The two important parts are defining the Actor record, and then in the query extracting the fields into a sequence of Actor records. You can then manifest into a list or array if necessary.
But you can also stick to your original solution. In that case just wrap the .Read() into a seq:
First define the type:
type User = {
floresID: string
exName: string
exPass: string
}
Then extract the data:
let recs = cmd.ExecuteReader() // execute the SQL Command
//extract the users into a sequence of records:
let users =
seq {
while recs.Read() do
yield {floresID=recs.[0].ToString()
exName=recs.[1].ToString()
exPass=recs.[2].ToString()
}
} |> Seq.toArray
Taking your code, you can use list expression:
let getUsers =
use connection = openConnection()
let getString = "select * from Accounts"
use sqlCommand = new SqlCommand(getString, connection)
try
[
use reader = sqlCommand.ExecuteReader()
while reader.Read() do
let floresID = reader.GetString 0
let exName = reader.GetString 1
let exPass = reader.GetString 2
let user = [floresID=floresID; exName=exName; exPass=exPass]
yield user
]
with
| :? SqlException as e -> failwithf "Došlo k chybě úrovni připojení:\n %s" e.Message
| _ -> failwithf "Neznámá výjimka."
That being said, I'd use FSharp.Data.SqlClient library so all of that boiler plate becomes a single line with added benefit of type safety (if you change the query, the code will have compile time error which are obvious to fix).

Writing a service in F#

I am back again, this time with a question on writing service in F#. I cannot seem to install the service using installutil. It gives me the following error.
$ installutil atfwindowsservice.exe
Microsoft (R) .NET Framework Installation utility Version 4.0.30319.18408
Copyright (C) Microsoft Corporation. All rights reserved.
Running a transacted installation.
Beginning the Install phase of the installation.
See the contents of the log file for the C:\Dev\ATF\output\bin\Debug\atfwindowsservice.exe assembly's progress.
The file is located at C:\Dev\ATF\output\bin\Debug\atfwindowsservice.InstallLog.
Installing assembly 'C:\Dev\ATF\output\bin\Debug\atfwindowsservice.exe'.
Affected parameters are:
logtoconsole =
logfile = C:\Dev\ATF\output\bin\Debug\atfwindowsservice.InstallLog
assemblypath = C:\Dev\ATF\output\bin\Debug\atfwindowsservice.exe
No public installers with the RunInstallerAttribute.Yes attribute could be found in the C:\Dev\ATF\output\bin\Debug\atfwindowsservice.exe assembly.
The code is given below. Any help is appreciated and thanks in advance.
Ramesh
namespace service
open System.ServiceProcess
open System.Runtime.Remoting
open System.Runtime.Remoting.Channels
type atf() =
inherit ServiceBase(ServiceName = "atf win service")
override x.OnStart(args) = ()
override x.OnStop() = ()
The registering the service code:
// Learn more about F# at http://fsharp.net
// See the 'F# Tutorial' project for more help.=
open System
open System.ComponentModel
open System.Configuration.Install
open System.ServiceProcess
[<RunInstaller(true)>]
type FSharpServiceInstaller() =
inherit Installer()
do
// Specify properties of the hosting process
new ServiceProcessInstaller(Account = ServiceAccount.LocalSystem) |> base.Installers.Add |> ignore
// Specify properties of the service running inside the process
new ServiceInstaller( DisplayName = "F# ATF Service", ServiceName = "atf",StartType = ServiceStartMode.Automatic ) |> base.Installers.Add |> ignore
// Run the chat service when the process starts
module Main =
ServiceBase.Run [| new service.atf() :> ServiceBase |]
I had the same problem. I eventually added the following code which works nicely and has the added benefit of not requiring installutil.exe. The service is able to install/uninstall itself by passing in the correct command line param. Keep all your code and add the following:
module Program =
let getInstaller() =
let installer = new AssemblyInstaller(typedefof<atf>.Assembly, null);
installer.UseNewContext <- true
installer
let installService() =
let installer = getInstaller()
let dic = new System.Collections.Hashtable()
installer.Install(dic)
installer.Commit(dic)
let uninstallService() =
let installer = getInstaller()
let dic = new System.Collections.Hashtable()
installer.Uninstall(dic)
[<EntryPoint>]
let main (args:string[]) =
match (args |> Seq.length) with
|1 -> match (args.[0]) with
|"-install" -> installService()
|"-uninstall" -> uninstallService()
|_-> failwith "Unrecognized param %s" args.[0]
|_ -> ServiceBase.Run [| new atf() :> ServiceBase |]
0
To install you can execute the following from the command line:
atfwindowsservice.exe -install
I figured out how to write a self installing service using other examples on the web, especially this post on stack was useful:
http://pingfu.net/programming/2011/08/11/creating-a-self-installing-windows-service-with-csharp.html
open System
open System.ServiceProcess
open System.Windows
open System.Threading
open System.Windows.Forms
open System.ComponentModel
open System.Configuration.Install
open System.Reflection
open Microsoft.Win32
type ATFServiceInstaller() =
inherit Installer()
let spi_ = new ServiceProcessInstaller(Account = ServiceAccount.LocalSystem)
let si_ = new ServiceInstaller( DisplayName = "ATF Service", Description="ATF service", ServiceName = "atf",StartType = ServiceStartMode.Automatic )
let dic_ = new System.Collections.Hashtable()
let SVC_SERVICE_KET = #"SYSTEM\CurrentControlSet\Services"
member this.install () =
base.Installers.Add(spi_) |> ignore
let ret = base.Installers.Add(si_)
let apath = sprintf "/assemblypath=%s" (Assembly.GetExecutingAssembly().Location)
let ctx = [|apath; "/logToConsole=false"; "/showCallStack"|]
this.Context <- new InstallContext("atfserviceinstall.log", ctx)
base.Install(dic_)
base.Commit(dic_)
member this.uninstall() =
base.Installers.Add(spi_) |> ignore
let ret = base.Installers.Add(si_)
let apath = sprintf "/assemblypath=%s" (Assembly.GetExecutingAssembly().Location)
let ctx = [|apath; "/logToConsole=false"; "/showCallStack"|]
this.Context <- new InstallContext("atfserviceinstall.log", ctx)
base.Uninstall(null)
module Main =
try
let args = Environment.GetCommandLineArgs()
match (args |> Seq.length) with
| 2 -> match (args.[1]) with
| "-install" -> let installer = new ATFServiceInstaller()
installer.install()
installer.Dispose()
| "-uninstall" -> let installer = new ATFServiceInstaller()
installer.uninstall()
installer.Dispose()
| _ -> failwith "Unrecognized param %s" args.[0]
| _ -> ServiceBase.Run [| new atfservice.ATFService() :> ServiceBase |]
with
| _ as ex -> MessageBox.Show(ex.ToString()) |> ignore
I came across this question while having the same issue. I still needed to use InstallUtil.exe in the deployment and find out that the problem with your original code was a missing namespace in the main file.
I have found this framework for hosting .NET services http://topshelf-project.com/ which makes the development much easier and basically lets you create a console application which you can debug and also has a built-in Windows/Mono service installer. The only downside for me was a missing support for installation with InstallUtil.exe again but there is a solution for that too. Instead of adding ServiceProcessInstaller and ServiceInstaller to Installers in the class inherited from Installer override Install and Uninstall methods and make them run your executable with install/unistall parameter.
[<RunInstaller(true)>]
type public FSharpServiceInstaller() =
inherit Installer()
override __.Install(stateSaver : System.Collections.IDictionary) =
let assemblyPath = __.Context.Parameters.["assemblypath"]
stateSaver.Add(assemblyIdentifier, assemblyPath)
// runProcess assemblyPath "install"
base.Install(stateSaver)
override __.Uninstall(savedState : System.Collections.IDictionary) =
let assemblyPath = savedState.[assemblyIdentifier].ToString()
// runProcess assemblyPath "uninstall"
base.Uninstall(savedState)
Full code at: https://gist.github.com/jbezak/eda4cc5864059b717e71beaec47db2d9

Converting string to UTF8Type in FluentCassandra

I am working with FluentCassandra in F# and attempting to convert a string to a UTF8Type in order to use the ExecuteNonQuery method. Has anyone been successful doing this?
Thanks,
Tom
Thank you Jack P. and Daniel for pointing me in the right direction.
To provide more examples so others can benefit, I am writing a wrapper on top of FluentCassandra in F# to make CRUD functionality much simpler by utilizing the succinctness of F#. I am using Nick Berardi's code as an example for this wrapper:
https://github.com/fluentcassandra/fluentcassandra/blob/master/test/FluentCassandra.Sandbox/Program.cs
For example, if you want to check if a keyspace exists, simply calling the KeySpaceExists(keyspaceName) would allow for checking if a keyspace exists, using CreateKeyspace(keyspaceName) would allow for creation of a keyspace, etc. An example of the library I am creating is here:
namespace Test
open System
open System.Collections.Generic
open System.Configuration
open System.Linq
open System.Text
open System.Windows
open FluentCassandra
open FluentCassandra.Connections
open FluentCassandra.Types
open FluentCassandra.Linq
module Cassandra =
let GetAppSettings (key : string) = ConfigurationManager.AppSettings.Item(key)
let KeyspaceExists keyspaceName =
let server = new Server(GetAppSettings("Server"))
let db = new CassandraContext(keyspaceName, server)
let keyspaceNameExists = db.KeyspaceExists(keyspaceName)
db.Dispose()
keyspaceNameExists
let CreateKeyspace keyspaceName =
let server = new Server(GetAppSettings("Server"))
let db = new CassandraContext(keyspaceName, server)
let schema = new CassandraKeyspaceSchema(Name=keyspaceName)
let keyspace = new CassandraKeyspace(schema,db)
if KeyspaceExists(keyspaceName)=false then keyspace.TryCreateSelf()
db.Dispose()
let DropKeyspace (keyspaceName : string ) =
let server = new Server(GetAppSettings("Server"))
let db = new CassandraContext(keyspaceName, server)
match db.KeyspaceExists(keyspaceName)=true with
// value has "ignore" to ignore the string returned from FluentCassandra
| true -> db.DropKeyspace(keyspaceName) |> ignore
| _ -> ()
db.Dispose()
let ColumnFamilyExists (keyspaceName, columnFamilyName : string) =
let server = new Server(GetAppSettings("Server"))
let db = new CassandraContext(keyspaceName, server)
let schema = new CassandraKeyspaceSchema(Name=keyspaceName)
let keyspace = new CassandraKeyspace(schema,db)
let columnFamilyNameExists = db.ColumnFamilyExists(columnFamilyName)
db.Dispose()
columnFamilyNameExists
let CreateColumnFamily (keyspaceName, columnFamilyName: string) =
if ColumnFamilyExists(keyspaceName,columnFamilyName)=false then
let server = new Server(GetAppSettings("Server"))
let db = new CassandraContext(keyspaceName, server)
let schema = new CassandraKeyspaceSchema(Name=keyspaceName)
let keyspace = new CassandraKeyspace(schema,db)
if ColumnFamilyExists(keyspaceName,columnFamilyName)=false then
keyspace.TryCreateColumnFamily(new CassandraColumnFamilySchema(FamilyName = columnFamilyName, KeyValueType = CassandraType.AsciiType, ColumnNameType = CassandraType.IntegerType, DefaultColumnValueType = CassandraType.UTF8Type))
let ExecuteNonQuery(keyspaceName, query: string) =
let server = new Server(GetAppSettings("Server"))
let db = new CassandraContext(keyspaceName, server)
let schema = new CassandraKeyspaceSchema(Name=keyspaceName)
let keyspace = new CassandraKeyspace(schema,db)
let queryUTF8 = FluentCassandra.Types.UTF8Type.op_Implicit query
try
db.ExecuteNonQuery(queryUTF8)
true
with
| _ -> false
This library allows for very easy one line commands to utilize the FluentCassandra functionality. Of course this is just the start and I plan on amending the above library further.
open System
open System.Linq
open System.Collections.Generic
open System.Configuration
open FluentCassandra.Connections
open FluentCassandra.Types
open FluentCassandra.Linq
open Test.Cassandra
[<EntryPoint>]
let main argv =
CreateKeyspace("test1")
printfn "%s" (ColumnFamilyExists("test1", "table1").ToString())
printfn "%s" (KeyspaceExists("test1").ToString())
CreateColumnFamily("test1","table1")
printfn "%s" (ColumnFamilyExists("test1", "table1").ToString())
let result = ExecuteNonQuery("test1", "CREATE TABLE table2 (id bigint primary key, name varchar)")
printfn "%s" (result.ToString())
let wait = System.Console.ReadLine()
0
Specifically with converting the query string to a UTF8Type, Daniel's approach of utilizing UTF8Type.op_Implicit str worked. You can see how I applied it in the ExecuteNonQuery function above. Thanks again for your help!

Resources