Fork me on GitHub

Code Snippet:

 1 #r "System.IdentityModel"
 2 #r "System.ServiceModel"
 3 #r "System.ServiceModel.Http"
 4 #r "System.ServiceModel.Primitives"
 5 #r "System.Runtime.Serialization"
 6 #r "FSharp.Data.TypeProviders.dll"
 7 
 8 open System
 9 open System.IO
10 open System.Net
11 open System.Runtime.Serialization
12 open System.ServiceModel
13 open System.ServiceModel.Description
14 open System.ServiceModel.Dispatcher
15 open System.Text
16 open System.Web.Services.Protocols
17 open Microsoft.FSharp.Data.TypeProviders
18 
19 type AuthorizationHeader(basicAuth) = 
20   interface IClientMessageInspector with
21     member x.AfterReceiveReply(reply, correlationState) = ()
22     member x.BeforeSendRequest(request, channel) = 
23       let prop = new Channels.HttpRequestMessageProperty()
24       prop.Headers.Add(name = "Authorization", value = basicAuth)
25       request.Properties.Add(Channels.HttpRequestMessageProperty.Name, prop) :> obj
26 
27 type BasicAuthorization(usr : string, pwd : string) = 
28   let bytes = Encoding.UTF8.GetBytes(usr + ":" + pwd)
29   let auth = "Basic " + Convert.ToBase64String(bytes)
30   interface IEndpointBehavior with
31     member x.Validate(endpoint) = ()
32     member x.AddBindingParameters(endpoint, bindingParameters) = ()
33     member x.ApplyDispatchBehavior(endpoint, endpointDispatcher) = ()
34     member x.ApplyClientBehavior(endpoint, clientRuntime) = 
35       clientRuntime.ClientMessageInspectors.Add(new AuthorizationHeader(auth))
36 
37 [<Literal>]
38 let baseurl = "https://DOMAIN_GOES_HERE.flexnetoperations.com/flexnet/services/"
39 
40 [<Literal>]
41 let fnauth = baseurl + "FlexnetAuthentication?wsdl"
42 
43 [<Literal>]
44 let userorghierarchy = baseurl + "UserOrgHierarchyService?wsdl"
45 
46 type FlexnetAuthentication = WsdlService< ServiceUri=fnauth >
47 type UserOrgHierarchyService = WsdlService< ServiceUri=userorghierarchy >
48 
49 let usr = "USERNAME_GOES_HERE"
50 let pwd = "PASSWORD_GOES_HERE"
51 
52 /// Example 1: (require Basic Auth)
53 let user = new UserOrgHierarchyService.ServiceTypes.getUserPermissionsRequestType()
54 do user.userName <- "USERNAME_GOES_HER"
55 do user.domainName <- "FLEXnet"
56 
57 let client1 = UserOrgHierarchyService.GetUserOrgHierarchyService()
58 do client1.DataContext.Endpoint.Behaviors.Add(new BasicAuthorization(usr, pwd))
59 
60 let result1 = client1.getUserPermissions (user)
61 
62 match result1.statusInfo.status with
63 | UserOrgHierarchyService.ServiceTypes.StatusType.SUCCESS -> 
64   result1.responseData.permissions |> Array.iter (printfn "Permission: %s")
65 | _ -> printfn "%A" result1.statusInfo.status
66 
67 /// Example 2: (doesn't requiere Basic Auth)
68 let auth = new FlexnetAuthentication.ServiceTypes.AuthenticateUserInputType()
69 do auth.userName <- usr
70 do auth.password <- pwd
71 do auth.domainName <- "FLEXnet"
72 
73 let client2 = FlexnetAuthentication.GetFlexnetAuthentication()
74 
75 let result2 = client2.authenticateUser (auth)
76 
77 printfn "Access granted to %s: %b" usr result2.Success

References:

All

Code Snippet:

 1 #nowarn "40"
 2 
 3 open System
 4 
 5 /// Types (alias types)
 6 type Agent<'a> = MailboxProcessor<'a>
 7 
 8 /// Domain agents
 9 let print fn =
