[Server] logging on failure

Author: haf

.semver

@@ -1,6 +1,6 @@
 ---
 :major: 0
 :minor: 5
-:patch: 0
+:patch: 1
 :special: ''
 :metadata: ''

README.md

@@ -247,6 +247,9 @@ This module adds some functions for composing Choice-s:
  - `(>>@) : m:Choice<'a, 'b> -> f:('b -> 'c) -> Choice<'a, 'c>` - map the
    second/error choice value to another one (and another type, possibly).
  - `map_2` - same as above
+ - `(>>*) : m:Choice<'a, 'b> -> f:('b -> unit) -> Choice<'a, 'b>` - inject
+   a side-effect if the choice is in the error case.
+ - `inject_2` - same as above
 
 #### Example
 

src/logibit.hawk.sln

@@ -40,7 +40,4 @@ Global
 	EndGlobalSection
 	GlobalSection(NestedProjects) = preSolution
 	EndGlobalSection
-	GlobalSection(MonoDevelopProperties) = preSolution
-		StartupItem = logibit.hawk.tests\logibit.hawk.tests.fsproj
-	EndGlobalSection
 EndGlobal

src/logibit.hawk.suave.tests/Hawk.fs

@@ -47,8 +47,8 @@ let making_request =
     Hawk.authenticate
       settings
       Hawk.bind_req
-      (fun (attr, creds, user) -> OK (sprintf "authenticated user '%s'" user.real_name))
       (fun err -> UNAUTHORIZED (err.ToString()))
+      (fun (attr, creds, user) -> OK (sprintf "authenticated user '%s'" user.real_name))
 
   let req m data f_req f_resp =
     req_resp m "/" "" data None System.Net.DecompressionMethods.None f_req f_resp

src/logibit.hawk/Choice.fs

@@ -13,7 +13,7 @@ let (>>=) m f =
 /// bind the successful value to f
 let bind f m = (m >>= f)
 
-/// bind f to the successful value
+/// bind f to the error value
 let (>>!) m f =
   m
   |> function
@@ -42,6 +42,7 @@ let (>>-) m f =
 /// map success
 let map f o = (o >>- f)
 
+/// map error
 let (>>@) m f =
   m
   |> function
@@ -50,3 +51,16 @@ let (>>@) m f =
 
 /// map error
 let map_2 f o = o >>@ f
+
+/// inject a side-effect beside the error
+let (>>*) m f =
+  m
+  |> function
+  | Choice1Of2 x -> Choice1Of2 x
+  | Choice2Of2 err ->
+    f err
+    Choice2Of2 err
+
+/// inject a side-effect beside the error
+let inject_2 f o =
+  o >>* f

src/logibit.hawk/Server.fs

@@ -278,6 +278,14 @@ module internal Impl =
     else
       Choice2Of2 (StaleTimestamp (given_ts, now, local_offset))
 
+  let log_failure (logger : Logger) timestamp (err : AuthError) =
+    { message   = "authenticate failure"
+      level     = Info
+      path      = "logibit.hawk.Server.authenticate"
+      data      = [ "error", box err ] |> Map.ofList
+      timestamp = timestamp }
+    |> logger.Log
+
 open Impl
 
 /// Parse the header into key-value pairs in the form
@@ -305,7 +313,7 @@ let authenticate (s : Settings<'a>)
   let map_result (a, (b, c)) = a, b, c
 
   (fun _ -> 
-    { message = "authenticate"
+    { message = "authenticate start"
       level   = Debug
       path    = "logibit.hawk.Server.authenticate"
       data    =
@@ -345,6 +353,7 @@ let authenticate (s : Settings<'a>)
       >>= validate_nonce s.nonce_validator
       >>= validate_timestamp now_with_offset s.allowed_clock_skew s.local_clock_offset
       >>- map_result
+      >>* log_failure s.logger now
 
 /// Authenticate payload hash - used when payload cannot be provided
 /// during authenticate()