Initial commit

.gitmodules

@@ -0,0 +1,4 @@
+[submodule "zcash-haskell"]
+	path = zcash-haskell
+	url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
+	branch = milestone2

CHANGELOG.md

@@ -0,0 +1,10 @@
+# Changelog 
+
+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.1.0.0 -- 2024-08-27
+
+* First version. Released on an unsuspecting world.

LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2024 Vergara Technologies LLC
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

README.md

@@ -0,0 +1,6 @@
+# exblo-server
+
+[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page) ![](https://img.shields.io/badge/License-MIT-green
+)
+
+The back end API for the [exblo](https://testnet.exblo.app) Zcash block explorer.

app/Main.hs

@@ -0,0 +1,8 @@
+module Main where
+
+import Network.Wai.Handler.Warp (run)
+import Server
+
+main :: IO ()
+main = do
+  run 8032 exbloApp

cabal.project

@@ -0,0 +1,16 @@
+packages:
+  ./*.cabal
+  zcash-haskell/*.cabal
+
+with-compiler: ghc-9.6.5
+
+source-repository-package
+  type: git
+  location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
+  tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
+
+source-repository-package
+  type: git
+  location: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
+  tag: 335e804454cd30da2c526457be37e477f71e4665
+

exblo-server.cabal

@@ -0,0 +1,60 @@
+cabal-version:      3.4
+name:               exblo-server
+version:            0.1.0.0
+-- synopsis:
+-- description:
+homepage:           https://vergara.tech/exblo
+license:            MIT
+license-file:       LICENSE
+author:             Vergara Technologies LLC
+maintainer:         contact@vergara.tech
+-- copyright:
+category:           Web
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+-- extra-source-files:
+
+common warnings
+    ghc-options: -Wall
+
+library
+    import:           warnings
+    exposed-modules:  Server
+    -- other-modules:
+    -- other-extensions:
+    build-depends:    
+       base ^>=4.18.2.1
+     , servant-server
+     , hexstring
+     , text
+     , aeson
+     , base16-bytestring
+     , zcash-haskell
+    hs-source-dirs:   src
+    default-language: GHC2021
+
+executable exblo-server
+    import:           warnings
+    main-is:          Main.hs
+    -- other-modules:
+    -- other-extensions:
+    build-depends:
+        base ^>=4.18.2.1
+      , warp
+      , exblo-server
+
+    hs-source-dirs:   app
+    pkgconfig-depends: rustzcash_wrapper
+    default-language: GHC2021
+
+test-suite exblo-server-test
+    import:           warnings
+    default-language: GHC2021
+    -- other-modules:
+    -- other-extensions:
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   test
+    main-is:          Spec.hs
+    build-depends:
+        base ^>=4.18.2.1,
+        exblo-server

src/Server.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Server where
+
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson
+import qualified Data.ByteString.Base16 as BS16 (decode)
+import Data.HexString
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Servant
+import ZcashHaskell.Types
+  ( RawZebraTx(..)
+  , Transaction(..)
+  , ZebraGetBlockChainInfo(..)
+  , ZebraTxResponse(..)
+  , fromRawOBundle
+  , fromRawSBundle
+  , fromRawTBundle
+  )
+import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
+
+instance FromHttpApiData HexString where
+  parseUrlPiece s =
+    case BS16.decode (TE.encodeUtf8 s) of
+      Right s -> Right $ HexString s
+      Left e -> Left $ T.pack e
+
+type ExbloAPI
+  = "getblock" :> Get '[ JSON] Int -- getblock
+     :<|> "gettransaction" :> Capture "txid" HexString :> Get
+      '[ JSON]
+      Transaction -- gettransaction
+
+api :: Proxy ExbloAPI
+api = Proxy
+
+exbloServer :: Server ExbloAPI
+exbloServer = handleAPI :<|> handleTx
+  where
+    handleAPI :: Handler Int
+    handleAPI = do
+      s <- liftIO $ makeZebraCall "localhost" 18232 "getblockchaininfo" []
+      case s of
+        Left e -> fail e
+        Right bci -> return $ zgb_blocks bci
+    handleTx :: HexString -> Handler Transaction
+    handleTx i = do
+      s <-
+        liftIO $
+        makeZebraCall
+          "localhost"
+          18232
+          "getrawtransaction"
+          [Data.Aeson.String $ toText i, Data.Aeson.Number 1]
+      case s of
+        Left e -> fail e
+        Right t ->
+          case readZebraTransaction (ztr_hex t) of
+            Nothing -> fail "Unable to parse transaction"
+            Just tx ->
+              return $
+              Transaction
+                i
+                (ztr_blockheight t)
+                (ztr_conf t)
+                (fromIntegral $ zt_expiry tx)
+                (fromRawTBundle $ zt_tBundle tx)
+                (fromRawSBundle $ zt_sBundle tx)
+                (fromRawOBundle $ zt_oBundle tx)
+
+exbloApp :: Application
+exbloApp = serve api exbloServer

test/Spec.hs

@@ -0,0 +1,4 @@
+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Test suite not yet implemented."

zcash-haskell

@@ -0,0 +1 @@
+Subproject commit 0b2fae2b5db6878b7669d639a5cb8c73b986906e