10   Agent.Start(fun inbox ->
11     let rec loop = async {
12       let! msg = inbox.Receive()
13       fn msg
14       return! loop }
15     loop)
16 
17 let duplicate a1 a2 fn =
18   Agent.Start(fun inbox ->
19     let rec loop = async {
20       let! msg = inbox.Receive()
21       fn a1 a2 msg
22       return! loop }
23     loop)
24 
25 let delay a fn =
26   Agent.Start(fun inbox ->
27     let rec loop = async {
28       let! msg = inbox.Receive()
29       fn a msg
30       return! loop }
31     loop)
32 
33 let add a fn =
34   Agent.Start(fun inbox ->
35     let rec loop state = async {
36       let! msg = inbox.Receive()
37       state |> function | None -> () | Some v -> fn a (0I+v+msg);
38       return! loop (Some (msg))}
39     loop (None))
40 
41 /// Domain functions
42 let out = lazy print (fun msg -> printfn "%A" msg)
43 let rec delta2int =
44   lazy
45     duplicate out (pairsInt:Lazy<Agent<bigint>>)
46       (fun a1 a2 msg -> a1.Value.Post msg; a2.Value.Post msg)
47 and prefixInt0 = lazy delay delta2int (fun a msg -> a.Value.Post msg)
48 and prefixInt1 = lazy delay prefixInt0 (fun a msg -> a.Value.Post msg)
49 and pairsInt = lazy add prefixInt1 (fun a msg -> a.Value.Post msg)
50 
51 prefixInt0.Value.Post 0I
52 prefixInt1.Value.Post 1I
53 
54 // Main (recursive loop)
55 let rec main () : unit = main ()
56 main ()

Code output:

type Agent<'a> = MailboxProcessor<'a>
val print : fn:('a -> unit) -> MailboxProcessor<'a>
val duplicate :
  a1:'a -> a2:'b -> fn:('a -> 'b -> 'c -> unit) -> MailboxProcessor<'c>
val delay : a:'a -> fn:('a -> 'b -> unit) -> MailboxProcessor<'b>
val add :
  a:'a ->
    fn:('a -> Numerics.BigInteger -> unit) ->
      MailboxProcessor<Numerics.BigInteger>
val out : Lazy<MailboxProcessor<bigint>> = Value is not created.
val delta2int : Lazy<MailboxProcessor<bigint>> = Value is not created.
val prefixInt0 : Lazy<MailboxProcessor<bigint>> = Value is not created.
val prefixInt1 : Lazy<MailboxProcessor<bigint>> = Value is not created.
val pairsInt : Lazy<Agent<bigint>> = Value is not created.
0
1
1
2
3
5
8
13
21
34
55
89
144
233
377
610
987
1597
2584
4181
6765
10946
17711
28657
46368
75025
121393
196418
317811
514229
832040
1346269
2178309
3524578
5702887
9227465
14930352
24157817
39088169
63245986
102334155
165580141
267914296
433494437
701408733
1134903170
1836311903
2971215073
4807526976
7778742049
12586269025
20365011074
32951280099
53316291173
86267571272
139583862445
225851433717
365435296162
591286729879
956722026041
1548008755920
2504730781961
4052739537881
6557470319842
10610209857723
17167680177565
27777890035288
44945570212853
72723460248141
117669030460994
190392490709135
308061521170129
498454011879264
806515533049393
1304969544928657
...

Error output (only on Mono):

Unhandled Exception:
System.NullReferenceException: Object reference not set to an instance of an object
  at Microsoft.FSharp.Control.AsyncBuilderImpl+bindA@783[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
  at Microsoft.FSharp.Control.AsyncBuilderImpl+callA@805[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
  at Microsoft.FSharp.Control.AsyncBuilderImpl+tryWithA@839[Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
  at Microsoft.FSharp.Control.AsyncBuilderImpl+callA@805[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Control.AsyncParams`1 args) [0x00000] in <filename unknown>:0
  at Microsoft.FSharp.Control.AsyncBuilderImpl+queueAsync@727[Microsoft.FSharp.Core.Unit].Invoke (Microsoft.FSharp.Core.Unit unitVar0) [0x00000] in <filename unknown>:0
  at <StartupCode$FSharp-Core>.$Control.loop@426-40 (Microsoft.FSharp.Control.Trampoline this, Microsoft.FSharp.Core.FSharpFunc`2 action) [0x00000] in <filename unknown>:0
  at Microsoft.FSharp.Control.Trampoline.ExecuteAction (Microsoft.FSharp.Core.FSharpFunc`2 firstAction) [0x00000] in <filename unknown>:0
  at Microsoft.FSharp.Control.TrampolineHolder.Protect (Microsoft.FSharp.Core.FSharpFunc`2 firstAction) [0x00000] in <filename unknown>:0
  at <StartupCode$FSharp-Core>.$Control+-ctor@512-1.Invoke (System.Object state) [0x00000] in <filename unknown>:0
Mono JIT compiler version 4.0.0 ((detached/d136b79 Mon Apr 13 14:40:59 EDT 2015)
Copyright (C) 2002-2014 Novell, Inc, Xamarin Inc and Contributors. www.mono-project.com
        TLS:           normal
        SIGSEGV:       altstack
        Notification:  kqueue
        Architecture:  x86
        Disabled:      none
        Misc:          softdebug
        LLVM:          yes(3.6.0svn-mono-(detached/a173357)
        GC:            sgen

References:

Code Snippet:

 1 #load @"Utils/ListLazy.fs"
 2 
 3 open Stermon.Research.Utils
 4 
 5 let corruptStartPoint l =
 6   let rec loopStart = function
 7     | Cons(h1,t1),Cons(h2,t2) -> (h1 = h2) |> function
 8       | true -> Some h1
 9       | false ->
10         loopStart (t1.Force(),t2.Force())
11     | _,_ -> None
12   let rec meetPoint = function
13     | Cons(h1,t1),Cons(h2,t2) -> (h1 = h2) |> function
14       | true -> loopStart (l,t2.Force())
15       | false ->
16         meetPoint (t1.Force(),(t2.Force() |> List.Lazy.skip 1I))
17     | _,_ -> None
18   meetPoint (l,(l |> List.Lazy.skip 1I))

Code output:

[Loading Utils/ListLazy.fs]

namespace FSI_0002.Stermon.Research.Utils
  type 'a ListLazy =
    | Cons of 'a * Lazy<'a ListLazy>
    | Nil
  module Lazy = begin
    val single : h:'a -> 'a ListLazy
    val cons : h:'a -> l:'a ListLazy -> 'a ListLazy
    val head : _arg1:'a ListLazy -> 'a
    val tail : _arg1:'a ListLazy -> 'a ListLazy
    val iter : f:('a -> unit) -> _arg1:'a ListLazy -> unit
    val map : f:('a -> 'b) -> _arg1:'a ListLazy -> 'b ListLazy
    val fold : f:('a -> 'b -> 'a) -> init:'a -> _arg1:'b ListLazy -> 'a
    val foldBack :
      f:('a -> Lazy<'b> -> 'b) -> init:'b -> _arg1:'a ListLazy -> 'b
    val unfold : f:('a -> ('b * 'a) option) -> init:'a -> 'b ListLazy
    val reduce : f:('a -> 'a -> 'a) -> _arg1:'a ListLazy -> 'a
    val reduceBack : f:('a -> Lazy<'a> -> 'a) -> _arg1:'a ListLazy -> 'a
    val skip :
      n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
    val take :
      n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
    val append : l1:'a ListLazy -> l2:'a ListLazy -> 'a ListLazy
    val concat : _arg1:'a ListLazy ListLazy -> 'a ListLazy
    val ofList : _arg1:'a list -> 'a ListLazy
    val toList : l:'a ListLazy -> 'a list
  end

val corruptStartPoint :
  l:'a Stermon.Research.Utils.ListLazy -> 'a option when 'a : equality

Non corrupt linked list

All

1 let example1 = List.Lazy.unfold(fun s -> Some(s,s+1)) 0 |> List.Lazy.take 26I
2 
3 example1
4 |> List.Lazy.iter(printf "%i ")
5 
6 corruptStartPoint example1
> val example1 : int ListLazy = Cons (0,Value is not created.)
> 0 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 val it : unit = ()
> val it : int option = None

Corrupt linked list

All

 1 let corruptGenerator n =
 2   List.Lazy.unfold(
 3     fun s -> (s < n) |> function
 4     | false -> Some((s % n) + n,s+1)
 5     | true  -> Some(s,s+1)) 0
 6 
 7 let example2 = corruptGenerator 7
 8 
 9 example2
10 |> List.Lazy.take 28I
11 |> List.Lazy.iter(printf "%i ")
12 
13 corruptStartPoint example2
> val corruptGenerator : n:int -> int ListLazy
> val example2 : int ListLazy = Cons (0,Value is not created.)
> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 7 8 9 10 11 12 13 7 8 9 10 11 12 13 val it : unit = ()
> val it : int option = Some 7

References: