From 4c7a602a006e45536e94e3672a87f59d2b72bf88 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 14 Oct 2024 10:18:47 -0500 Subject: [PATCH] feat: implement `getrecent blocks` --- CHANGELOG.md | 4 ++++ exblo-server.cabal | 2 +- src/Server.hs | 58 ++++++++++++++++++++++++++++++++++++++++------ src/Types.hs | 15 +++++++++--- 4 files changed, 68 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 71bf4b2..872f9a3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ 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] - 2024-10-14 + +- `getrecentblocks` endpoint + ## [0.2.0.0] -- 2024-10-11 ### Added diff --git a/exblo-server.cabal b/exblo-server.cabal index 0c6ceac..73a862e 100644 --- a/exblo-server.cabal +++ b/exblo-server.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: exblo-server -version: 0.2.0.0 +version: 0.3.0.0 -- synopsis: -- description: homepage: https://vergara.tech/exblo diff --git a/src/Server.hs b/src/Server.hs index 0090ddd..32bfad5 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -10,16 +10,17 @@ module Server where +import Control.Monad (forM) import Control.Monad.IO.Class (liftIO) import Data.Aeson import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as LBS +import Data.Either (fromRight, isRight) import Data.HexString import Data.Scientific (scientific) import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import Servant -import Types (ExbloInfo(..)) +import Types (ExbloInfo(..), ShortBlock(..)) import ZcashHaskell.Types ( BlockResponse(..) , RawZebraTx(..) @@ -39,14 +40,57 @@ type ExbloAPI '[ JSON] Transaction -- gettransaction :<|> "getinfo" :> Get '[ JSON] ExbloInfo -- getinfo - :<|> "getblockinfo" :> Capture "blkid" T.Text :> Get '[ JSON] BlockResponse + :<|> "getblockinfo" :> Capture "blkid" T.Text :> Get '[ JSON] BlockResponse -- getblockinfo + :<|> "getrecentblocks" :> Get '[ JSON] [ShortBlock] api :: Proxy ExbloAPI api = Proxy exbloServer :: Server ExbloAPI -exbloServer = handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock +exbloServer = + handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock :<|> + handleRecentBlocks where + handleRecentBlocks :: Handler [ShortBlock] + handleRecentBlocks = do + res <- + liftIO $ do + s <- makeZebraCall "localhost" 18232 "getblockcount" [] + let blkList = do + findBlocks =<< s + return blkList + case res of + Left e -> throwError $ err400 {errBody = LBS.fromStrict $ C.pack e} + Right sb -> liftIO sb + findBlocks :: Int -> Either String (IO [ShortBlock]) + findBlocks x = do + let blks = [(x - 10) .. x] + let res = + forM blks $ \y -> do + s1 <- + makeZebraCall + "localhost" + 18232 + "getblock" + [Data.Aeson.String $ T.pack $ show y, jsonNumber 1] + s2 <- + makeZebraCall + "localhost" + 18232 + "getblock" + [Data.Aeson.String $ T.pack $ show y, jsonNumber 0] + let blocktime = getBlockTime <$> s2 + let blhash = bl_hash <$> s1 + let blk = ShortBlock y <$> blhash <*> blocktime + return blk + let resList = catRights <$> res + pure resList + catRights :: [Either a ShortBlock] -> [ShortBlock] + catRights [] = [] + catRights (x:xs) = + if isRight x + then fromRight (ShortBlock 0 (hexString "deadbeef") 1) x : catRights xs + else catRights xs handleBlock :: T.Text -> Handler BlockResponse handleBlock i = do s <- @@ -80,10 +124,10 @@ exbloServer = handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock (bl_txs br) handleBlockheight :: Handler Int handleBlockheight = do - s <- liftIO $ makeZebraCall "localhost" 18232 "getblockchaininfo" [] + s <- liftIO $ makeZebraCall "localhost" 18232 "getblockcount" [] case s of Left e -> throwError $ err400 {errBody = LBS.fromStrict $ C.pack e} - Right bci -> return $ zgb_blocks bci + Right bci -> return bci handleTx :: HexString -> Handler Transaction handleTx i = do s <- @@ -120,7 +164,7 @@ exbloServer = handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock Left e1 -> throwError $ err400 {errBody = LBS.fromStrict $ C.pack e1} Right bci -> - return $ ExbloInfo (zgb_net bci) (zgi_build bi) "0.1.0.0" + return $ ExbloInfo (zgb_net bci) (zgi_build bi) "0.3.0.0" exbloApp :: Application exbloApp = serve api exbloServer diff --git a/src/Types.hs b/src/Types.hs index 7b0d3fb..58f2170 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -5,13 +5,22 @@ module Types where import Data.Aeson import Data.Aeson.TH (deriveJSON) +import Data.HexString import qualified Data.Text as T import ZcashHaskell.Types (ZcashNet) data ExbloInfo = ExbloInfo - { ex_net :: ZcashNet - , ex_zebra :: T.Text - , ex_version :: T.Text + { ex_net :: !ZcashNet + , ex_zebra :: !T.Text + , ex_version :: !T.Text } deriving (Eq, Show) $(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ExbloInfo) + +data ShortBlock = ShortBlock + { sb_height :: !Int + , sb_hash :: !HexString + , sb_time :: !Int + } deriving (Eq, Show) + +$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ShortBlock)