feat: implement getrecent blocks
This commit is contained in:
parent
8c1230ebd6
commit
4c7a602a00
4 changed files with 68 additions and 11 deletions
|
@ -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/),
|
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.3.0.0] - 2024-10-14
|
||||||
|
|
||||||
|
- `getrecentblocks` endpoint
|
||||||
|
|
||||||
## [0.2.0.0] -- 2024-10-11
|
## [0.2.0.0] -- 2024-10-11
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 3.4
|
cabal-version: 3.4
|
||||||
name: exblo-server
|
name: exblo-server
|
||||||
version: 0.2.0.0
|
version: 0.3.0.0
|
||||||
-- synopsis:
|
-- synopsis:
|
||||||
-- description:
|
-- description:
|
||||||
homepage: https://vergara.tech/exblo
|
homepage: https://vergara.tech/exblo
|
||||||
|
|
|
@ -10,16 +10,17 @@
|
||||||
|
|
||||||
module Server where
|
module Server where
|
||||||
|
|
||||||
|
import Control.Monad (forM)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.ByteString.Char8 as C
|
import qualified Data.ByteString.Char8 as C
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
|
import Data.Either (fromRight, isRight)
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.Scientific (scientific)
|
import Data.Scientific (scientific)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as TE
|
|
||||||
import Servant
|
import Servant
|
||||||
import Types (ExbloInfo(..))
|
import Types (ExbloInfo(..), ShortBlock(..))
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( BlockResponse(..)
|
( BlockResponse(..)
|
||||||
, RawZebraTx(..)
|
, RawZebraTx(..)
|
||||||
|
@ -39,14 +40,57 @@ type ExbloAPI
|
||||||
'[ JSON]
|
'[ JSON]
|
||||||
Transaction -- gettransaction
|
Transaction -- gettransaction
|
||||||
:<|> "getinfo" :> Get '[ JSON] ExbloInfo -- getinfo
|
:<|> "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 ExbloAPI
|
||||||
api = Proxy
|
api = Proxy
|
||||||
|
|
||||||
exbloServer :: Server ExbloAPI
|
exbloServer :: Server ExbloAPI
|
||||||
exbloServer = handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock
|
exbloServer =
|
||||||
|
handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock :<|>
|
||||||
|
handleRecentBlocks
|
||||||
where
|
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 :: T.Text -> Handler BlockResponse
|
||||||
handleBlock i = do
|
handleBlock i = do
|
||||||
s <-
|
s <-
|
||||||
|
@ -80,10 +124,10 @@ exbloServer = handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock
|
||||||
(bl_txs br)
|
(bl_txs br)
|
||||||
handleBlockheight :: Handler Int
|
handleBlockheight :: Handler Int
|
||||||
handleBlockheight = do
|
handleBlockheight = do
|
||||||
s <- liftIO $ makeZebraCall "localhost" 18232 "getblockchaininfo" []
|
s <- liftIO $ makeZebraCall "localhost" 18232 "getblockcount" []
|
||||||
case s of
|
case s of
|
||||||
Left e -> throwError $ err400 {errBody = LBS.fromStrict $ C.pack e}
|
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 :: HexString -> Handler Transaction
|
||||||
handleTx i = do
|
handleTx i = do
|
||||||
s <-
|
s <-
|
||||||
|
@ -120,7 +164,7 @@ exbloServer = handleBlockheight :<|> handleTx :<|> handleInfo :<|> handleBlock
|
||||||
Left e1 ->
|
Left e1 ->
|
||||||
throwError $ err400 {errBody = LBS.fromStrict $ C.pack e1}
|
throwError $ err400 {errBody = LBS.fromStrict $ C.pack e1}
|
||||||
Right bci ->
|
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 :: Application
|
||||||
exbloApp = serve api exbloServer
|
exbloApp = serve api exbloServer
|
||||||
|
|
15
src/Types.hs
15
src/Types.hs
|
@ -5,13 +5,22 @@ module Types where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.TH (deriveJSON)
|
import Data.Aeson.TH (deriveJSON)
|
||||||
|
import Data.HexString
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import ZcashHaskell.Types (ZcashNet)
|
import ZcashHaskell.Types (ZcashNet)
|
||||||
|
|
||||||
data ExbloInfo = ExbloInfo
|
data ExbloInfo = ExbloInfo
|
||||||
{ ex_net :: ZcashNet
|
{ ex_net :: !ZcashNet
|
||||||
, ex_zebra :: T.Text
|
, ex_zebra :: !T.Text
|
||||||
, ex_version :: T.Text
|
, ex_version :: !T.Text
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ExbloInfo)
|
$(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)
|
||||||
|
|
Loading…
Reference in a new issue