feat: add block search capability

CHANGELOG.md

@@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [0.3.0.0]
+
+### Added
+
+- New block component
+
 ## [0.2.0.1]
 
 ### Fixed

spago.dhall

@@ -17,7 +17,6 @@ to generate this file without the comments in this block.
   , "affjax-web"
   , "argonaut-codecs"
   , "arrays"
-  , "codec-argonaut"
   , "console"
   , "datetime"
   , "effect"
@@ -35,6 +34,7 @@ to generate this file without the comments in this block.
   , "routing-duplex"
   , "safe-coerce"
   , "simple-json"
+  , "strings"
   , "tailrec"
   , "transformers"
   , "web-events"

src/Exblo/API.purs

@@ -133,3 +133,12 @@ sumBundles t s o =
           Nothing -> 0
           Just sap -> sap.value
       )
+
+type Block =
+  { hash :: String
+  , height :: Int
+  , confirmations :: Int
+  , time :: Int
+  , tx :: Array String
+  }
+

src/Exblo/Block.purs

@@ -0,0 +1,127 @@
+module Exblo.Block where
+
+import Prelude
+
+import Simple.JSON (readJSON)
+import Affjax.StatusCode (StatusCode(..))
+import Affjax.Web as AX
+import Affjax.ResponseFormat as AXRF
+import Data.Maybe (Maybe(..))
+import Data.Either (Either(..))
+import Effect.Aff.Class (class MonadAff)
+import Exblo.API (Block, ZcashNet)
+import Exblo.Navigate (class Navigate, navigate, Route(..))
+import Exblo.Store as S
+import Exblo.Utils (css, convertToDate, safeHref)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.Store.Connect (Connected, connect)
+import Halogen.Store.Monad (class MonadStore)
+import Halogen.Store.Select (selectEq)
+import Network.RemoteData (RemoteData(..))
+import Web.UIEvent.MouseEvent (MouseEvent)
+
+type Input = String
+
+type State =
+  { block :: RemoteData String Block
+  , network :: ZcashNet
+  , blid :: Input
+  }
+
+data Action
+  = Initialize
+  | Receive (Connected ZcashNet Input)
+  | Close MouseEvent
+
+component :: forall q o m . MonadAff m => MonadStore S.Action S.Store m => Navigate m => H.Component q Input o m
+component = connect (selectEq _.network) $
+  H.mkComponent
+    { initialState
+    , render
+    , eval: H.mkEval $ H.defaultEval
+      { handleAction = handleAction
+      , receive = Just <<< Receive
+      , initialize = Just Initialize
+      }
+    }
+  where
+    initialState :: Connected ZcashNet Input -> State
+    initialState { context: net, input: blid} =
+      { block: NotAsked
+      , network: net
+      , blid: blid
+      }
+
+render :: forall cs m. State -> H.ComponentHTML Action cs m
+render state =
+  HH.div
+    [ css "bigcard"
+    ]
+    [ HH.h1_ [ HH.text "exblo"]
+    , case state.block of
+          NotAsked -> HH.p_ [ HH.text "Explore the Zcash blockchain" ]
+          Loading -> HH.p_ [ HH.text "Processing Zebra response..." ]
+          Failure e ->
+            HH.div
+              [ css "card" ]
+              [ HH.p_ [ HH.text e ]
+              , HH.button
+                [ css "btn-primary raised"
+                , HE.onClick \ev -> Close ev
+                ]
+                [ HH.text "Back"
+                , HH.i [ css "ri-arrow-go-back-fill ri-lg" ] []
+                ]
+              ]
+          Success b ->
+            HH.div
+              [ css "card" ]
+              [ HH.table_
+                [ HH.tr_ [ HH.th_ [ HH.text "hash" ], HH.td_ [ HH.text b.hash ] ]
+                , HH.tr_ [ HH.th_ [ HH.text "mined" ], HH.td_ [ HH.text $ convertToDate b.time ] ]
+                , HH.tr_ [ HH.th_ [ HH.text "height" ], HH.td_ [ HH.text $ show b.height ] ]
+                , HH.tr_ [ HH.th_ [ HH.text "confirmations" ], HH.td_ [ HH.text $ show b.confirmations ] ]
+                , HH.tr_ [ HH.th_ [ HH.text "txs" ]
+                                  , HH.td_ (map (\txid -> HH.p_ [ HH.a [ safeHref $ Tx txid ] [HH.text txid]] ) b.tx)]
+                ]
+              , HH.button
+                [ css "btn-primary raised"
+                , HE.onClick \ev -> Close ev
+                ]
+                [ HH.text "Back"
+                , HH.i [ css "ri-arrow-go-back-fill ri-lg" ] []
+                ]
+              ]
+    , HH.p_
+        [ HH.i [ css "ri-copyright-line" ] []
+        , HH.text "2024 Vergara Technologies LLC"
+        ]
+    ]
+
+handleAction :: forall cs o m. MonadAff m => Navigate m => Action -> H.HalogenM State Action cs o m Unit
+handleAction = case _ of
+  Initialize -> do
+     H.modify_ _ { block = Loading }
+     term <- H.gets _.blid
+     res <- H.liftAff $ AX.get AXRF.string ("https://api.exblo.app/getblockinfo/" <> term)
+     case res of
+         Left err -> do
+            H.modify_ _ { block = Failure $ AX.printError err }
+         Right response -> do
+            case response.status of
+                StatusCode 200 -> do
+                   case readJSON response.body of
+                       Right (b :: Block) ->
+                         H.modify_ _ { block = Success b }
+                       Left e -> H.modify_ _ { block = Failure $ show e }
+                _any -> H.modify_ _ { block = Failure "Invalid block identifier" }
+  Receive {context: network, input: bl } -> do
+     st <- H.get
+     if (st.blid /= bl) then do
+       H.modify_ _ { blid = bl, network = network }
+       handleAction Initialize
+     else
+       H.modify_ _ { network = network }
+  Close _e -> navigate Home

src/Exblo/Home.purs

@@ -7,16 +7,12 @@ import Affjax.Web as AX
 import Affjax.ResponseFormat as AXRF
 import Data.Maybe (Maybe(..))
 import Data.Either (Either(..))
-import Data.Int (toNumber)
-import Data.Nullable (Nullable, toMaybe)
-import Data.Array (length, foldl)
-import Data.Formatter.DateTime as FDT
-import Data.DateTime.Instant (toDateTime, instant)
-import Effect.Aff (Milliseconds(..))
+import Data.String.CodeUnits as SC
 import Effect.Aff as Aff
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class.Console (log)
-import Exblo.API (ZcashNet(..), Transaction(..), sumBundles)
+import Effect.Aff (Milliseconds(..))
+import Exblo.API (ZcashNet(..))
 import Exblo.Navigate (class Navigate, navigate, Route(..))
 import Exblo.Utils (css)
 import Exblo.Store as S
@@ -82,7 +78,7 @@ render state =
             [ HH.input
                 [ css "input"
                 , HP.value state.term
-                , HP.placeholder "Search TX ID..."
+                , HP.placeholder "TX ID/Block height..."
                 , HE.onValueInput \str -> SetTerm str
                 ]
             , HH.button
@@ -121,7 +117,7 @@ render state =
             , HH.text "Server: "
             , HH.text state.version
             , HH.br_
-            , HH.text "UI: 0.2.0.1"
+            , HH.text "UI: 0.3.0.0"
             , HH.br_
             , HH.text "Zebra Node: "
             , HH.text state.zebra
@@ -161,16 +157,9 @@ handleAction = case _ of
   Search event -> do
     H.liftEffect $ Event.preventDefault event
     term <- H.gets _.term
-    navigate $ Tx term
-
-convertToDate :: Int -> String
-convertToDate secs =
-  case instant (Milliseconds (toNumber (1000 * secs))) of
-    Nothing -> "N/A"
-    Just i ->
-      case (FDT.formatDateTime "YYYY-DD-MM HH:mm:ss:SSS" <<< toDateTime) i of
-        Left _e -> "N/A"
-        Right d -> d
+    if (SC.length term /= 64)
+      then navigate $ Blk term
+      else navigate $ Tx term
 
 timer :: forall m a. MonadAff m => a -> m (HS.Emitter a)
 timer val = do

src/Exblo/Navigate.purs

@@ -20,6 +20,7 @@ instance navigateHalogenM :: Navigate m => Navigate (HalogenM st act slots msg m
 data Route
   = Home
   | Tx String
+  | Blk String
 
 derive instance genericRoute :: Generic Route _
 derive instance eqRoute :: Eq Route
@@ -29,6 +30,7 @@ routeCodec :: RouteDuplex' Route
 routeCodec = root $ sum
   { "Home": noArgs
   , "Tx": "tx" / segment
+  , "Blk": "block" / segment
   }
 
 safeHref :: forall r i. Route -> HH.IProp (href :: String | r) i

src/Exblo/Router.purs

@@ -1,7 +1,6 @@
 module Exblo.Router where
 
 import Prelude
-import Data.Codec.Argonaut as CA
 import Data.Argonaut.Decode (decodeJson, parseJson)
 import Affjax.Web as AX
 import Affjax.ResponseFormat as AXRF
@@ -9,11 +8,12 @@ import Data.Either (hush, Either(..))
 import Data.Maybe (Maybe(..), fromMaybe)
 import Effect.Class.Console (log)
 import Effect.Aff.Class (class MonadAff)
-import Exblo.API (ExbloInfo(..))
+import Exblo.API (ExbloInfo)
 import Exblo.Home as Home
 import Exblo.Navigate (class Navigate, navigate, Route(..), routeCodec)
 import Exblo.Store as S
 import Exblo.Tx as Tx
+import Exblo.Block as Block
 import Exblo.Utils (OpaqueSlot)
 import Halogen as H
 import Halogen.HTML as HH
@@ -24,7 +24,6 @@ import Routing.Duplex (parse)
 import Routing.Hash (getHash)
 import Type.Proxy (Proxy(..))
 
-
 data Query a = Navigate Route a
 
 type State =
@@ -38,31 +37,33 @@ data Action
 type ChildSlots =
   ( home :: OpaqueSlot Unit
   , transaction :: OpaqueSlot Unit
+  , block :: OpaqueSlot Unit
   )
 
 deriveState :: Connected S.Store Unit -> State
-deriveState { context: store} = { route: Nothing }
+deriveState { context: store } = { route: Just Home }
 
 component :: forall m. MonadAff m => Navigate m => MonadStore S.Action S.Store m => H.Component Query Unit Void m
 component = connect selectAll $ H.mkComponent
   { initialState: deriveState
   , render: render
   , eval: H.mkEval $ H.defaultEval
-    { handleAction = handleAction
-    , handleQuery = handleQuery
-    , receive = Just <<< Receive
-    , initialize = Just Initialize
-    }
+      { handleAction = handleAction
+      , handleQuery = handleQuery
+      , receive = Just <<< Receive
+      , initialize = Just Initialize
+      }
   }
 
-render :: forall m. MonadAff m => MonadStore S.Action S.Store m => Navigate m =>State -> H.ComponentHTML Action ChildSlots m
+render :: forall m. MonadAff m => MonadStore S.Action S.Store m => Navigate m => State -> H.ComponentHTML Action ChildSlots m
 render { route } =
   case route of
-      Just r -> 
-        case r of
-            Home -> HH.slot_ (Proxy :: _ "home") unit Home.component unit
-            Tx hex -> HH.slot_ (Proxy :: _ "transaction") unit Tx.component hex
-      Nothing -> HH.div_ [ HH.text "Page not found." ]
+    Just r ->
+      case r of
+        Home -> HH.slot_ (Proxy :: _ "home") unit Home.component unit
+        Tx hex -> HH.slot_ (Proxy :: _ "transaction") unit Tx.component hex
+        Blk id -> HH.slot_ (Proxy :: _ "block") unit Block.component id
+    Nothing -> HH.div_ [ HH.text "Page not found." ]
 
 handleAction :: forall m. MonadAff m => Navigate m => MonadStore S.Action S.Store m => Action -> H.HalogenM State Action ChildSlots Void m Unit
 handleAction = case _ of
@@ -70,13 +71,13 @@ handleAction = case _ of
     s <- getStore
     res <- H.liftAff $ AX.get AXRF.string (s.baseUrl <> "/getinfo")
     case res of
-        Left err -> do
-           log $ "/getinfo response failed " <> AX.printError err
-        Right response -> do
-           case decodeJson =<< parseJson response.body of
-               Right (x :: ExbloInfo) -> do
-                 updateStore $ S.SetInfo x
-               Left e1 -> log $ "/getinfo JSON decode failed " <> show e1
+      Left err -> do
+        log $ "/getinfo response failed " <> AX.printError err
+      Right response -> do
+        case decodeJson =<< parseJson response.body of
+          Right (x :: ExbloInfo) -> do
+            updateStore $ S.SetInfo x
+          Left e1 -> log $ "/getinfo JSON decode failed " <> show e1
     initialRoute <- hush <<< (parse routeCodec) <$> H.liftEffect getHash
     navigate $ fromMaybe Home initialRoute
   Receive { context: baseUrl } -> pure unit
@@ -84,8 +85,8 @@ handleAction = case _ of
 handleQuery :: forall a m. Query a -> H.HalogenM State Action ChildSlots Void m (Maybe a)
 handleQuery = case _ of
   Navigate dest a -> do
-     { route } <- H.get
-     when (route /= Just dest) do
-        H.modify_ _ { route = Just dest }
-     pure (Just a)
+    { route } <- H.get
+    when (route /= Just dest) do
+      H.modify_ _ { route = Just dest }
+    pure (Just a)
 

src/Exblo/Tx.purs

@@ -14,7 +14,7 @@ import Effect.Aff.Class (class MonadAff)
 import Exblo.API (Transaction(..), ZcashNet, sumBundles)
 import Exblo.Navigate (class Navigate, navigate, Route(..))
 import Exblo.Store as S
-import Exblo.Utils (css)
+import Exblo.Utils (css, safeHref)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
@@ -83,7 +83,7 @@ render state =
             [ css "card" ]
             [ HH.table_
                 [ HH.tr_ [ HH.th_ [ HH.text "tx id" ], HH.td_ [ HH.text t.txid ] ]
-                , HH.tr_ [ HH.th_ [ HH.text "block" ], HH.td_ [ HH.text (show t.height) ] ]
+                , HH.tr_ [ HH.th_ [ HH.text "block" ], HH.td_ [ HH.a [ safeHref $ Blk $ show t.height] [ HH.text (show t.height) ] ] ]
                 , HH.tr_ [ HH.th_ [ HH.text "confirmations" ], HH.td_ [ HH.text (show t.confirmations) ] ]
                 , HH.tr_ [ HH.th_ [ HH.text "expiry" ], HH.td_ [ HH.text (show t.expiry) ] ]
                 , HH.tr_ [ HH.th_ [ HH.text "fee" ], HH.td_ [ HH.text (show $ sumBundles t.transparent t.sapling t.orchard) ] ]
@@ -152,8 +152,8 @@ render state =
               [ css "btn-primary raised"
               , HE.onClick \ev -> Close ev
               ]
-              [ HH.i [ css "ri-arrow-go-back-fill ri-lg" ] []
-              , HH.text "Back"
+              [ HH.text "Back"
+              , HH.i [ css "ri-arrow-go-back-fill ri-lg" ] []
               ]
             ]
     , HH.p_
@@ -178,8 +178,10 @@ handleAction = case _ of
                  case readJSON response.body of
                      Right (t :: Transaction) ->
                        H.modify_ _ { tx = Success t}
-                     Left e -> H.modify_ _ { tx = Failure $ show e }
-               _any -> H.modify_ _ { tx = Failure "Invalid transaction identifier" }
+                     Left e ->
+                        H.modify_ _ { tx = Failure $ show e }
+               _any -> do
+                  H.modify_ _ { tx = Failure "Invalid transaction identifier" }
   Receive {context: network, input: hex } -> do
      st <- H.get
      if (st.hex /= hex) then do

src/Exblo/Utils.purs

@@ -2,6 +2,14 @@ module Exblo.Utils where
 
 import Prelude
 
+import Data.DateTime.Instant (toDateTime, instant)
+import Data.Time.Duration (Seconds(..), convertDuration)
+import Data.Either (Either(..))
+import Data.Formatter.DateTime as FDT
+import Data.Int (toNumber)
+import Data.Maybe (Maybe(..))
+import Exblo.Navigate (Route, routeCodec)
+import Routing.Duplex (print)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
@@ -10,3 +18,15 @@ type OpaqueSlot slot = forall query. H.Slot query Void slot
 
 css :: forall r i. String -> HH.IProp (class :: String | r) i
 css = HP.class_ <<< HH.ClassName
+
+convertToDate :: Int -> String
+convertToDate secs =
+  case instant (convertDuration $ Seconds (toNumber secs)) of
+    Nothing -> "N/A"
+    Just i ->
+      case (FDT.formatDateTime "YYYY-MM-DD HH:mm:ss" <<< toDateTime) i of
+        Left _e -> "N/A"
+        Right d -> d
+
+safeHref :: forall r i. Route -> HH.IProp (href :: String | r) i
+safeHref = HP.href <<< append "#" <<< print routeCodec