Bumping version to 1.1.16

RELEASE_NOTES.md

@@ -1,6 +1,6 @@
 # Release Notes
 
-## 1.1.15 - 2019-03-17
+## 1.1.16 - 2019-03-17
 * Upgrade Raspbian
 
 ## 1.1.0 - 2019-01-20

src/Client/ReleaseNotes.fs

@@ -1,13 +1,13 @@
 module internal ReleaseNotes
 
-let Version = "1.1.15"
+let Version = "1.1.16"
 
 let IsPrerelease = false
 
 let Notes = """
 # Release Notes
 
-## 1.1.15 - 2019-03-17
+## 1.1.16 - 2019-03-17
 * Upgrade Raspbian
 
 ## 1.1.0 - 2019-01-20

src/Client/TagHistory.fs

@@ -1,40 +1,62 @@
 module TagHistory
 
 
-open System
-open Fable.Helpers.React
-open Fable.PowerPack
 open Elmish
-open ServerCore.Domain
+open Elmish.React
+open Elmish.HMR
+open Fable.PowerPack
 
 #if FABLE_COMPILER
 open Thoth.Json
 #else
 open Thoth.Json.Net
 #endif
 
+open System
+open Fable.PowerPack.Fetch
+open Fulma
+open ServerCore.Domain
+
+
 type Model = {
     WebSocket : Fable.Import.Browser.WebSocket
     Connected : bool
     UserID : string
+    Requests : Request []
 }
 
 type Msg =
 | Refresh
 | ServerMsg of Elmish.WebSocket.WebSocketMsg<TagHistorySocketEvent>
 | ConnectToWebsocket
 | RetrySocketConnection of TimeSpan
-| Error of exn
+| HistoryLoaded of Result<RequestList, exn>
+| MsgError of exn
+
+
+let fetchHistory (userID) = promise {
+    let! res = Fetch.fetch (sprintf "api/history/%s" userID) []
+    let! txt = res.text()
+
+    match Decode.fromString RequestList.Decoder txt with
+    | Ok tags -> return tags
+    | Error msg -> return failwith msg
+}
+
+let fetchHistoryCmd userID = Cmd.ofPromise fetchHistory userID (Ok >> HistoryLoaded) (Error >> HistoryLoaded)
+
 
 let init (userID) : Model * Cmd<Msg> =
     let initialModel = {
         WebSocket = null
         Connected = false
         UserID = userID
+        Requests = [||]
     }
 
     initialModel,
         Cmd.batch [
+            fetchHistoryCmd userID
             Cmd.ofMsg ConnectToWebsocket
             Cmd.ofMsg Refresh
         ]
@@ -48,6 +70,7 @@ let runIn (timeSpan:System.TimeSpan) successMsg errorMsg =
     Cmd.ofPromise p () (fun _ -> successMsg) errorMsg
 
 
+
 let update (msg : Msg) (model : Model) : Model * Cmd<Msg> =
     match msg with
     | Refresh ->
@@ -67,6 +90,12 @@ let update (msg : Msg) (model : Model) : Model * Cmd<Msg> =
             { model with
                 WebSocket = ws }, Elmish.WebSocket.Cmd.Configure ws ServerMsg
 
+    | HistoryLoaded (Ok requests) ->
+        { model with Requests = requests.Requests }, Cmd.ofMsg Refresh
+
+    | HistoryLoaded _  ->
+        model, Cmd.none
+
     | ServerMsg Elmish.WebSocket.WebSocketMsg.Opening ->
         { model with Connected = true }, Cmd.none
 
@@ -83,9 +112,9 @@ let update (msg : Msg) (model : Model) : Model * Cmd<Msg> =
             | TagHistorySocketEvent.ToDo -> Cmd.ofMsg Refresh
 
     | RetrySocketConnection delay ->
-        model, runIn delay ConnectToWebsocket Error
+        model, runIn delay ConnectToWebsocket MsgError
 
-    | Error _exn ->
+    | MsgError _exn ->
         model,
             if model.Connected then
                 Cmd.ofMsg Refresh
@@ -95,5 +124,31 @@ let update (msg : Msg) (model : Model) : Model * Cmd<Msg> =
                     Cmd.ofMsg (RetrySocketConnection (TimeSpan.FromSeconds 10.))
                 ]
 
+open Fable.Helpers.React
+open Fable.Helpers.React.Props
+open Fable.Core.JsInterop
+
+let historyTable (model : Model) (dispatch : Msg -> unit) =
+    div [] [
+        table [][
+            thead [][
+                tr [] [
+                    th [] [ str "Time"]
+                    th [] [ str "Token"]
+                ]
+            ]
+            tbody [][
+                for tag in model.Requests ->
+                    tr [ Id tag.Token ] [
+                        yield td [ ] [ str (tag.Timestamp.ToString("o")) ]
+                        yield td [ Title tag.Token ] [ str tag.Token ]
+                    ]
+            ]
+        ]
+    ]
+
+
 let view (dispatch: Msg -> unit) (model:Model) =
-    div [][ ]
+    div [][ 
+        historyTable model dispatch
+    ]

src/Server/AzureTable.fs

@@ -151,6 +151,11 @@ let mapTag (entity: DynamicTableEntity) : Tag =
         | Ok action -> action }
 
 
+let mapRequest (entity: DynamicTableEntity) : Request =
+    { UserID = entity.PartitionKey
+      Token = getStringProperty "Token" entity
+      Timestamp = DateTimeOffset.Parse entity.RowKey }
+
 let mapPlayListPosition (entity: DynamicTableEntity) : PlayListPosition =
     { UserID = entity.PartitionKey
       Token = entity.RowKey
@@ -192,6 +197,23 @@ let saveRequest (userID:string) (token:string) =
     requestsTable.ExecuteAsync operation
 
 
+let getAllRequestsForUser (userID:string) = task {
+    let rec getResults token = task {
+        let query = TableQuery.GenerateFilterCondition("PartitionKey", QueryComparisons.Equal, userID)
+        let! result = requestsTable.ExecuteQuerySegmentedAsync(TableQuery(FilterString = query), token)
+        let token = result.ContinuationToken
+        let result = result |> Seq.toList
+        if isNull token then
+            return result
+        else
+            let! others = getResults token
+            return result @ others }
+
+    let! results = getResults null
+
+    return [| for result in results -> mapRequest result |]
+}
+
 let savePlayListPosition (userID:string) (token:string) position =
     let entity = DynamicTableEntity()
     entity.PartitionKey <- userID

src/Server/Server.fs

@@ -195,7 +195,7 @@ let nextFileEndpoint (userID,token) =
         })
     }
 
-let allTagsEndpoint userID =
+let userTagsEndPoint userID =
     pipeline {
         set_header "Content-Type" "application/json"
         plug (fun next ctx -> task {
@@ -205,6 +205,16 @@ let allTagsEndpoint userID =
         })
     }
 
+let historyEndPoint userID =
+    pipeline {
+        set_header "Content-Type" "application/json"
+        plug (fun next ctx -> task {
+            let! requests = AzureTable.getAllRequestsForUser userID
+            let txt = RequestList.Encoder { Requests = requests } |> Encode.toString 0
+            return! setBodyFromString txt next ctx
+        })
+    }
+
 let startupEndpoint =
     pipeline {
         set_header "Content-Type" "application/json"
@@ -284,8 +294,9 @@ let webApp =
     router {
         getf "/api/nextfile/%s/%s" nextFileEndpoint
         getf "/api/previousfile/%s/%s" previousFileEndpoint
-        getf "/api/usertags/%s" allTagsEndpoint
+        getf "/api/usertags/%s" userTagsEndPoint
         postf "/api/upload/%s" uploadEndpoint
+        getf "/api/history/%s" historyEndPoint
         get "/api/startup" startupEndpoint
         get "/api/firmware" firmwareEndpoint
         get "/api/youtube" youtubeEndpoint

src/Shared/Shared.fs

@@ -144,6 +144,24 @@ type Tag =
               Action = get.Required.Field "Action" TagAction.Decoder }
         )
 
+type Request =
+    { Token : string
+      Timestamp : DateTimeOffset
+      UserID : string }
+
+    static member Encoder (request : Request) =
+        Encode.object [
+            "Token", Encode.string request.Token
+            "UserID", Encode.string request.UserID
+            "Timestamp", Encode.datetimeOffset request.Timestamp
+        ]
+    static member Decoder =
+        Decode.object (fun get ->
+            { Token = get.Required.Field "Token" Decode.string
+              UserID = get.Required.Field "UserID" Decode.string
+              Timestamp = get.Required.Field "Timestamp" Decode.datetimeOffset }
+        )
+
 type PlayListPosition = {
     Token : string
     UserID : string
@@ -172,6 +190,19 @@ type TagForBox =
               Action = get.Required.Field "Action" TagActionForBox.Decoder }
         )
 
+type RequestList =
+    { Requests : Request [] }
+
+    static member Encoder (requesrList : RequestList) =
+        Encode.object [
+            "Requests", requesrList.Requests |> Array.map Request.Encoder |> Encode.array
+        ]
+
+    static member Decoder =
+        Decode.object (fun get ->
+            { Requests = get.Required.Field "Requests" (Decode.array Request.Decoder) }
+        )
+
 
 type TagList =
     { Tags : Tag [] }