Create a gist now

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Examples of capability based design. Related blog post: http://fsharpforfunandprofit.com/posts/capability-based-security/
(*
CapabilityBasedSecurity_ConfigExample.fsx
An example of a simple capability-based design.
Related blog post: http://fsharpforfunandprofit.com/posts/capability-based-security/
*)
/// Configuration system
module Config =
type MessageFlag = ShowThisMessageAgain | DontShowThisMessageAgain
type ConnectionString = ConnectionString of string
type Color = System.Drawing.Color
type ConfigurationCapabilities = {
GetMessageFlag : unit -> MessageFlag
SetMessageFlag : MessageFlag -> unit
GetBackgroundColor : unit -> Color
SetBackgroundColor : Color -> unit
GetConnectionString : unit -> ConnectionString
SetConnectionString : ConnectionString -> unit
}
// a private store for demo purposes
module private ConfigStore =
let mutable MessageFlag = ShowThisMessageAgain
let mutable BackgroundColor = Color.White
let mutable ConnectionString = ConnectionString ""
// public capabilities
let configurationCapabilities = {
GetMessageFlag = fun () -> ConfigStore.MessageFlag
SetMessageFlag = fun flag -> ConfigStore.MessageFlag <- flag
GetBackgroundColor = fun () -> ConfigStore.BackgroundColor
SetBackgroundColor = fun color -> ConfigStore.BackgroundColor <- color
GetConnectionString = fun () -> ConfigStore.ConnectionString
SetConnectionString = fun connStr -> ConfigStore.ConnectionString <- connStr
}
/// Logic for constructing an annoying popup message dialog everytime you click the main form
module AnnoyingPopupMessage =
open System.Windows.Forms
let createLabel() =
new Label(Text="You clicked the main window", Dock=DockStyle.Top)
let createMessageFlagCheckBox capabilities =
let getFlag,setFlag = capabilities
let ctrl= new CheckBox(Text="Don't show this annoying message again", Dock=DockStyle.Bottom)
ctrl.Checked <- getFlag()
ctrl.CheckedChanged.Add (fun _ -> ctrl.Checked |> setFlag)
ctrl // return new control
let createOkButton (dialog:Form) =
let ctrl= new Button(Text="OK",Dock=DockStyle.Bottom)
ctrl.Click.Add (fun _ -> dialog.Close())
ctrl
let createForm capabilities =
let form = new Form(Text="Annoying Popup Message", Width=300, Height=150)
form.FormBorderStyle <- FormBorderStyle.FixedDialog
form.StartPosition <- FormStartPosition.CenterParent
let label = createLabel()
let messageFlag = createMessageFlagCheckBox capabilities
let okButton = createOkButton form
form.Controls.Add label
form.Controls.Add messageFlag
form.Controls.Add okButton
form
module UserInterface =
open System.Windows.Forms
open System.Drawing
let showPopupMessage capabilities owner =
let getFlag,setFlag = capabilities
let popupMessage = AnnoyingPopupMessage.createForm (getFlag,setFlag)
popupMessage.Owner <- owner
popupMessage.ShowDialog() |> ignore // don't care about result
let showColorDialog capabilities owner =
let getColor,setColor = capabilities
let dlg = new ColorDialog(Color=getColor())
let result = dlg.ShowDialog(owner)
if result = DialogResult.OK then
dlg.Color |> setColor
let createClickMeLabel capabilities owner =
let getFlag,_ = capabilities
let ctrl= new Label(Text="Click me", Dock=DockStyle.Fill, TextAlign=ContentAlignment.MiddleCenter)
ctrl.Click.Add (fun _ ->
if getFlag() then showPopupMessage capabilities owner)
ctrl // return new control
let createChangeBackColorButton capabilities owner =
let ctrl= new Button(Text="Change background color", Dock=DockStyle.Bottom)
ctrl.Click.Add (fun _ -> showColorDialog capabilities owner)
ctrl
let createResetMessageFlagButton capabilities =
let setFlag = capabilities
let ctrl= new Button(Text="Show popup message again", Dock=DockStyle.Bottom)
ctrl.Click.Add (fun _ -> setFlag Config.ShowThisMessageAgain)
ctrl
let createMainForm capabilities =
// get the individual component capabilities from the parameter
let getFlag,setFlag,getColor,setColor = capabilities
let form = new Form(Text="Capability example", Width=500, Height=300)
form.BackColor <- getColor() // update the form from the config
// transform color capability to change form as well
let newSetColor color =
setColor color // change config
form.BackColor <- color // change form as well
// transform flag capabilities from domain type to bool
let getBoolFlag() =
getFlag() = Config.ShowThisMessageAgain
let setBoolFlag bool =
if bool
then setFlag Config.ShowThisMessageAgain
else setFlag Config.DontShowThisMessageAgain
// set up capabilities for child objects
let colorDialogCapabilities = getColor,newSetColor
let popupMessageCapabilities = getBoolFlag,setBoolFlag
// setup controls with their different capabilities
let clickMeLabel = createClickMeLabel popupMessageCapabilities form
let changeColorButton = createChangeBackColorButton colorDialogCapabilities form
let resetFlagButton = createResetMessageFlagButton setFlag
// add controls
form.Controls.Add clickMeLabel
form.Controls.Add changeColorButton
form.Controls.Add resetFlagButton
form // return form
module Startup =
// set up capabilities
let configCapabilities = Config.configurationCapabilities
let formCapabilities =
configCapabilities.GetMessageFlag,
configCapabilities.SetMessageFlag,
configCapabilities.GetBackgroundColor,
configCapabilities.SetBackgroundColor
// start
let form = UserInterface.createMainForm formCapabilities
form.ShowDialog() |> ignore
// open another form and the config is remembered
//form.ShowDialog() |> ignore
(*
CapabilityBasedSecurity_ConsoleExample.fsx
An example of a capability-based console application that also includes authorization.
Related blog post: http://fsharpforfunandprofit.com/posts/capability-based-security-2/
*)
open System.Security.Principal
open System
// ================================================
// A complete console application demonstrating capabilities
// ================================================
module Rop =
type SuccessFailure<'a,'b> =
| Success of 'a
| Failure of 'b
let bind f = function
| Success x -> f x
| Failure e -> Failure e
let map f = function
| Success x -> Success (f x)
| Failure e -> Failure e
let orElse errValue = function
| Success x -> x
| Failure _ -> errValue
/// Core domain types shares across the application
module Domain =
open Rop
type CustomerId = CustomerId of int
type CustomerData = CustomerData of string
type Password = Password of string
type FailureCase =
| AuthenticationFailed of string
| AuthorizationFailed
| CustomerNameNotFound of string
| CustomerIdNotFound of CustomerId
| OnlyAllowedOnce
| CapabilityRevoked
// ----------------------------------------------
/// Capabilities that are available in the application
module Capabilities =
open Rop
open Domain
// capabilities
type GetCustomerCap = unit -> SuccessFailure<CustomerData,FailureCase>
type UpdateCustomerCap = unit -> CustomerData -> SuccessFailure<unit,FailureCase>
type UpdatePasswordCap = Password -> SuccessFailure<unit,FailureCase>
type CapabilityProvider = {
/// given a customerId and IPrincipal, attempt to get the GetCustomer capability
getCustomer : CustomerId -> IPrincipal -> GetCustomerCap option
/// given a customerId and IPrincipal, attempt to get the UpdateCustomer capability
updateCustomer : CustomerId -> IPrincipal -> UpdateCustomerCap option
/// given a customerId and IPrincipal, attempt to get the UpdatePassword capability
updatePassword : CustomerId -> IPrincipal -> UpdatePasswordCap option
}
// ----------------------------------------------
/// Functions related to authentication
module Authentication =
open Rop
open Domain
let customerRole = "Customer"
let customerAgentRole = "CustomerAgent"
let makePrincipal name role =
let iden = GenericIdentity(name)
let principal = GenericPrincipal(iden,[|role|])
principal :> IPrincipal
let authenticate name =
match name with
| "Alice" | "Bob" ->
makePrincipal name customerRole |> Success
| "Zelda" ->
makePrincipal name customerAgentRole |> Success
| _ ->
AuthenticationFailed name |> Failure
let customerIdForName name =
match name with
| "Alice" -> CustomerId 1 |> Success
| "Bob" -> CustomerId 2 |> Success
| _ -> CustomerNameNotFound name |> Failure
let customerIdOwnedByPrincipal customerId (principle:IPrincipal) =
principle.Identity.Name
|> customerIdForName
|> Rop.map (fun principalId -> principalId = customerId)
|> Rop.orElse false
// ----------------------------------------------
/// Functions related to authorization
module Authorization =
open Rop
open Domain
let onlyForSameId (id:CustomerId) (principal:IPrincipal) (f:CustomerId -> 'a) =
if Authentication.customerIdOwnedByPrincipal id principal then
Some (fun () -> f id)
else
None
let onlyForAgents (id:CustomerId) (principal:IPrincipal) (f:CustomerId -> 'a) =
if principal.IsInRole(Authentication.customerAgentRole) then
Some (fun () -> f id)
else
None
let onlyIfDuringBusinessHours (time:DateTime) f =
if time.Hour >= 8 && time.Hour <= 17 then
Some f
else
None
// constrain who can call a password update function
let passwordUpdate (id:CustomerId) (principal:IPrincipal) (f:CustomerId*Password -> 'a) =
if Authentication.customerIdOwnedByPrincipal id principal then
Some (fun password -> f (id,password))
else
None
// return the first good capability, if any
let first capabilityList =
capabilityList |> List.tryPick id
// given a capability option, restrict it
let restrict filter originalCap =
originalCap
|> Option.bind filter
/// Uses of the capability will be audited
let auditable capabilityName principalName f =
fun x ->
// simple audit log!
let timestamp = DateTime.UtcNow.ToString("u")
printfn "AUDIT: User %s used capability %s at %s" principalName capabilityName timestamp
// use the capability
f x
/// Return a pair of functions: the revokable capability,
/// and the revoker function
let revokable f =
let allow = ref true
let capability = fun x ->
if !allow then //! is dereferencing not negation!
f x
else
Failure CapabilityRevoked
let revoker() =
allow := false
capability, revoker
// ----------------------------------------------
/// Functions related to database access
module CustomerDatabase =
open Rop
open System.Collections.Generic
open Domain
let private db = Dictionary<CustomerId,CustomerData>()
let getCustomer id =
match db.TryGetValue id with
| true, value -> Success value
| false, _ -> Failure (CustomerIdNotFound id)
let updateCustomer id data =
db.[id] <- data
Success ()
let updatePassword (id:CustomerId,password:Password) =
Success () // dummy implementation
// ----------------------------------------------
module BusinessServices =
open Rop
open Domain
// use the getCustomer capability
let getCustomer capability =
match capability() with
| Success data -> printfn "%A" data
| Failure err -> printfn ".. %A" err
// use the updateCustomer capability
let updateCustomer capability =
printfn "Enter new data: "
let customerData = Console.ReadLine() |> CustomerData
match capability () customerData with
| Success _ -> printfn "Data updated"
| Failure err -> printfn ".. %A" err
// use the updatePassword capability
let updatePassword capability =
printfn "Enter new password: "
let password = Console.ReadLine() |> Password
match capability password with
| Success _ -> printfn "Password updated"
| Failure err -> printfn ".. %A" err
// ----------------------------------------------
module UserInterface =
open Rop
open Domain
open Capabilities
type CurrentState =
| LoggedOut
| LoggedIn of IPrincipal
| CustomerSelected of IPrincipal * CustomerId
| Exit
/// do the actions available while you are logged out. Return the new state
let loggedOutActions originalState =
printfn "[Login] enter Alice, Bob, Zelda, or Exit: "
let action = Console.ReadLine()
match action with
| "Exit" ->
// Change state to Exit
Exit
| name ->
// otherwise try to authenticate the name
match Authentication.authenticate name with
| Success principal ->
LoggedIn principal
| Failure err ->
printfn ".. %A" err
originalState
/// do the actions available while you are logged in. Return the new state
let loggedInActions originalState (principal:IPrincipal) =
printfn "[%s] Pick a customer to work on. Enter Alice, Bob, or Logout: " principal.Identity.Name
let action = Console.ReadLine()
match action with
| "Logout" ->
// Change state to LoggedOut
LoggedOut
// otherwise treat it as a customer name
| customerName ->
// Attempt to find customer
match Authentication.customerIdForName customerName with
| Success customerId ->
// found -- change state
CustomerSelected (principal,customerId)
| Failure err ->
// not found -- stay in originalState
printfn ".. %A" err
originalState
let getAvailableCapabilities capabilityProvider customerId principal =
let getCustomer = capabilityProvider.getCustomer customerId principal
let updateCustomer = capabilityProvider.updateCustomer customerId principal
let updatePassword = capabilityProvider.updatePassword customerId principal
getCustomer,updateCustomer,updatePassword
/// do the actions available when a selected customer is available. Return the new state
let selectedCustomerActions originalState capabilityProvider customerId principal =
// get the individual component capabilities from the provider
let getCustomerCap,updateCustomerCap,updatePasswordCap =
getAvailableCapabilities capabilityProvider customerId principal
// get the text for menu options based on capabilities that are present
let menuOptionTexts =
[
getCustomerCap |> Option.map (fun _ -> "(G)et");
updateCustomerCap |> Option.map (fun _ -> "(U)pdate");
updatePasswordCap |> Option.map (fun _ -> "(P)assword");
]
|> List.choose id
// show the menu
let actionText =
match menuOptionTexts with
| [] -> " (no other actions available)"
| texts -> texts |> List.reduce (fun s t -> s + ", " + t)
printfn "[%s] (D)eselect customer, %s" principal.Identity.Name actionText
// process the user action
let action = Console.ReadLine().ToUpper()
match action with
| "D" ->
// revert to logged in with no selected customer
LoggedIn principal
| "G" ->
// use Option.iter in case we don't have the capability
getCustomerCap
|> Option.iter BusinessServices.getCustomer
originalState // stay in same state
| "U" ->
updateCustomerCap
|> Option.iter BusinessServices.updateCustomer
originalState
| "P" ->
updatePasswordCap
|> Option.iter BusinessServices.updatePassword
originalState
| _ ->
// unknown option
originalState
let rec mainUiLoop capabilityProvider state =
match state with
| LoggedOut ->
let newState = loggedOutActions state
mainUiLoop capabilityProvider newState
| LoggedIn principal ->
let newState = loggedInActions state principal
mainUiLoop capabilityProvider newState
| CustomerSelected (principal,customerId) ->
let newState = selectedCustomerActions state capabilityProvider customerId principal
mainUiLoop capabilityProvider newState
| Exit ->
() // done
let start capabilityProvider =
mainUiLoop capabilityProvider LoggedOut
// ----------------------------------------------
/// Top level module
module Application=
open Rop
open Domain
open CustomerDatabase
open Authentication
open Authorization
open Capabilities
let capabilities =
let getCustomerOnlyForSameId id principal =
onlyForSameId id principal CustomerDatabase.getCustomer
let getCustomerOnlyForAgentsInBusinessHours id principal =
let cap1 = onlyForAgents id principal CustomerDatabase.getCustomer
let restriction f = onlyIfDuringBusinessHours (DateTime.Now) f
cap1 |> restrict restriction
let getCustomerOnlyForSameId_OrForAgentsInBusinessHours id principal =
let cap1 = getCustomerOnlyForSameId id principal
let cap2 = getCustomerOnlyForAgentsInBusinessHours id principal
first [cap1; cap2]
let updateCustomerOnlyForSameId id principal =
onlyForSameId id principal CustomerDatabase.updateCustomer
let updateCustomerOnlyForAgentsInBusinessHours id principal =
let cap1 = onlyForAgents id principal CustomerDatabase.updateCustomer
// uncomment to get the restriction
// let restriction f = onlyIfDuringBusinessHours (DateTime.Now) f
let restriction = Some // no restriction
cap1 |> restrict restriction
let updateCustomerOnlyForSameId_OrForAgentsInBusinessHours id principal =
let cap1 = updateCustomerOnlyForSameId id principal
let cap2 = updateCustomerOnlyForAgentsInBusinessHours id principal
first [cap1; cap2]
let updatePasswordOnlyForSameId id principal =
let cap = passwordUpdate id principal CustomerDatabase.updatePassword
cap
|> Option.map (auditable "UpdatePassword" principal.Identity.Name)
// create the record that contains the capabilities
{
getCustomer = getCustomerOnlyForSameId_OrForAgentsInBusinessHours
updateCustomer = updateCustomerOnlyForSameId_OrForAgentsInBusinessHours
updatePassword = updatePasswordOnlyForSameId
}
let start() =
// pass capabilities to UI
UserInterface.start capabilities
// compile all the code above
// and then run this separately to start the app
Application.start()
(*
CapabilityBasedSecurity_ConsoleExample_WithTypes.fsx
An example of a capability-based console application that also includes authorization and access tokens.
Related blog post: http://fsharpforfunandprofit.com/posts/capability-based-security-3/
*)
open System.Security.Principal
open System
// ================================================
// A complete console application demonstrating capabilities
// ================================================
module Rop =
type SuccessFailure<'a,'b> =
| Success of 'a
| Failure of 'b
let bind f = function
| Success x -> f x
| Failure e -> Failure e
let map f = function
| Success x -> Success (f x)
| Failure e -> Failure e
let orElse errValue = function
| Success x -> x
| Failure _ -> errValue
/// Core domain types shares across the application
module Domain =
open Rop
type CustomerId = CustomerId of int
type CustomerData = CustomerData of string
type Password = Password of string
type FailureCase =
| AuthenticationFailed of string
| AuthorizationFailed
| CustomerNameNotFound of string
| CustomerIdNotFound of CustomerId
| OnlyAllowedOnce
| CapabilityRevoked
// ----------------------------------------------
/// Capabilities that are available in the application
module Capabilities =
open Rop
open Domain
// each access token gets its own type
type AccessCustomer = AccessCustomer of CustomerId
type UpdatePassword = UpdatePassword of CustomerId
// capabilities
type GetCustomerCap = unit -> SuccessFailure<CustomerData,FailureCase>
type UpdateCustomerCap = CustomerData -> SuccessFailure<unit,FailureCase>
type UpdatePasswordCap = Password -> SuccessFailure<unit,FailureCase>
type CapabilityProvider = {
/// given a customerId and IPrincipal, attempt to get the GetCustomer capability
getCustomer : CustomerId -> IPrincipal -> GetCustomerCap option
/// given a customerId and IPrincipal, attempt to get the UpdateCustomer capability
updateCustomer : CustomerId -> IPrincipal -> UpdateCustomerCap option
/// given a customerId and IPrincipal, attempt to get the UpdatePassword capability
updatePassword : CustomerId -> IPrincipal -> UpdatePasswordCap option
}
// ----------------------------------------------
/// Functions related to authentication
module Authentication =
open Rop
open Domain
let customerRole = "Customer"
let customerAgentRole = "CustomerAgent"
let makePrincipal name role =
let iden = GenericIdentity(name)
let principal = GenericPrincipal(iden,[|role|])
principal :> IPrincipal
let authenticate name =
match name with
| "Alice" | "Bob" ->
makePrincipal name customerRole |> Success
| "Zelda" ->
makePrincipal name customerAgentRole |> Success
| _ ->
AuthenticationFailed name |> Failure
let customerIdForName name =
match name with
| "Alice" -> CustomerId 1 |> Success
| "Bob" -> CustomerId 2 |> Success
| _ -> CustomerNameNotFound name |> Failure
let customerIdOwnedByPrincipal customerId (principle:IPrincipal) =
principle.Identity.Name
|> customerIdForName
|> Rop.map (fun principalId -> principalId = customerId)
|> Rop.orElse false
// ----------------------------------------------
/// Functions related to authorization
module Authorization =
open Rop
open Domain
open Capabilities
// the constructor is protected
type AccessToken<'data> = private {data:'data} with
// but do allow read access to the data
member this.Data = this.data
let onlyForSameId (id:CustomerId) (principal:IPrincipal) =
if Authentication.customerIdOwnedByPrincipal id principal then
Some {data=AccessCustomer id}
else
None
let onlyForAgents (id:CustomerId) (principal:IPrincipal) =
if principal.IsInRole(Authentication.customerAgentRole) then
Some {data=AccessCustomer id}
else
None
let onlyIfDuringBusinessHours (time:DateTime) f =
if time.Hour >= 8 && time.Hour <= 17 then
Some f
else
None
// constrain who can call a password update function
let passwordUpdate (id:CustomerId) (principal:IPrincipal) =
if Authentication.customerIdOwnedByPrincipal id principal then
Some {data=UpdatePassword id}
else
None
// return the first good capability, if any
let first capabilityList =
capabilityList |> List.tryPick id
// given a capability option, restrict it
let restrict filter originalCap =
originalCap
|> Option.bind filter
/// Uses of the capability will be audited
let auditable capabilityName principalName f =
fun x ->
// simple audit log!
let timestamp = DateTime.UtcNow.ToString("u")
printfn "AUDIT: User %s used capability %s at %s" principalName capabilityName timestamp
// use the capability
f x
/// Return a pair of functions: the revokable capability,
/// and the revoker function
let revokable f =
let allow = ref true
let capability = fun x ->
if !allow then //! is dereferencing not negation!
f x
else
Failure CapabilityRevoked
let revoker() =
allow := false
capability, revoker
// ----------------------------------------------
/// Functions related to database access
module CustomerDatabase =
open Rop
open System.Collections.Generic
open Domain
open Capabilities
open Authorization
let private db = Dictionary<CustomerId,CustomerData>()
let getCustomer (accessToken:AccessToken<AccessCustomer>) =
// get customer id
let (AccessCustomer id) = accessToken.Data
// now get customer data using the id
match db.TryGetValue id with
| true, value -> Success value
| false, _ -> Failure (CustomerIdNotFound id)
let updateCustomer (accessToken:AccessToken<AccessCustomer>) (data:CustomerData) =
// get customer id
let (AccessCustomer id) = accessToken.Data
// update database
db.[id] <- data
Success ()
let updatePassword (accessToken:AccessToken<UpdatePassword>) (password:Password) =
Success () // dummy implementation
// ----------------------------------------------
module BusinessServices =
open Rop
open Domain
// use the getCustomer capability
let getCustomer capability =
match capability() with
| Success data -> printfn "%A" data
| Failure err -> printfn ".. %A" err
// use the updateCustomer capability
let updateCustomer capability =
printfn "Enter new data: "
let customerData = Console.ReadLine() |> CustomerData
match capability customerData with
| Success _ -> printfn "Data updated"
| Failure err -> printfn ".. %A" err
// use the updatePassword capability
let updatePassword capability =
printfn "Enter new password: "
let password = Console.ReadLine() |> Password
match capability password with
| Success _ -> printfn "Password updated"
| Failure err -> printfn ".. %A" err
// ----------------------------------------------
module UserInterface =
open Rop
open Domain
open Capabilities
type CurrentState =
| LoggedOut
| LoggedIn of IPrincipal
| CustomerSelected of IPrincipal * CustomerId
| Exit
/// do the actions available while you are logged out. Return the new state
let loggedOutActions originalState =
printfn "[Login] enter Alice, Bob, Zelda, or Exit: "
let action = Console.ReadLine()
match action with
| "Exit" ->
// Change state to Exit
Exit
| name ->
// otherwise try to authenticate the name
match Authentication.authenticate name with
| Success principal ->
LoggedIn principal
| Failure err ->
printfn ".. %A" err
originalState
/// do the actions available while you are logged in. Return the new state
let loggedInActions originalState (principal:IPrincipal) =
printfn "[%s] Pick a customer to work on. Enter Alice, Bob, or Logout: " principal.Identity.Name
let action = Console.ReadLine()
match action with
| "Logout" ->
// Change state to LoggedOut
LoggedOut
// otherwise treat it as a customer name
| customerName ->
// Attempt to find customer
match Authentication.customerIdForName customerName with
| Success customerId ->
// found -- change state
CustomerSelected (principal,customerId)
| Failure err ->
// not found -- stay in originalState
printfn ".. %A" err
originalState
let getAvailableCapabilities capabilityProvider customerId principal =
let getCustomer = capabilityProvider.getCustomer customerId principal
let updateCustomer = capabilityProvider.updateCustomer customerId principal
let updatePassword = capabilityProvider.updatePassword customerId principal
getCustomer,updateCustomer,updatePassword
/// do the actions available when a selected customer is available. Return the new state
let selectedCustomerActions originalState capabilityProvider customerId principal =
// get the individual component capabilities from the provider
let getCustomerCap,updateCustomerCap,updatePasswordCap =
getAvailableCapabilities capabilityProvider customerId principal
// get the text for menu options based on capabilities that are present
let menuOptionTexts =
[
getCustomerCap |> Option.map (fun _ -> "(G)et");
updateCustomerCap |> Option.map (fun _ -> "(U)pdate");
updatePasswordCap |> Option.map (fun _ -> "(P)assword");
]
|> List.choose id
// show the menu
let actionText =
match menuOptionTexts with
| [] -> " (no other actions available)"
| texts -> texts |> List.reduce (fun s t -> s + ", " + t)
printfn "[%s] (D)eselect customer, %s" principal.Identity.Name actionText
// process the user action
let action = Console.ReadLine().ToUpper()
match action with
| "D" ->
// revert to logged in with no selected customer
LoggedIn principal
| "G" ->
// use Option.iter in case we don't have the capability
getCustomerCap
|> Option.iter BusinessServices.getCustomer
originalState // stay in same state
| "U" ->
updateCustomerCap
|> Option.iter BusinessServices.updateCustomer
originalState
| "P" ->
updatePasswordCap
|> Option.iter BusinessServices.updatePassword
originalState
| _ ->
// unknown option
originalState
let rec mainUiLoop capabilityProvider state =
match state with
| LoggedOut ->
let newState = loggedOutActions state
mainUiLoop capabilityProvider newState
| LoggedIn principal ->
let newState = loggedInActions state principal
mainUiLoop capabilityProvider newState
| CustomerSelected (principal,customerId) ->
let newState = selectedCustomerActions state capabilityProvider customerId principal
mainUiLoop capabilityProvider newState
| Exit ->
() // done
let start capabilityProvider =
mainUiLoop capabilityProvider LoggedOut
// ----------------------------------------------
/// Top level module
module Application=
open Rop
open Domain
open CustomerDatabase
open Authentication
open Authorization
open Capabilities
let capabilities =
// apply the token, if present,
// to a function which has only the token as a parameter
let tokenToCap f token =
token
|> Option.map (fun token ->
fun () -> f token)
// apply the token, if present,
// to a function which has the token and other parameters
let tokenToCap2 f token =
token
|> Option.map (fun token ->
fun x -> f token x)
let getCustomerOnlyForSameId id principal =
let accessToken = Authorization.onlyForSameId id principal
accessToken |> tokenToCap CustomerDatabase.getCustomer
let getCustomerOnlyForAgentsInBusinessHours id principal =
let accessToken = Authorization.onlyForAgents id principal
let cap1 = accessToken |> tokenToCap CustomerDatabase.getCustomer
let restriction f = onlyIfDuringBusinessHours (DateTime.Now) f
cap1 |> restrict restriction
let getCustomerOnlyForSameId_OrForAgentsInBusinessHours id principal =
let cap1 = getCustomerOnlyForSameId id principal
let cap2 = getCustomerOnlyForAgentsInBusinessHours id principal
first [cap1; cap2]
let updateCustomerOnlyForSameId id principal =
let accessToken = Authorization.onlyForSameId id principal
accessToken |> tokenToCap2 CustomerDatabase.updateCustomer
let updateCustomerOnlyForAgentsInBusinessHours id principal =
let accessToken = Authorization.onlyForAgents id principal
let cap1 = accessToken |> tokenToCap2 CustomerDatabase.updateCustomer
// uncomment to get the restriction
// let restriction f = onlyIfDuringBusinessHours (DateTime.Now) f
let restriction = Some // no restriction
cap1 |> restrict restriction
let updateCustomerOnlyForSameId_OrForAgentsInBusinessHours id principal =
let cap1 = updateCustomerOnlyForSameId id principal
let cap2 = updateCustomerOnlyForAgentsInBusinessHours id principal
first [cap1; cap2]
let updatePasswordOnlyForSameId id principal =
let accessToken = Authorization.passwordUpdate id principal
let cap = accessToken |> tokenToCap2 CustomerDatabase.updatePassword
cap
|> Option.map (auditable "UpdatePassword" principal.Identity.Name)
// create the record that contains the capabilities
{
getCustomer = getCustomerOnlyForSameId_OrForAgentsInBusinessHours
updateCustomer = updateCustomerOnlyForSameId_OrForAgentsInBusinessHours
updatePassword = updatePasswordOnlyForSameId
}
let start() =
// pass capabilities to UI
UserInterface.start capabilities
// compile all the code above
// and then run this separately to start the app
Application.start()
(*
CapabilityBasedSecurity_DbExample.fsx
Code snippets from the blog post: http://fsharpforfunandprofit.com/posts/capability-based-security-2/
*)
open System.Security.Principal
open System
// ==============================
// dummy definitions
// ==============================
type CustomerId = int
type CustomerData = string
let customerIdBelongsToPrincipal (id:CustomerId) (principle:IPrincipal) = true
type SuccessFailure<'a,'b> =
| Success of 'a
| Failure of 'b
type DbErrors =
| AuthorizationFailed
| OnlyAllowedOnce
| OnlyAllowedNTimes of int
| Revoked
// ==============================
// end dummy definitions
// ==============================
// ==============================
// Example 1 - inlined authorization
// ==============================
module Example1 =
let getCustomer id principal =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
// get database
Success "CustomerData"
else
Failure AuthorizationFailed
let updateCustomer id data principal =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
// update database
Success "OK"
else
Failure AuthorizationFailed
// ==============================
// Example 2 - separate CapabilityProvider
// ==============================
module Example2 =
module internal CustomerDatabase =
let getCustomer (id:CustomerId) :CustomerData =
// get customer data
"CustomerData"
let updateCustomer (id:CustomerId) (data:CustomerData) =
// update database
()
/// accessible to the business layer
module CustomerDatabaseCapabilityProvider =
// Get the capability to call getCustomer
let getGetCustomerCapability (id:CustomerId) (principal:IPrincipal) =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
Some ( fun () -> CustomerDatabase.getCustomer id )
else
None
// Get the capability to call UpdateCustomer
let getUpdateCustomerCapability (id:CustomerId) (principal:IPrincipal) =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
Some ( fun () -> CustomerDatabase.updateCustomer id )
else
None
// ==============================
// Example 3 - separate CapabilityFilter
// ==============================
module Example3 =
module internal CustomerDatabase =
let getCustomer (id:CustomerId) :CustomerData =
// get customer data
"data"
// val getCustomer : CustomerId -> CustomerData
let updateCustomer (id:CustomerId) (data:CustomerData) =
// update database
()
// val updateCustomer : CustomerId -> CustomerData -> unit
module CustomerCapabilityFilter =
// Get the capability to use any function that has a CustomerId parameter
// but only if the caller has the same customer id or is a member of the
// CustomerAgent role.
let onlyForSameIdOrAgents (id:CustomerId) (principal:IPrincipal) (f:CustomerId -> 'a) =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
Some (fun () -> f id)
else
None
module Startup =
open CustomerCapabilityFilter
let principal = WindowsPrincipal.Current // from context
let id = 0 // from context
let getCustomerOnlyForSameIdOrAgents =
onlyForSameIdOrAgents id principal CustomerDatabase.getCustomer
// val getCustomerOnlyForSameIdOrAgents : (CustomerId -> CustomerData) option
let updateCustomerOnlyForSameIdOrAgents =
onlyForSameIdOrAgents id principal CustomerDatabase.updateCustomer
// val updateCustomerOnlyForSameIdOrAgents : (CustomerId -> CustomerData -> unit) option
match getCustomerOnlyForSameIdOrAgents with
| Some cap -> () // create child component and pass in the capability
| None -> () // return error saying that you don't have the capability to get the data
// ==============================
// Example 4 - composable filters
// ==============================
module Example4 =
module internal CustomerDatabase =
let getCustomer (id:CustomerId) : CustomerData =
// get customer data
"data"
// val getCustomer : CustomerId -> CustomerData
let updateCustomer (id:CustomerId) (data:CustomerData) =
// update database
()
// val updateCustomer : CustomerId -> CustomerData -> unit
module CustomerCapabilityFilter =
let onlyForSameId (id:CustomerId) (principal:IPrincipal) (f:CustomerId -> 'a) =
if customerIdBelongsToPrincipal id principal then
Some (fun () -> f id)
else
None
let onlyForAgents (id:CustomerId) (principal:IPrincipal) (f:CustomerId -> 'a) =
if principal.IsInRole("CustomerAgent") then
Some (fun () -> f id)
else
None
let onlyIfDuringBusinessHours (time:DateTime) f =
if time.Hour >= 8 && time.Hour <= 17 then
Some f
else
None
// given a list of capability options,
// return the first good one, if any
let first capabilityList =
capabilityList |> List.tryPick id
// given a capability option, restrict it
let restrict filter originalCap =
originalCap
|> Option.bind filter
module Startup =
open CustomerCapabilityFilter
let principal = WindowsPrincipal.Current // from context
let id = 0 // from context
let getCustomerOnlyForSameId =
let f = CustomerDatabase.getCustomer
onlyForSameId id principal f
// val getCustomerOnlyForSameId : (unit -> CustomerData) option
let getCustomerOnlyForSameIdOrAgents =
let f = CustomerDatabase.getCustomer
let cap1 = onlyForSameId id principal f
let cap2 = onlyForAgents id principal f
first [cap1; cap2]
// val getCustomerOnlyForSameIdOrAgents : (unit -> CustomerData) option
let updateCustomerOnlyForSameIdOrAgents =
let f = CustomerDatabase.updateCustomer
let cap1 = onlyForSameId id principal f
let cap2 = onlyForAgents id principal f
first [cap1; cap2]
// val updateCustomerOnlyForSameIdOrAgents : (unit -> CustomerData -> unit) option
match getCustomerOnlyForSameIdOrAgents with
| Some cap -> () // create child component and pass in the capability
| None -> () // return error saying that you don't have the capability to get the data
let getCustomerOnlyForAgentsInBusinessHours =
let f = CustomerDatabase.getCustomer
let cap1 = onlyForAgents id principal f
let restriction f = onlyIfDuringBusinessHours (DateTime.Now) f
cap1 |> restrict restriction
// val getCustomerOnlyForAgentsInBusinessHours : (unit -> CustomerData) option
let getCustomerOnlyForSameId_OrForAgentsInBusinessHours =
let cap1 = getCustomerOnlyForSameId
let cap2 = getCustomerOnlyForAgentsInBusinessHours
first [cap1; cap2]
// ==============================
// Example 5 - more transforms
// ==============================
module Example5 =
module internal CustomerDatabase =
let updatePassword (id,password) =
Success "OK"
module GenericCapabilityFilter =
/// Uses of the capability will be audited
let auditable capabilityName f =
fun x ->
// simple audit log!
printfn "AUDIT: calling %s with %A" capabilityName x
// use the capability
f x
/// Allow the function to be called once only
let onlyOnce f =
let allow = ref true
fun x ->
if !allow then //! is dereferencing not negation!
allow := false
f x
else
Failure OnlyAllowedOnce
/// Return a pair of functions: the revokable capability,
/// and the revoker function
let revokable f =
let allow = ref true
let capability = fun x ->
if !allow then //! is dereferencing not negation!
f x
else
Failure Revoked
let revoker() =
allow := false
capability, revoker
module Startup =
open GenericCapabilityFilter
// ----------------------------------------
let updatePasswordWithAudit x =
auditable "updatePassword" CustomerDatabase.updatePassword x
// test
updatePasswordWithAudit (1,"password")
updatePasswordWithAudit (1,"new password")
// AUDIT: calling updatePassword with (1, "password")
// AUDIT: calling updatePassword with (1, "new password")
// ----------------------------------------
let updatePasswordOnce =
onlyOnce CustomerDatabase.updatePassword
// test
updatePasswordOnce (1,"password") |> printfn "Result 1st time: %A"
updatePasswordOnce (1,"password") |> printfn "Result 2nd time: %A"
// Result 1st time: Success "OK"
// Result 2nd time: Failure OnlyAllowedOnce
// ----------------------------------------
let revokableUpdatePassword, revoker =
revokable CustomerDatabase.updatePassword
// test
revokableUpdatePassword (1,"password") |> printfn "Result 1st time before revoking: %A"
revokableUpdatePassword (1,"password") |> printfn "Result 2nd time before revoking: %A"
revoker()
revokableUpdatePassword (1,"password") |> printfn "Result 3nd time after revoking: %A"
// Result 1st time before revoking: Success "OK"
// Result 2nd time before revoking: Success "OK"
// Result 3nd time after revoking: Failure Revoked
(*
CapabilityBasedSecurity_TypeExample.fsx
Code snippets from the blog post: http://fsharpforfunandprofit.com/posts/capability-based-security-3/
*)
open System.Security.Principal
open System
// ==============================
// dummy definitions
// ==============================
type CustomerId = int
type CustomerData = CustomerData of string
type Password = Password of string
let myCustomerData = CustomerData "data"
let customerIdBelongsToPrincipal customerId (principle:IPrincipal) = true
type SuccessFailure<'a,'b> =
| Success of 'a
| Failure of 'b
type DbErrors =
| AuthorizationFailed
| CustomerIdNotFound of CustomerId
// ==============================
// end dummy definitions
// ==============================
// ==============================
// Example 1 - access token in same service
// ==============================
module Example1 =
/// Public database module
module CustomerDatabase =
type DbAccessToken private() =
// create a DbAccessToken that allows access to a particular customer
static member getAccessToCustomer id principal =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
Some <| DbAccessToken()
else
None
let getCustomer (accessToken:DbAccessToken) (id:CustomerId) =
// get customer data
Success myCustomerData
let updateCustomer (accessToken:DbAccessToken) (id:CustomerId) (data:CustomerData) =
// update database
Success "OK"
/// Usage example
module Startup =
let principal = WindowsPrincipal.Current // from context
let id = 0 // from context
// attempt to get an access token
let accessToken = CustomerDatabase.DbAccessToken.getAccessToCustomer id principal
// get the (optional) capabilities
let getCustomerCap =
accessToken |> Option.map CustomerDatabase.getCustomer
let updateCustomerCap =
accessToken |> Option.map CustomerDatabase.updateCustomer
// use the capabilities, if available
match getCustomerCap with
| Some getCustomer -> getCustomer id
| None -> Failure AuthorizationFailed // error
match updateCustomerCap with
| Some updateCustomer -> updateCustomer id myCustomerData
| None -> Failure AuthorizationFailed // error
// ==============================
// Example 2 - access token from separate service
//
// Dangerous because (a) the access token can be reused
// and (b) the access token doesn't store the customer id
// ==============================
module Example2 =
/// OO version of AccessToken
module AuthorizationService =
// the constructor is hidden using "private"
type AccessToken private() =
// create a AccessToken that allows access to a particular customer
static member getAccessToCustomer id principal =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
Some <| AccessToken()
else
None
/// Public database module
module CustomerDatabase =
open AuthorizationService
let getCustomer (accessToken:AccessToken) (id:CustomerId) =
// get customer data
Success myCustomerData
let updateCustomer (accessToken:AccessToken) (id:CustomerId) (data:CustomerData) =
// update database
Success "OK"
/// Usage example
module Startup =
let principal = WindowsPrincipal.Current // from context
let id = 0 // from context
// attempt to get an access token
let accessToken = AuthorizationService.AccessToken.getAccessToCustomer id principal
// get the (optional) capabilities
let getCustomerCap =
accessToken |> Option.map CustomerDatabase.getCustomer
let updateCustomerCap =
accessToken |> Option.map CustomerDatabase.updateCustomer
// use the capabilities, if available
match getCustomerCap with
| Some getCustomer -> getCustomer id
| None -> Failure AuthorizationFailed // error
match updateCustomerCap with
| Some updateCustomer -> updateCustomer id myCustomerData
| None -> Failure AuthorizationFailed // error
// ==============================
// Example 3 - access token stores information
// ==============================
module Example3 =
module Capabilities =
// each capability gets a type
type AccessCustomer = AccessCustomer of CustomerId
type UpdatePassword = UpdatePassword of CustomerId
// functional version of AccessToken
module AuthorizationService =
open Capabilities
// the constructor is protected
type AccessToken<'data> = private {data:'data} with
// but do allow read access to the data
member this.Data = this.data
// create a AccessToken that allows access to a particular customer
let getAccessCustomerToken id principal =
if customerIdBelongsToPrincipal id principal ||
principal.IsInRole("CustomerAgent")
then
Some {data=AccessCustomer id}
else
None
// create a AccessToken that allows access to UpdatePassword
let getUpdatePasswordToken id principal =
if customerIdBelongsToPrincipal id principal then
Some {data=UpdatePassword id}
else
None
/// Public database module
module CustomerDatabase =
open Capabilities
open AuthorizationService
open System.Collections.Generic
let private db = Dictionary<CustomerId,CustomerData>()
let getCustomer (accessToken:AccessToken<AccessCustomer>) =
// get customer id
let (AccessCustomer id) = accessToken.Data
// now get customer data using the id
match db.TryGetValue id with
| true, value -> Success value
| false, _ -> Failure (CustomerIdNotFound id)
let updateCustomer (accessToken:AccessToken<AccessCustomer>) (data:CustomerData) =
// get customer id
let (AccessCustomer id) = accessToken.Data
// update database
db.[id] <- data
Success ()
let updatePassword (accessToken:AccessToken<UpdatePassword>) (password:Password) =
Success () // dummy implementation
/// Usage example
module Startup =
open AuthorizationService
let principal = WindowsPrincipal.Current // from context
let customerId = 0 // from context
// attempt to get a capability
let getCustomerCap =
// attempt to get a token
let accessToken = AuthorizationService.getAccessCustomerToken customerId principal
match accessToken with
// if token is present pass the token to CustomerDatabase.getCustomer,
// and return a unit->CustomerData
| Some token ->
Some (fun () -> CustomerDatabase.getCustomer token)
| None -> None
// use the capability, if available
match getCustomerCap with
| Some getCustomer -> getCustomer()
| None -> Failure AuthorizationFailed // error
// attempt to get a capability
let getUpdatePasswordCap =
let accessToken = AuthorizationService.getAccessCustomerToken customerId principal
match accessToken with
| Some token ->
Some (fun password -> CustomerDatabase.updatePassword token password)
| None -> None
match getUpdatePasswordCap with
| Some updatePassword ->
let password = Password "p@ssw0rd"
updatePassword password
| None ->
Failure AuthorizationFailed // error
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment