feat: implement router and components

This commit is contained in:
Rene Vergara 2024-09-06 21:03:42 -05:00
parent 41165f9c2c
commit 57c0ad34a7
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
15 changed files with 7335 additions and 3237 deletions

View file

@ -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/), 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). 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] ## [0.1.0.0]
### Added ### Added

9435
dev/app.js

File diff suppressed because it is too large Load diff

View file

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

View file

@ -11,6 +11,6 @@
"bundle": "spago bundle-app --to dev/app.js", "bundle": "spago bundle-app --to dev/app.js",
"test": "spago test", "test": "spago test",
"serve": "spago build && parcel serve --open --no-cache --dist-dir dist/ dev/index.html", "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"
} }
} }

View file

@ -14,22 +14,31 @@ to generate this file without the comments in this block.
, dependencies = , dependencies =
[ "aff" [ "aff"
, "affjax" , "affjax"
, "simple-json"
, "affjax-web" , "affjax-web"
, "console" , "argonaut-codecs"
, "tailrec"
, "nullable"
, "integers"
, "datetime"
, "formatters"
, "arrays" , "arrays"
, "codec-argonaut"
, "console"
, "datetime"
, "effect" , "effect"
, "either" , "either"
, "formatters"
, "halogen" , "halogen"
, "halogen-store"
, "halogen-subscriptions" , "halogen-subscriptions"
, "integers"
, "maybe" , "maybe"
, "nullable"
, "prelude" , "prelude"
, "remotedata"
, "routing"
, "routing-duplex"
, "safe-coerce"
, "simple-json"
, "tailrec"
, "transformers"
, "web-events" , "web-events"
, "web-uievents"
] ]
, packages = ./packages.dhall , packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ] , sources = [ "src/**/*.purs", "test/**/*.purs" ]

135
src/Exblo/API.purs Normal file
View file

@ -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
)

33
src/Exblo/AppM.purs Normal file
View file

@ -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

180
src/Exblo/Home.purs Normal file
View file

@ -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

35
src/Exblo/Navigate.purs Normal file
View file

@ -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

91
src/Exblo/Router.purs Normal file
View file

@ -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)

26
src/Exblo/Store.purs Normal file
View file

@ -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

175
src/Exblo/Tx.purs Normal file
View file

@ -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

View file

@ -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

12
src/Exblo/Utils.purs Normal file
View file

@ -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

View file

@ -2,12 +2,36 @@ module Main where
import Prelude import Prelude
import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Aff (launchAff_)
import Halogen as H
import Halogen.Aff as HA import Halogen.Aff as HA
import Halogen.VDom.Driver (runUI) 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 :: Effect Unit
main = HA.runHalogenAff do main = HA.runHalogenAff do
body <- HA.awaitBody 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