6 people like it.
Like the snippet!

The Facet Pattern

The Facet Pattern Used for Principle of Least Authority (POLA) Inspired by: "The Lazy Programmer's Guide to Secure Computing" http://www.youtube.com/watch?v=eL5o4PFuxTY

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35:

// Facet Pattern
// Used for Principle of Least Authority (POLA)
// Inspired by: "The Lazy Programmer's Guide to Secure Computing"
//              http://www.youtube.com/watch?v=eL5o4PFuxTY
type IFacet<'a> =
    abstract Set    : 'a   -> unit
    abstract Get    : unit -> 'a Option
    abstract Revoke : unit -> unit
 
type OnOff = On | Off
 
let allowWrite access f = if access=On then f()
let allowRead  access f = if access=On then Some( f() ) else None
 
/// Revocable Facet Maker
let makeFacet x =
    let access = ref On
    { new IFacet<_> with
        member this.Revoke() =             access := Off            
        member this.Get()    = allowRead  !access (fun () -> !x )
        member this.Set(v)   = allowWrite !access (fun () ->  x := v)
    }
 
// usage
let my = ref "Revocable Facet"
let facet = makeFacet my
 
facet.Get()             = Some "Revocable Facet"
facet.Set( "changed" )
facet.Get()             = Some "changed"
facet.Revoke()       
facet.Get()             = None
facet.Set( "changed2" )
facet.Get()             = None
my.Value                = "changed"

Multiple items
abstract member IFacet.Set : 'a -> unit

Full name: Script.IFacet`1.Set

--------------------
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

abstract member IFacet.Get : unit -> Option<'a>

Full name: Script.IFacet`1.Get

module Option

from Microsoft.FSharp.Core

abstract member IFacet.Revoke : unit -> unit

Full name: Script.IFacet`1.Revoke

type OnOff =
| On
| Off

Full name: Script.OnOff

union case OnOff.On: OnOff

union case OnOff.Off: OnOff

val allowWrite : access:OnOff -> f:(unit -> unit) -> unit

Full name: Script.allowWrite

val access : OnOff

val f : (unit -> unit)

val allowRead : access:OnOff -> f:(unit -> 'a) -> 'a option

Full name: Script.allowRead

val f : (unit -> 'a)

union case Option.Some: Value: 'T -> Option<'T>

union case Option.None: Option<'T>

val makeFacet : x:'a ref -> IFacet<'a>

Full name: Script.makeFacet

Revocable Facet Maker

val x : 'a ref

val access : OnOff ref

Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>

type IFacet<'a> =
  interface
    abstract member Get : unit -> Option<'a>
    abstract member Revoke : unit -> unit
    abstract member Set : 'a -> unit
  end

Full name: Script.IFacet<_>

val this : IFacet<'a>

abstract member IFacet.Revoke : unit -> unit

abstract member IFacet.Get : unit -> Option<'a>

abstract member IFacet.Set : 'a -> unit

val v : 'a

val my : string ref

Full name: Script.my

val facet : IFacet<string>

Full name: Script.facet

property Ref.Value: string

Raw view Test code New version

More information

Link:	http://fssnip.net/gb
Posted:	11 years ago
Author:	user3539
Tags:	facet pattern , principle of least authority , pola , secure computing