zcash-haskell/src/ZcashHaskell/Sapling.hs

{- Copyright 2022-2024 Vergara Technologies LLC

  This file is part of Zcash-Haskell.
 
  Zcash-Haskell is free software: you can redistribute it and/or modify it
  under the terms of the GNU Lesser General Public License as published by the Free
  Software Foundation, either version 3 of the License, or (at your option) any
  later version.
 
  Zcash-Haskell is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
  details.

  You should have received a copy of the GNU Lesser General Public License along with
  Zcash-Haskell. If not, see <https://www.gnu.org/licenses/>.

-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  ZcashHaskell.Sapling
-- Copyright   :  2022-2024 Vergara Technologies
-- License     :  LGPL-3
--
-- Maintainer  :  rene@vergara.network
-- Stability   :  experimental
-- Portability :  unknown
--
-- Functions to interact with the Sapling shielded pool of the Zcash blockchain.
--
module ZcashHaskell.Sapling where

import C.Zcash
  ( rustWrapperIsShielded
  , rustWrapperSaplingCheck
  , rustWrapperSaplingNoteDecode
  , rustWrapperSaplingVkDecode
  , rustWrapperTxParse
  )
import Data.Aeson
import qualified Data.ByteString as BS
import Foreign.Rust.Marshall.Variable (withPureBorshVarBuffer)
import ZcashHaskell.Types
  ( DecodedNote(..)
  , RawData(..)
  , RawTxResponse(..)
  , ShieldedOutput(..)
  , decodeHexText
  )
import ZcashHaskell.Utils (decodeBech32)

-- | Check if given bytesting is a valid encoded shielded address
isValidShieldedAddress :: BS.ByteString -> Bool
isValidShieldedAddress = rustWrapperIsShielded

getShieldedOutputs :: BS.ByteString -> [BS.ByteString]
getShieldedOutputs t = withPureBorshVarBuffer $ rustWrapperTxParse t

-- | Check if given bytestring is a valid Sapling viewing key
isValidSaplingViewingKey :: BS.ByteString -> Bool
isValidSaplingViewingKey k =
  case hrp decodedKey of
    "zxviews" -> rustWrapperSaplingVkDecode $ bytes decodedKey
    _ -> False
  where
    decodedKey = decodeBech32 k

-- | Check if the given bytestring for the Sapling viewing key matches the second bytestring for the address
matchSaplingAddress :: BS.ByteString -> BS.ByteString -> Bool
matchSaplingAddress = rustWrapperSaplingCheck

-- | Attempt to decode the given raw tx with the given Sapling viewing key
decodeSaplingOutput :: BS.ByteString -> BS.ByteString -> Maybe DecodedNote
decodeSaplingOutput key out =
  case a_value decodedAction of
    0 -> Nothing
    _ -> Just decodedAction
  where
    decodedAction =
      withPureBorshVarBuffer $ rustWrapperSaplingNoteDecode key out

instance FromJSON RawTxResponse where
  parseJSON =
    withObject "RawTxResponse" $ \obj -> do
      i <- obj .: "txid"
      o <- obj .:? "orchard"
      h <- obj .: "hex"
      ht <- obj .: "height"
      c <- obj .: "confirmations"
      b <- obj .: "blocktime"
      case o of
        Nothing ->
          pure $
          RawTxResponse
            i
            (decodeHexText h)
            (getShieldedOutputs (decodeHexText h))
            []
            ht
            c
            b
        Just o' -> do
          a <- o' .: "actions"
          pure $
            RawTxResponse
              i
              (decodeHexText h)
              (getShieldedOutputs (decodeHexText h))
              a
              ht
              c
              b