feat: implement router and components

CHANGELOG.md

@@ -5,6 +5,11 @@ 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.2.0.0]
+
+- Implemented routing
+- Separated the Tx information to a new page, accessible via URL
+
 ## [0.1.0.0]
 
 ### Added

dev/main.css

@@ -143,3 +143,14 @@ h4 {
 h5 {
 	font-family: 'F25Executive', serif;
 }
+
+table.footer {
+	margin: auto;
+	width: 90%;
+	text-align: center;
+	font-size: 12px;
+}
+
+td.footer {
+	text-align: center;
+}

package.json

@@ -11,6 +11,6 @@
     "bundle": "spago bundle-app --to dev/app.js",
     "test": "spago test",
     "serve": "spago build && parcel serve --open --no-cache --dist-dir dist/ dev/index.html",
-    "build-prod": "rm -rf dist && mkdir -p dist && cp dev/index.html dist/ && spago bundle-app --to dist/app.js && parcel build prod/index.html"
+    "build-prod": "rm -rf dist && mkdir -p dist && cp dev/index.html dist/ && spago bundle-app --to dist/app.js && parcel build dist/index.html"
   }
 }

spago.dhall

@@ -11,25 +11,34 @@ When creating a new Spago project, you can use
 to generate this file without the comments in this block.
 -}
 { name = "exblo-app"
-, dependencies = 
+, dependencies =
   [ "aff"
   , "affjax"
-  , "simple-json"
   , "affjax-web"
-  , "console"
-  , "tailrec"
-  , "nullable"
-  , "integers"
-  , "datetime"
-  , "formatters"
+  , "argonaut-codecs"
   , "arrays"
+  , "codec-argonaut"
+  , "console"
+  , "datetime"
   , "effect"
   , "either"
+  , "formatters"
   , "halogen"
+  , "halogen-store"
   , "halogen-subscriptions"
+  , "integers"
   , "maybe"
+  , "nullable"
   , "prelude"
+  , "remotedata"
+  , "routing"
+  , "routing-duplex"
+  , "safe-coerce"
+  , "simple-json"
+  , "tailrec"
+  , "transformers"
   , "web-events"
+  , "web-uievents"
   ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs", "test/**/*.purs" ]

src/Exblo/API.purs

@@ -0,0 +1,135 @@
+module Exblo.API where
+
+import Prelude
+import Data.Nullable (Nullable, toMaybe)
+import Data.Either (note)
+import Data.Argonaut.Decode
+import Data.Maybe (Maybe(..))
+
+data ZcashNet
+  = MainNet
+  | TestNet
+
+derive instance eqZcashNet :: Eq ZcashNet
+
+zcashNetFromString :: String -> Maybe ZcashNet
+zcashNetFromString = case _ of
+  "MainNet" -> Just MainNet
+  "TestNet" -> Just TestNet
+  _ -> Nothing
+
+zcashNetToString :: ZcashNet -> String
+zcashNetToString = case _ of
+  MainNet -> "MainNet"
+  TestNet -> "TestNet"
+
+instance showZcashNet :: Show ZcashNet where
+  show = zcashNetToString
+
+instance decodeJsonZcashNet :: DecodeJson ZcashNet where
+  decodeJson json = do
+     string <- decodeJson json
+     note (TypeMismatch "ZcashNet") (zcashNetFromString string)
+
+newtype ExbloInfo = ExbloInfo
+  { net :: ZcashNet
+  , version :: String
+  , zebra :: String
+  }
+
+instance decodeJsonExbloInfo :: DecodeJson ExbloInfo where
+  decodeJson json = do
+     obj <- decodeJson json
+     net <- obj .: "net" .!= TestNet
+     version <- obj .: "version"
+     zebra <- obj .: "zebra"
+     pure $ ExbloInfo { net, version, zebra}
+
+type Transaction =
+  { txid :: String
+  , height :: Int
+  , confirmations :: Int
+  , expiry :: Int
+  , transparent :: Nullable TBundle
+  , sapling :: Nullable SBundle
+  , orchard :: Nullable OBundle
+  }
+
+type TBundle =
+  { vin :: Array TxIn
+  , vout :: Array TxOut
+  , coinbase :: Boolean
+  }
+
+type TxIn =
+  { prevoutput :: OutPoint
+  , inputscript :: String
+  , sequence :: Number
+  }
+
+type OutPoint =
+  { txid :: String
+  , index :: Number
+  }
+
+type TxOut =
+  { value :: Int
+  , outputscript :: String
+  }
+
+type SBundle =
+  { spends :: Array ShieldedSpend
+  , outputs :: Array ShieldedOutput
+  , value :: Int
+  , sig :: String
+  }
+
+type ShieldedSpend =
+  { cv :: String
+  , anchor :: String
+  , nullifier :: String
+  , rk :: String
+  , proof :: String
+  , spendAuthSig :: String
+  }
+
+type ShieldedOutput =
+  { cv :: String
+  , cmu :: String
+  , ephemeralKey :: String
+  , encCiphertext :: String
+  , outCiphertext :: String
+  , proof :: String
+  }
+
+type OBundle =
+  { actions :: Array OrchardAction
+  , flags :: Array Boolean
+  , value :: Int
+  , anchor :: String
+  , proof :: String
+  , sig :: String
+  }
+
+type OrchardAction =
+  { nullifier :: String
+  , rk :: String
+  , cmx :: String
+  , ephemeralKey :: String
+  , encCiphertext :: String
+  , outCiphertext :: String
+  , cv :: String
+  , spendAuthSig :: String
+  }
+
+sumBundles :: Nullable TBundle -> Nullable SBundle -> Nullable OBundle -> Int
+sumBundles t s o =
+  ( case toMaybe o of
+      Nothing -> 0
+      Just orc -> orc.value
+  )
+    +
+      ( case toMaybe s of
+          Nothing -> 0
+          Just sap -> sap.value
+      )

src/Exblo/AppM.purs

@@ -0,0 +1,33 @@
+module Exblo.AppM where
+
+import Prelude
+
+import Exblo.Store as Store
+import Exblo.Navigate (class Navigate, routeCodec, Route(..), navigate)
+import Effect.Aff (Aff)
+import Effect.Aff.Class (class MonadAff)
+import Effect.Class (class MonadEffect, liftEffect)
+import Halogen as H
+import Halogen.Store.Monad (class MonadStore, StoreT, getStore, runStoreT, updateStore)
+import Routing.Hash (setHash)
+import Routing.Duplex (print)
+import Safe.Coerce (coerce)
+
+newtype AppM a = AppM (StoreT Store.Action Store.Store Aff a)
+
+runAppM :: forall q i o. Store.Store -> H.Component q i o AppM -> Aff (H.Component q i o Aff)
+runAppM store = runStoreT store Store.reduce <<< coerce
+
+derive newtype instance functorAppM :: Functor AppM
+
+derive newtype instance applyAppM :: Apply AppM
+derive newtype instance applicativeAppM :: Applicative AppM
+derive newtype instance bindAppM :: Bind AppM
+derive newtype instance monadAppM :: Monad AppM
+derive newtype instance monadEffectAppM :: MonadEffect AppM
+derive newtype instance monadAffAppM :: MonadAff AppM
+derive newtype instance monadStoreAppM :: MonadStore Store.Action Store.Store AppM
+
+instance navigateAppM :: Navigate AppM where
+  navigate =
+    liftEffect <<< setHash <<< print routeCodec

src/Exblo/Home.purs

@@ -0,0 +1,180 @@
+module Exblo.Home where
+
+import Prelude
+import Control.Monad.Rec.Class (forever)
+import Simple.JSON (readJSON)
+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 Effect.Aff as Aff
+import Effect.Aff.Class (class MonadAff)
+import Effect.Class.Console (log)
+import Exblo.API (ZcashNet(..), Transaction(..), sumBundles)
+import Exblo.Navigate (class Navigate, navigate, Route(..))
+import Exblo.Utils (css)
+import Exblo.Store as S
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+import Halogen.Subscription as HS
+import Halogen.Store.Monad (class MonadStore, getStore)
+import Halogen.Store.Select (selectAll)
+import Halogen.Store.Connect (Connected, connect)
+import Web.Event.Event (Event)
+import Web.Event.Event as Event
+import Network.RemoteData (RemoteData(..))
+
+type Input = Unit
+
+type State =
+  { block :: RemoteData String Int
+  , term :: String
+  , network :: ZcashNet
+  , zebra :: String
+  , version :: String
+  }
+
+data Action
+  = Initialize
+  | Refresh
+  | Receive (Connected S.Store Input)
+  | Search Event
+  | SetTerm String
+
+component :: forall q o m. MonadAff m => MonadStore S.Action S.Store m => Navigate m => H.Component q Input o m
+component = connect selectAll $
+  H.mkComponent
+    { initialState: \_ -> { block: NotAsked, term: "", network: TestNet, zebra: "", version: "" }
+    , render
+    , eval: H.mkEval H.defaultEval { handleAction = handleAction, receive = Just <<< Receive, initialize = Just Initialize }
+    }
+
+render :: forall cs m. State -> H.ComponentHTML Action cs m
+render state =
+  HH.div
+    [ css "bigcard"
+    ]
+    [ HH.h1_ [ HH.text "exblo" ]
+    , HH.div
+        [ css "card"
+        ]
+        [ HH.h3_ [ HH.text "latest block" ]
+        , HH.p_
+            [ HH.text $
+                case state.block of
+                  NotAsked -> "N/A"
+                  Loading -> "Loading"
+                  Failure e -> e
+                  Success b -> show b
+            ]
+        ]
+    , HH.form
+        [ HE.onSubmit \ev -> Search ev ]
+        [ HH.p_
+            [ HH.input
+                [ css "input"
+                , HP.value state.term
+                , HP.placeholder "Search TX ID..."
+                , HE.onValueInput \str -> SetTerm str
+                ]
+            , HH.button
+                [ css "btn-primary raised"
+                , HP.type_ HP.ButtonSubmit
+                ]
+                [ HH.i [ css "ri-search-line ri-xl" ] [] ]
+            ]
+        ]
+    , HH.table
+      [ css "footer" ]
+      [ HH.tr_
+        [ HH.td
+          [ css "footer" ]
+          [ HH.p_
+            [ HH.text "Made with "
+            , HH.a
+              [ HP.href "https://www.purescript.org/"]
+              [ HH.text "PureScript" ]
+            ]
+          ]
+        , HH.td
+          [ css "footer" ]
+          [ HH.p_
+            [ HH.i [ css "ri-copyright-line" ] []
+            , HH.text "2024 Vergara Technologies LLC"
+            ]
+          ]
+        , HH.td
+          [ css "footer" ]
+          [ HH.p
+            []
+            [ HH.text "Network: "
+            , HH.text $ show state.network
+            , HH.br_
+            , HH.text "Version: "
+            , HH.text state.version
+            , HH.br_
+            , HH.text "Zebra Node: "
+            , HH.text state.zebra
+            ]
+          ]
+        ]
+      ]
+    ]
+
+handleAction :: forall cs o m. MonadAff m => Navigate m => MonadStore S.Action S.Store m => Action -> H.HalogenM State Action cs o m Unit
+handleAction = case _ of
+  Initialize -> do
+    _ <- H.subscribe =<< timer Refresh
+    st <- getStore
+    H.modify_ _ {network = st.network, zebra = st.zebraVersion, version = st.version }
+    handleAction Refresh
+  Refresh -> do
+    H.modify_ _ { block = Loading }
+    res <- H.liftAff $ AX.get AXRF.string ("https://api.exblo.app/getblock")
+    case res of
+      Left err -> do
+        log $ "/block response failed to decode: " <> AX.printError err
+      Right response -> do
+        case readJSON response.body of
+          Right (i :: Int) ->
+            H.modify_ _
+              { block = Success i
+              }
+          Left e -> do
+            log $ "Can't parse JSON. " <> show e
+            H.modify_ _
+              { block = Failure "Failed to parse response" }
+  SetTerm s -> do
+    H.modify_ _ { term = s }
+  Receive {context: store, input: inp } -> do
+     H.modify_ _ { network = store.network, zebra = store.zebraVersion, version = store.version }
+  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
+
+timer :: forall m a. MonadAff m => a -> m (HS.Emitter a)
+timer val = do
+  { emitter, listener } <- H.liftEffect HS.create
+  _ <- H.liftAff $ Aff.forkAff $ forever do
+    Aff.delay $ Milliseconds 60000.0
+    H.liftEffect $ HS.notify listener val
+  pure emitter
+

src/Exblo/Navigate.purs

@@ -0,0 +1,35 @@
+module Exblo.Navigate where
+
+import Prelude hiding ((/))
+import Control.Monad.Trans.Class (lift)
+import Data.Generic.Rep (class Generic)
+import Routing.Duplex (RouteDuplex', root, segment, print)
+import Routing.Duplex.Generic (noArgs, sum)
+import Routing.Duplex.Generic.Syntax ((/))
+import Halogen (HalogenM)
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+class Monad m <= Navigate m where
+  navigate :: Route -> m Unit
+
+-- | This instance lets us avoid having to use `lift` when we use these functions in a component.
+instance navigateHalogenM :: Navigate m => Navigate (HalogenM st act slots msg m) where
+  navigate = lift <<< navigate
+
+data Route
+  = Home
+  | Tx String
+
+derive instance genericRoute :: Generic Route _
+derive instance eqRoute :: Eq Route
+derive instance ordRoute :: Ord Route
+
+routeCodec :: RouteDuplex' Route
+routeCodec = root $ sum
+  { "Home": noArgs
+  , "Tx": "tx" / segment
+  }
+
+safeHref :: forall r i. Route -> HH.IProp (href :: String | r) i
+safeHref = HP.href <<< append "#" <<< print routeCodec

src/Exblo/Router.purs

@@ -0,0 +1,91 @@
+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
+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.Home as Home
+import Exblo.Navigate (class Navigate, navigate, Route(..), routeCodec)
+import Exblo.Store as S
+import Exblo.Tx as Tx
+import Exblo.Utils (OpaqueSlot)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.Store.Connect (Connected, connect)
+import Halogen.Store.Monad (class MonadStore, getStore, updateStore)
+import Halogen.Store.Select (selectAll)
+import Routing.Duplex (parse)
+import Routing.Hash (getHash)
+import Type.Proxy (Proxy(..))
+
+
+data Query a = Navigate Route a
+
+type State =
+  { route :: Maybe Route
+  }
+
+data Action
+  = Initialize
+  | Receive (Connected S.Store Unit)
+
+type ChildSlots =
+  ( home :: OpaqueSlot Unit
+  , transaction :: OpaqueSlot Unit
+  )
+
+deriveState :: Connected S.Store Unit -> State
+deriveState { context: store} = { route: Nothing }
+
+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
+    }
+  }
+
+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." ]
+
+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
+  Initialize -> do
+    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
+    initialRoute <- hush <<< (parse routeCodec) <$> H.liftEffect getHash
+    navigate $ fromMaybe Home initialRoute
+  Receive { context: baseUrl } -> pure unit
+
+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)
+

src/Exblo/Store.purs

@@ -0,0 +1,26 @@
+module Exblo.Store where
+
+import Prelude
+import Exblo.API (ZcashNet, ExbloInfo(..))
+
+data LogLevel = Dev | Prod
+
+derive instance eqLogLevel :: Eq LogLevel
+derive instance ordLogLevel :: Ord LogLevel
+
+type Store =
+  { logLevel :: LogLevel
+  , baseUrl :: String
+  , network :: ZcashNet
+  , zebraVersion :: String
+  , version :: String
+  }
+
+data Action
+  = SetInfo ExbloInfo
+  | Logout
+
+reduce :: Store -> Action -> Store
+reduce store = case _ of
+  SetInfo (ExbloInfo {net, version, zebra}) -> store { network = net, zebraVersion = zebra, version = version }
+  Logout -> store

src/Exblo/Tx.purs

@@ -0,0 +1,175 @@
+module Exblo.Tx where
+
+import Prelude
+
+import Simple.JSON (readJSON)
+import Affjax.Web as AX
+import Affjax.ResponseFormat as AXRF
+import Data.Array (length, foldl)
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Either (Either(..), hush)
+import Data.Nullable (Nullable, toMaybe)
+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 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.Event.Event (Event)
+import Web.UIEvent.MouseEvent (MouseEvent)
+
+type Input = String
+
+type State =
+  { tx :: RemoteData String Transaction
+  , network :: ZcashNet
+  , hex :: 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: hex} =
+      { tx: NotAsked
+      , network: net
+      , hex: hex
+      }
+
+render :: forall cs m. State -> H.ComponentHTML Action cs m
+render state =
+  HH.div
+    [ css "bigcard"
+    ]
+    [ HH.h1_ [ HH.text "exblo" ]
+    , case state.tx of
+        NotAsked -> HH.p_ [ HH.text "Explore the Zcash blockchain" ]
+        Loading -> HH.p_ [ HH.text "Processing Zebra response..." ]
+        Failure e -> HH.p_ [ HH.text e ]
+        Success t ->
+          HH.div
+            [ 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 "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) ] ]
+                , case toMaybe t.orchard of
+                    Nothing -> HH.p_ []
+                    Just orc ->
+                      HH.tr_
+                        [ HH.th_ [ HH.text "orchard" ]
+                        , HH.table_
+                            [ HH.tr_
+                                [ HH.th_ [ HH.text "actions" ]
+                                , HH.td_ [ HH.text (show $ length orc.actions) ]
+                                ]
+                            , HH.tr_
+                                [ HH.th_ [ HH.text "value" ]
+                                , HH.td_ [ HH.text (show orc.value) ]
+                                ]
+                            ]
+                        ]
+                , case toMaybe t.sapling of
+                    Nothing -> HH.p_ []
+                    Just sap ->
+                      HH.tr_
+                        [ HH.th_ [ HH.text "sapling" ]
+                        , HH.table_
+                            [ HH.tr_
+                                [ HH.th_ [ HH.text "spends" ]
+                                , HH.td_ [ HH.text (show $ length sap.spends) ]
+                                ]
+                            , HH.tr_
+                                [ HH.th_ [ HH.text "outputs" ]
+                                , HH.td_ [ HH.text (show $ length sap.outputs) ]
+                                ]
+                            , HH.tr_
+                                [ HH.th_ [ HH.text "value" ]
+                                , HH.td_ [ HH.text (show $ sap.value) ]
+                                ]
+                            ]
+                        ]
+                , case toMaybe t.transparent of
+                    Nothing -> HH.p_ []
+                    Just transp ->
+                      HH.tr_
+                        [ HH.th_
+                            [ HH.text "transparent"
+                            , if transp.coinbase then HH.i [ css "ri-money-dollar-circle-line ri-xl" ] []
+                              else HH.p_ []
+                            ]
+                        , HH.table_
+                            [ HH.tr_
+                                [ HH.th_ [ HH.text "inputs" ]
+                                , HH.td_ [ HH.text (show $ length transp.vin) ]
+                                ]
+                            , HH.tr_
+                                [ HH.th_ [ HH.text "outputs" ]
+                                , HH.td_ [ HH.text (show $ length transp.vout) ]
+                                ]
+                            , HH.tr_
+                                [ HH.th_ [ HH.text "value" ]
+                                , HH.td_ [ HH.text (show $ foldl (\a b -> a + b.value) 0 transp.vout) ]
+                                ]
+                            ]
+                        ]
+                ]
+            , HH.button
+              [ css "btn-primary raised"
+              , HE.onClick \ev -> Close ev
+              ]
+              [ HH.i [ css "ri-arrow-go-back-fill ri-lg" ] []
+              , HH.text "Back"
+              ]
+            ]
+    , 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_ _ { tx = Loading }
+    term <- H.gets _.hex
+    res <- H.liftAff $ AX.get AXRF.string ("https://api.exblo.app/gettransaction/" <> term)
+    case res of
+        Left err -> do
+           H.modify_ _ { tx = Failure $ AX.printError err }
+        Right response -> do
+           case readJSON response.body of
+               Right (t :: Transaction) ->
+                 H.modify_ _ { tx = Success t}
+               Left e -> H.modify_ _ { tx = Failure $ show e }
+  Receive {context: network, input: hex } -> do
+     st <- H.get
+     if (st.hex /= hex) then do
+       H.modify_ _ { hex = hex, network = network }
+       handleAction Initialize
+     else
+       H.modify_ _ { network = network }
+  Close e -> navigate Home

src/Exblo/UI.purs

@@ -1,309 +0,0 @@
-module Exblo.UI where
-
-import Prelude
-import Control.Monad.Rec.Class (forever)
-import Simple.JSON (readJSON)
-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 Effect.Aff as Aff
-import Effect.Aff.Class (class MonadAff)
-import Effect.Class.Console (log)
-import Halogen as H
-import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Halogen.Subscription as HS
-import Web.Event.Event (Event)
-import Web.Event.Event as Event
-
-type Transaction =
-  { txid :: String
-  , height :: Int
-  , confirmations :: Int
-  , expiry :: Int
-  , transparent :: Nullable TBundle
-  , sapling :: Nullable SBundle
-  , orchard :: Nullable OBundle
-  }
-
-type TBundle =
-  { vin :: Array TxIn
-  , vout :: Array TxOut
-  , coinbase :: Boolean
-  }
-
-type TxIn =
-  { prevoutput :: OutPoint
-  , inputscript :: String
-  , sequence :: Number
-  }
-
-type OutPoint =
-  { txid :: String
-  , index :: Number
-  }
-
-type TxOut =
-  { value :: Int
-  , outputscript :: String
-  }
-
-type SBundle =
-  { spends :: Array ShieldedSpend
-  , outputs :: Array ShieldedOutput
-  , value :: Int
-  , sig :: String
-  }
-
-type ShieldedSpend =
-  { cv :: String
-  , anchor :: String
-  , nullifier :: String
-  , rk :: String
-  , proof :: String
-  , spendAuthSig :: String
-  }
-
-type ShieldedOutput =
-  { cv :: String
-  , cmu :: String
-  , ephemeralKey :: String
-  , encCiphertext :: String
-  , outCiphertext :: String
-  , proof :: String
-  }
-
-type OBundle =
-  { actions :: Array OrchardAction
-  , flags :: Array Boolean
-  , value :: Int
-  , anchor :: String
-  , proof :: String
-  , sig :: String
-  }
-
-type OrchardAction =
-  { nullifier :: String
-  , rk :: String
-  , cmx :: String
-  , ephemeralKey :: String
-  , encCiphertext :: String
-  , outCiphertext :: String
-  , cv :: String
-  , spendAuthSig :: String
-  }
-
-type State =
-  { block :: Maybe Int
-  , loading :: Boolean
-  , term :: String
-  , tx :: Maybe Transaction
-  }
-
-data Action
-  = Initialize
-  | Refresh
-  | Search Event
-  | SetTerm String
-
-component :: forall q i o m. MonadAff m => H.Component q i o m
-component =
-  H.mkComponent
-    { initialState: \_ -> { block: Nothing, loading: false, term: "", tx: Nothing }
-    , render
-    , eval: H.mkEval H.defaultEval { handleAction = handleAction, initialize = Just Initialize }
-    }
-
-render :: forall cs m. State -> H.ComponentHTML Action cs m
-render state =
-  HH.div
-    [ css "bigcard"
-    ]
-    [ HH.h1_ [ HH.text "exblo" ]
-    , HH.div
-        [ css "card"
-        ]
-        [ HH.h3_ [ HH.text "latest block" ]
-        , HH.p_
-            [ HH.text $
-                if state.loading then "Loading..."
-                else case state.block of
-                  Nothing -> "N/A"
-                  Just b -> show b
-            ]
-        ]
-    , HH.form
-        [ HE.onSubmit \ev -> Search ev ]
-        [ HH.p_
-            [ HH.input
-                [ css "input"
-                , HP.value state.term
-                , HP.placeholder "Search TX ID..."
-                , HE.onValueInput \str -> SetTerm str
-                ]
-            , HH.button
-                [ css "btn-primary raised"
-                , HP.type_ HP.ButtonSubmit
-                ]
-                [ HH.i [ css "ri-search-line ri-xl" ] [] ]
-            ]
-        ]
-    , case state.tx of
-        Nothing -> HH.p_ [ HH.text "Explore the Zcash blockchain" ]
-        Just t ->
-          HH.div
-            [ 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 "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) ] ]
-                , case toMaybe t.orchard of
-                    Nothing -> HH.p_ []
-                    Just orc ->
-                      HH.tr_
-                        [ HH.th_ [ HH.text "orchard" ]
-                        , HH.table_
-                            [ HH.tr_
-                                [ HH.th_ [ HH.text "actions" ]
-                                , HH.td_ [ HH.text (show $ length orc.actions) ]
-                                ]
-                            , HH.tr_
-                                [ HH.th_ [ HH.text "value" ]
-                                , HH.td_ [ HH.text (show orc.value) ]
-                                ]
-                            ]
-                        ]
-                , case toMaybe t.sapling of
-                    Nothing -> HH.p_ []
-                    Just sap ->
-                      HH.tr_
-                        [ HH.th_ [ HH.text "sapling" ]
-                        , HH.table_
-                            [ HH.tr_
-                                [ HH.th_ [ HH.text "spends" ]
-                                , HH.td_ [ HH.text (show $ length sap.spends) ]
-                                ]
-                            , HH.tr_
-                                [ HH.th_ [ HH.text "outputs" ]
-                                , HH.td_ [ HH.text (show $ length sap.outputs) ]
-                                ]
-                            , HH.tr_
-                                [ HH.th_ [ HH.text "value" ]
-                                , HH.td_ [ HH.text (show $ sap.value) ]
-                                ]
-                            ]
-                        ]
-                , case toMaybe t.transparent of
-                    Nothing -> HH.p_ []
-                    Just transp ->
-                      HH.tr_
-                        [ HH.th_
-                            [ HH.text "transparent"
-                            , if transp.coinbase then HH.i [ css "ri-money-dollar-circle-line ri-xl" ] []
-                              else HH.p_ []
-                            ]
-                        , HH.table_
-                            [ HH.tr_
-                                [ HH.th_ [ HH.text "inputs" ]
-                                , HH.td_ [ HH.text (show $ length transp.vin) ]
-                                ]
-                            , HH.tr_
-                                [ HH.th_ [ HH.text "outputs" ]
-                                , HH.td_ [ HH.text (show $ length transp.vout) ]
-                                ]
-                            , HH.tr_
-                                [ HH.th_ [ HH.text "value" ]
-                                , HH.td_ [ HH.text (show $ foldl (\a b -> a + b.value) 0 transp.vout) ]
-                                ]
-                            ]
-                        ]
-                ]
-            ]
-    , HH.p_
-        [ HH.i [ css "ri-copyright-line" ] []
-        , HH.text "2024 Vergara Technologies LLC"
-        ]
-    ]
-
-handleAction :: forall cs o m. MonadAff m => Action -> H.HalogenM State Action cs o m Unit
-handleAction = case _ of
-  Initialize -> do
-    _ <- H.subscribe =<< timer Refresh
-    handleAction Refresh
-  Refresh -> do
-    H.modify_ _ { loading = true }
-    res <- H.liftAff $ AX.get AXRF.string ("https://api.exblo.app/getblock")
-    case res of
-      Left err -> do
-        log $ "/block response failed to decode: " <> AX.printError err
-      Right response -> do
-        case readJSON response.body of
-          Right (i :: Int) ->
-            H.modify_ _
-              { loading = false
-              , block = Just i
-              }
-          Left e -> do
-            log $ "Can't parse JSON. " <> show e
-  SetTerm s -> do
-    H.modify_ _ { term = s }
-  Search event -> do
-    H.liftEffect $ Event.preventDefault event
-    term <- H.gets _.term
-    H.modify_ _ { loading = true }
-    res <- H.liftAff $ AX.get AXRF.string ("https://api.exblo.app/gettransaction/" <> term)
-    case res of
-      Left err -> do
-        log $ "/gettransaction response failed to decode: " <> AX.printError err
-      Right response -> do
-        case readJSON response.body of
-          Right (t :: Transaction) ->
-            H.modify_ _
-              { loading = false
-              , tx = Just t
-              }
-          Left e -> do
-            log $ "Can't parse JSON. " <> show e
-
-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
-
-sumBundles :: Nullable TBundle -> Nullable SBundle -> Nullable OBundle -> Int
-sumBundles t s o =
-  ( case toMaybe o of
-      Nothing -> 0
-      Just orc -> orc.value
-  )
-    +
-      ( case toMaybe s of
-          Nothing -> 0
-          Just sap -> sap.value
-      )
-
-timer :: forall m a. MonadAff m => a -> m (HS.Emitter a)
-timer val = do
-  { emitter, listener } <- H.liftEffect HS.create
-  _ <- H.liftAff $ Aff.forkAff $ forever do
-    Aff.delay $ Milliseconds 60000.0
-    H.liftEffect $ HS.notify listener val
-  pure emitter
-
-css :: forall r i. String -> HH.IProp (class :: String | r) i
-css = HP.class_ <<< HH.ClassName
-

src/Exblo/Utils.purs

@@ -0,0 +1,12 @@
+module Exblo.Utils where
+
+import Prelude
+
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+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

src/Main.purs

@@ -2,12 +2,36 @@ module Main where
 
 import Prelude
 
+import Data.Maybe (Maybe(..))
 import Effect (Effect)
+import Effect.Class (liftEffect)
+import Effect.Aff (launchAff_)
+import Halogen as H
 import Halogen.Aff as HA
 import Halogen.VDom.Driver (runUI)
-import Exblo.UI as UI
+import Exblo.Router as Router
+import Exblo.API (ZcashNet(..))
+import Exblo.Store (LogLevel(..), Store(..))
+import Exblo.AppM (runAppM)
+import Exblo.Navigate (routeCodec)
+import Routing.Hash (matchesWith)
+import Routing.Duplex (parse)
 
 main :: Effect Unit
 main = HA.runHalogenAff do
   body <- HA.awaitBody
-  runUI UI.component unit body
+  let
+    baseUrl = "https://api.exblo.app"
+    logLevel = Dev
+    network = TestNet
+    zebraVersion = ""
+    version = ""
+  let
+    initialStore :: Store
+    initialStore = { baseUrl, logLevel, network, zebraVersion, version }
+  rootComponent <- runAppM initialStore Router.component
+  halogenIO <- runUI rootComponent unit body
+  void $ liftEffect $ matchesWith (parse routeCodec) \old new ->
+    when (old /= Just new) $ launchAff_ do
+      _response <- halogenIO.query $ H.mkTell $ Router.Navigate new
+      pure unit