From c032c8c4575226ba72e72ade71c6f2d488f2ed55 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Sun, 17 Mar 2019 21:27:10 +0100 Subject: [PATCH] Bumping version to 1.1.16 --- RELEASE_NOTES.md | 2 +- src/Client/ReleaseNotes.fs | 4 +-- src/Client/TagHistory.fs | 71 +++++++++++++++++++++++++++++++++----- src/Server/AzureTable.fs | 22 ++++++++++++ src/Server/Server.fs | 15 ++++++-- src/Shared/Shared.fs | 31 +++++++++++++++++ 6 files changed, 132 insertions(+), 13 deletions(-) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index b8890bc..de0843c 100644 --- a/RELEASE_NOTES.md +++ b/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 diff --git a/src/Client/ReleaseNotes.fs b/src/Client/ReleaseNotes.fs index a06b2a7..0d49e50 100644 --- a/src/Client/ReleaseNotes.fs +++ b/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 diff --git a/src/Client/TagHistory.fs b/src/Client/TagHistory.fs index 6b0fb14..f78e743 100644 --- a/src/Client/TagHistory.fs +++ b/src/Client/TagHistory.fs @@ -1,11 +1,10 @@ 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 @@ -13,10 +12,17 @@ open Thoth.Json 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 = @@ -24,17 +30,33 @@ type Msg = | ServerMsg of Elmish.WebSocket.WebSocketMsg | ConnectToWebsocket | RetrySocketConnection of TimeSpan -| Error of exn +| HistoryLoaded of Result +| 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 = 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 = match msg with | Refresh -> @@ -67,6 +90,12 @@ let update (msg : Msg) (model : Model) : Model * Cmd = { 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 = | 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 = 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 [][ ] \ No newline at end of file + div [][ + historyTable model dispatch + ] \ No newline at end of file diff --git a/src/Server/AzureTable.fs b/src/Server/AzureTable.fs index 6367ae8..c72ea58 100644 --- a/src/Server/AzureTable.fs +++ b/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 diff --git a/src/Server/Server.fs b/src/Server/Server.fs index 62a6f47..dcf8c5e 100644 --- a/src/Server/Server.fs +++ b/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 diff --git a/src/Shared/Shared.fs b/src/Shared/Shared.fs index f939603..ea1a537 100644 --- a/src/Shared/Shared.fs +++ b/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 [] }