Commit 0c07bded authored by Cédric F.'s avatar Cédric F.

Display relative time

parent 4600b43e
Pipeline #13966348 (#) failed with stage
in 1 minute and 15 seconds
......@@ -9,6 +9,7 @@
"exposed-modules": [],
"dependencies": {
"NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
"alpacaaa/elm-date-distance": "1.1.0 <= v < 2.0.0",
"elm-lang/core": "5.1.1 <= v < 6.0.0",
"elm-lang/html": "2.0.0 <= v < 3.0.0",
"elm-lang/http": "1.0.0 <= v < 2.0.0",
......
......@@ -3,6 +3,7 @@ module Components.Address exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)
import Http exposing (Error)
import Time exposing (Time)
import Json.Encode as Encode
import Json.Decode as Decode
import Lib.JsonRpc as JsonRpc
......@@ -55,8 +56,8 @@ type Msg
| TicketsForAddressResult (Result Http.Error (List String))
view : Model -> Html a
view model =
view : Model -> Time -> Html a
view model now =
let
details model =
if missingTransactions model then
......@@ -80,11 +81,11 @@ view model =
|> List.map
(\tx ->
tr []
[ td [] [ a [ href tx.hash ] [ text <| shortHash tx.hash ] ]
[ td [] [ queryLink tx.hash (shortHash tx.hash) [] ]
, td [] [ text tx.type_ ]
, td []
[ Transaction.vInToAddress model.address tx |> formatAmount ]
, td [] [ text <| Transaction.formatTime tx ]
, td [] [ Transaction.formatTime tx now ]
, td [] [ text <| toString tx.confirmations ]
]
)
......
......@@ -86,8 +86,8 @@ type Msg
| GetBlockHashResult (Result Http.Error String)
view : Model -> Html Msg
view model =
view : Model -> Time -> Html Msg
view model now =
let
sibbling maybeHash direction =
case maybeHash of
......@@ -156,9 +156,7 @@ view model =
[ text <| formatNumber model.height ]
)
, ( "time"
, Just <|
span []
[ text <| TimeExtra.toISOString model.time ]
, Just <| TimeExtra.timeAgo model.time now
)
, ( "confirmations"
, Just <|
......
module Components.Status exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)
import Http exposing (Error)
import Json.Encode
import Json.Decode
import Lib.JsonRpc as JsonRpc
import Trappisto.Helpers exposing (..)
type alias Model =
{ blocks : Int
, connections : Int
, fetching : Bool
, error : Maybe String
, webSocketConnected : Bool
}
initialModel : Model
initialModel =
{ blocks = -1
, connections = -1
, fetching = False
, error = Nothing
, webSocketConnected = False
}
type alias JsonModel =
{ blocks : Int
, connections : Int
}
type Msg
= GetInfo
| GetInfoResult (Result Http.Error JsonModel)
view : Model -> Html a
view model =
let
block =
if model.blocks < 0 then
span [] [ text "??????" ]
else
queryLink (toString model.blocks) (toString model.blocks) []
( wsClass, wsStatus ) =
if model.webSocketConnected then
( "success", "on" )
else
( "danger", "off" )
in
div []
[ span
[ class "badge badge-info" ]
[ h5 []
[ span [] [ text "Last block: " ]
, block
, br [] []
, span [] [ text "N minutes ago" ]
]
]
, span
[ class <| "badge badge-pill badge-" ++ wsClass ]
[ text <| "Live updating: " ++ wsStatus ]
]
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
GetInfo ->
let
updatedModel =
{ model | fetching = True }
in
( updatedModel, getInfo updatedModel )
GetInfoResult result ->
case result of
Ok jsonModel ->
( { model
| blocks = jsonModel.blocks
, connections = jsonModel.connections
, fetching = False
, error = Nothing
}
, Cmd.none
)
Err error ->
( { model
| error = JsonRpc.parseError error
, fetching = False
}
, Cmd.none
)
getInfo : Model -> Cmd Msg
getInfo model =
let
params =
Json.Encode.list []
in
JsonRpc.post "getinfo" params GetInfoResult decodeStatusFetch
decodeStatusFetch : Json.Decode.Decoder JsonModel
decodeStatusFetch =
Json.Decode.map2 JsonModel
(Json.Decode.at [ "result", "blocks" ] Json.Decode.int)
(Json.Decode.at [ "result", "connections" ] Json.Decode.int)
......@@ -108,8 +108,8 @@ type Msg
| GetRawTransactionResult (Result Http.Error JsonModel)
view : Model -> Html a
view model =
view : Model -> Time -> Html a
view model now =
let
formatType type_ =
span [ class "badge badge badge-success" ] [ text type_ ]
......@@ -217,7 +217,7 @@ view model =
, Just <| span [] [ text <| toString model.confirmations ]
)
, ( "time"
, Just <| span [] [ text <| formatTime model ]
, Just <| span [] [ formatTime model now ]
)
, ( "block"
, Just <| formatBlock model.blockHash model.blockHeight
......@@ -415,14 +415,14 @@ computeVote jsonModel =
-- "methods" to get info from Model
formatTime : Model -> String
formatTime model =
formatTime : Model -> Time -> Html msg
formatTime model now =
case model.time of
Nothing ->
"recent (unconfirmed)"
span [] [ text "recent (unconfirmed)" ]
Just time ->
TimeExtra.toISOString time
TimeExtra.timeAgo time now
vInToAddress : String -> Model -> Float
......
......@@ -2,6 +2,9 @@ module Lib.TimeExtra exposing (..)
import Date exposing (Date)
import Time exposing (Time)
import Html exposing (..)
import Html.Attributes exposing (..)
import Date.Distance
import Lib.DateExtra
......@@ -33,3 +36,17 @@ toISOString time =
timestampToTime : Int -> Time
timestampToTime int =
Time.second * (toFloat int)
timeAgo : Time -> Time -> Html msg
timeAgo time now =
let
absolute =
toISOString time
relative =
Date.Distance.inWords (Date.fromTime now) (Date.fromTime time) ++ " ago"
in
Html.time
[ datetime absolute, title absolute ]
[ text relative ]
module Lib.WebSocket exposing (send, isSuccess)
module Lib.WebSocket exposing (send, isSuccess, newBlock)
import WebSocket
import Json.Encode
import Json.Decode as Decode
import Json.Encode as Encode
send : String -> String -> List Json.Encode.Value -> Cmd msg
send : String -> String -> List Encode.Value -> Cmd msg
send endpoint method params =
let
json =
Json.Encode.object
[ ( "jsonrpc", Json.Encode.string "2.0" )
, ( "id", Json.Encode.int 0 )
, ( "method", Json.Encode.string method )
, ( "params", Json.Encode.list params )
Encode.object
[ ( "jsonrpc", Encode.string "1.0" )
, ( "id", Encode.int 0 )
, ( "method", Encode.string method )
, ( "params", Encode.list params )
]
in
json
|> Json.Encode.encode 0
|> Encode.encode 0
|> WebSocket.send endpoint
isSuccess : String -> Bool
isSuccess jsonString =
jsonString == "{\"result\":null,\"error\":null,\"id\":0}"
let
decoder =
Decode.maybe <| Decode.field "error" <| Decode.string
result =
Decode.decodeString decoder jsonString
in
case result of
Err _ ->
False
Ok maybeError ->
maybeError == Nothing
newBlock : String -> Maybe Int
newBlock jsonString =
if filterMethod [ "blockconnected", "blockdisconnected" ] jsonString then
-- decodeNewBlock jsonString
Nothing
else
Nothing
-- write tests
filterMethod : List String -> String -> Bool
filterMethod methods jsonString =
let
decoder =
Decode.maybe <| Decode.field "method" <| Decode.string
result =
Decode.decodeString decoder jsonString
in
case result of
Err _ ->
False
Ok maybeMethod ->
List.any (\method -> Just method == maybeMethod) methods
-- == "{\"result\":null,\"error\":null,\"id\":0}"
-- decode : String -> Json.Decode.Decoder Notification
-- decode jsonString =
-- Json.Decode.map2 JsonModel
......
......@@ -4,7 +4,7 @@ import Navigation
import Window
import Keyboard
import Time exposing (Time)
import Components.Status as StatusComponent
import Http exposing (Error)
import Components.Address as AddressComponent
import Components.Block as BlockComponent
import Components.Transaction as TransactionComponent
......@@ -20,7 +20,7 @@ type alias Config =
type Template
= Status
= Home
| Address
| Block
| Transaction
......@@ -30,7 +30,6 @@ type alias Model =
{ config : Config
, keys : Keys
, window : Window.Size
, statusModel : StatusComponent.Model
, addressModel : AddressComponent.Model
, blockModel : BlockComponent.Model
, transactionModel : TransactionComponent.Model
......@@ -41,6 +40,10 @@ type alias Model =
, vimMode : Bool
, debug : Bool
, time : Time
, lastWebSocketPong : Time
, lastBlockHeight : Int
, fetching : Bool
, webSocketConnected : Bool
}
......@@ -49,23 +52,25 @@ initialModel coin wsEndpoint query =
{ config = Config coin
, keys = Keys False False False False False False
, window = Window.Size 0 0
, statusModel = StatusComponent.initialModel
, addressModel = AddressComponent.initialModel coin
, blockModel = BlockComponent.initialModel coin
, transactionModel = TransactionComponent.initialModel coin
, query = query
, template = Status
, template = Home
, error = Nothing
, wsEndpoint = wsEndpoint
, vimMode = False
, debug = False
, time = 0
, time = -1
, lastWebSocketPong = -1
, lastBlockHeight = -1
, fetching = False
, webSocketConnected = False
}
type Msg
= NewUrl Navigation.Location
| StatusMsg StatusComponent.Msg
| AddressMsg AddressComponent.Msg
| BlockMsg BlockComponent.Msg
| TransactionMsg TransactionComponent.Msg
......@@ -75,7 +80,8 @@ type Msg
| Resize Window.Size
| Tick Time
| WSMsg String
| FetchStatus
| GetInfo
| GetInfoResult (Result Http.Error Int)
type alias Keys =
......
......@@ -5,8 +5,10 @@ import Keyboard
import Task exposing (Task)
import Time exposing (Time)
import Window
import Json.Encode as Encode
import Json.Decode as Decode
import Lib.JsonRpc as JsonRpc
import WebSocket
import Components.Status as StatusComponent
import Components.Address as AddressComponent
import Components.Block as BlockComponent
import Components.Transaction as TransactionComponent
......@@ -21,6 +23,11 @@ port elmToJs : List String -> Cmd msg
port jsToElm : (List String -> msg) -> Sub msg
webSocketTTL : Time
webSocketTTL =
Time.second * 10
init : Flags -> Navigation.Location -> ( Model, Cmd Msg )
init flags location =
let
......@@ -52,7 +59,7 @@ init flags location =
( updatedModel, msg ) =
if String.isEmpty query then
update FetchStatus model
update GetInfo model
else
update (Query query) model
......@@ -68,6 +75,7 @@ init flags location =
, msg
, notifyBlocks
, notifyNewTransactions
, Task.perform Tick Time.now
, Task.perform Resize Window.size
]
)
......@@ -79,7 +87,7 @@ subscriptions model =
[ Keyboard.downs (KeyChange True)
, Keyboard.ups (KeyChange False)
, Window.resizes Resize
, Time.every (Time.second * 60) Tick
, Time.every webSocketTTL Tick
, WebSocket.listen model.wsEndpoint WSMsg
, jsToElm JsMsg
]
......@@ -89,14 +97,20 @@ update : Msg -> Model -> ( Model, Cmd Msg )
update action model =
case action of
Tick time ->
-- let
-- -- TODO: ideally we should be able to trigger all updates when
-- -- we receive a websocket event and not use polling altogether
-- -- ( updatedModel, cmd ) =
-- -- update (Query model.query) model
-- in
-- ( { model | time = time }, notifyBlocks )
( model, Cmd.none )
let
ping =
Lib.WebSocket.send model.wsEndpoint "session" []
timeout =
model.time - model.lastWebSocketPong >= webSocketTTL
updatedModel =
{ model
| time = time
, webSocketConnected = not timeout
}
in
( updatedModel, ping )
WSMsg message ->
let
......@@ -106,24 +120,26 @@ update action model =
connected =
Lib.WebSocket.isSuccess message
status =
model.statusModel
lastBlockHeight =
case Lib.WebSocket.newBlock message of
Nothing ->
model.lastBlockHeight
Just height ->
height
updatedStatus =
{ status | webSocketConnected = connected }
updatedModel =
{ model
| webSocketConnected = connected
, lastWebSocketPong = model.time
, lastBlockHeight = lastBlockHeight
}
in
( { model | statusModel = updatedStatus }, Cmd.none )
( updatedModel, Cmd.none )
NewUrl location ->
( { model | query = extractQuery location }, Cmd.none )
FetchStatus ->
let
( updatedModel, cmd ) =
StatusComponent.update StatusComponent.GetInfo model.statusModel
in
( { model | statusModel = updatedModel }, Cmd.map StatusMsg cmd )
Query query ->
let
--- FIXME: add BTC genesis?
......@@ -152,7 +168,7 @@ update action model =
{ model | query = query, error = Nothing }
in
if query == "" then
( { updatedModel | template = Status }
( { updatedModel | template = Home }
, Cmd.none
)
|> updateUrl
......@@ -166,25 +182,38 @@ update action model =
fetchBlockByHeight (parseBlockHeight query) updatedModel
else
( { updatedModel
| template = Status
| template = Home
, error = Just "Not sure what you're looking for :|"
}
, Cmd.none
)
|> updateUrl
StatusMsg statusMsg ->
GetInfo ->
let
( updatedModel, cmd ) =
StatusComponent.update statusMsg model.statusModel
updatedModel =
{ model | fetching = True }
in
( { model
| template = Status
, statusModel = updatedModel
}
, Cmd.map StatusMsg cmd
)
|> updateUrl
( updatedModel, getInfo updatedModel )
GetInfoResult result ->
case result of
Ok blocks ->
( { model
| lastBlockHeight = blocks
, fetching = False
, error = Nothing
}
, Cmd.none
)
Err error ->
( { model
| error = JsonRpc.parseError error
, fetching = False
}
, Cmd.none
)
AddressMsg addressMsg ->
let
......@@ -396,3 +425,17 @@ updateUrl ( model, cmd ) =
]
in
( model, Cmd.batch <| commands ++ [ cmd ] )
getInfo : Model -> Cmd Msg
getInfo model =
let
params =
Encode.list []
in
JsonRpc.post "getinfo" params GetInfoResult decodeStatusFetch
decodeStatusFetch : Decode.Decoder Int
decodeStatusFetch =
Decode.at [ "result", "blocks" ] Decode.int
......@@ -5,7 +5,7 @@ import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Lib.HtmlAttributesExtra as HtmlAttributesExtra
import Trappisto.Model exposing (..)
import Components.Status as StatusComponent exposing (view)
import Trappisto.Helpers exposing (..)
import Components.Address as AddressComponent exposing (view)
import Components.Block as BlockComponent exposing (view)
import Components.Transaction as TransactionComponent exposing (view)
......@@ -13,7 +13,7 @@ import Components.Transaction as TransactionComponent exposing (view)
isFetching : Model -> Bool
isFetching model =
model.statusModel.fetching
model.fetching
|| model.addressModel.fetching
|| model.blockModel.fetching
|| model.transactionModel.fetching
......@@ -39,8 +39,8 @@ getError model =
Block ->
model.blockModel.error
Status ->
model.statusModel.error
Home ->
model.error
errorView : Model -> Html Msg
......@@ -83,7 +83,7 @@ searchView model =
[ class "col-2"
, style [ ( "background-color", "rgba(255,255,255,0.5)" ) ]
]
[ (StatusComponent.view model.statusModel) ]
[ statusView model ]
]
vim =
......@@ -127,22 +127,48 @@ searchView model =
statusView : Model -> Html Msg
statusView model =
Html.map StatusMsg (StatusComponent.view model.statusModel)
let
lastBlock =
if model.lastBlockHeight < 0 then
span [] [ text "??????" ]
else
queryLink (toString model.lastBlockHeight) (toString model.lastBlockHeight) []
( wsClass, wsStatus ) =
if model.webSocketConnected then
( "success", "ON" )
else
( "danger", "OFF" )
in
div [ class "text-center" ]
[ span
[ class "badge badge-info" ]
[ h5 []
[ span [] [ text "Last block: " ]
, lastBlock
, br [] []
, span [] [ text "N minutes ago" ]
]
]
, span
[ class <| "badge badge-pill badge-" ++ wsClass ]
[ text <| "Live updating: " ++ wsStatus ]
]
addressView : Model -> Html Msg
addressView model =
Html.map AddressMsg (AddressComponent.view model.addressModel)
Html.map AddressMsg (AddressComponent.view model.addressModel model.time)
blockView : Model -> Html Msg
blockView model =
Html.map BlockMsg (BlockComponent.view model.blockModel)
Html.map BlockMsg (BlockComponent.view model.blockModel model.time)
transactionView : Model -> Html Msg
transactionView model =
Html.map TransactionMsg (TransactionComponent.view model.transactionModel)
Html.map TransactionMsg (TransactionComponent.view model.transactionModel model.time)
view : Model -> Html Msg
......@@ -163,7 +189,7 @@ view model =
[ searchView model, errorView model ]
else
case model.template of
Status ->
Home ->
case model.query of
"" ->
[ searchView model, errorView model, ascii ]
......
......@@ -10,6 +10,7 @@
"exposed-modules": [],
"dependencies": {
"NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
"alpacaaa/elm-date-distance": "1.1.0 <= v < 2.0.0",
"eeue56/elm-html-test": "5.1.1 <= v < 6.0.0",
"elm-community/elm-test": "4.0.0 <= v < 5.0.0",
"elm-lang/core": "5.1.1 <= v < 6.0.0",
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment