Compare commits
No commits in common. "a134947df6af5b0729be20540addffdc91fd36c6" and "c58aa2f8c016007dbf5d1e2e83e9687c84f47354" have entirely different histories.
a134947df6
...
c58aa2f8c0
7 changed files with 166 additions and 302 deletions
15
CHANGELOG.md
15
CHANGELOG.md
|
@ -6,22 +6,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
|
||||
## [Unreleased]
|
||||
|
||||
### Added
|
||||
|
||||
- Parser for Unified Addresses that validates the address
|
||||
- Tests for UA parsing from wallets
|
||||
- Function to scan new transactions using known viewing keys
|
||||
- Function to identify the owners and VKs needed for tx scans
|
||||
|
||||
### Changed
|
||||
## Changed
|
||||
|
||||
- MongoDB driver updated to support MongoDB 6.
|
||||
- Full validation of Sapling addresses to parser.
|
||||
|
||||
### Removed
|
||||
|
||||
- `makeZcashCall` function moved to the generic `zcash-haskell` library.
|
||||
- `RpcResponse`, `RpcCall` types moved to the generic `zcash-haskell` library.
|
||||
|
||||
## [1.7.0]
|
||||
|
||||
|
|
139
src/Owner.hs
139
src/Owner.hs
|
@ -14,33 +14,35 @@ import Database.MongoDB
|
|||
import GHC.Generics
|
||||
|
||||
-- | Type to represent a ZGo shop owner/business
|
||||
data Owner = Owner
|
||||
{ o_id :: Maybe ObjectId
|
||||
, oaddress :: T.Text
|
||||
, oname :: T.Text
|
||||
, ocurrency :: T.Text
|
||||
, otax :: Bool
|
||||
, otaxValue :: Double
|
||||
, ovat :: Bool
|
||||
, ovatValue :: Double
|
||||
, ofirst :: T.Text
|
||||
, olast :: T.Text
|
||||
, oemail :: T.Text
|
||||
, ostreet :: T.Text
|
||||
, ocity :: T.Text
|
||||
, ostate :: T.Text
|
||||
, opostal :: T.Text
|
||||
, ophone :: T.Text
|
||||
, owebsite :: T.Text
|
||||
, ocountry :: T.Text
|
||||
, opaid :: Bool
|
||||
, ozats :: Bool
|
||||
, oinvoices :: Bool
|
||||
, oexpiration :: UTCTime
|
||||
, opayconf :: Bool
|
||||
, oviewkey :: T.Text
|
||||
, ocrmToken :: T.Text
|
||||
} deriving (Eq, Show, Generic, Typeable)
|
||||
data Owner =
|
||||
Owner
|
||||
{ o_id :: Maybe ObjectId
|
||||
, oaddress :: T.Text
|
||||
, oname :: T.Text
|
||||
, ocurrency :: T.Text
|
||||
, otax :: Bool
|
||||
, otaxValue :: Double
|
||||
, ovat :: Bool
|
||||
, ovatValue :: Double
|
||||
, ofirst :: T.Text
|
||||
, olast :: T.Text
|
||||
, oemail :: T.Text
|
||||
, ostreet :: T.Text
|
||||
, ocity :: T.Text
|
||||
, ostate :: T.Text
|
||||
, opostal :: T.Text
|
||||
, ophone :: T.Text
|
||||
, owebsite :: T.Text
|
||||
, ocountry :: T.Text
|
||||
, opaid :: Bool
|
||||
, ozats :: Bool
|
||||
, oinvoices :: Bool
|
||||
, oexpiration :: UTCTime
|
||||
, opayconf :: Bool
|
||||
, oviewkey :: T.Text
|
||||
, ocrmToken :: T.Text
|
||||
}
|
||||
deriving (Eq, Show, Generic, Typeable)
|
||||
|
||||
instance ToJSON Owner where
|
||||
toJSON (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv eTs pc vk cT) =
|
||||
|
@ -274,19 +276,21 @@ instance Val Owner where
|
|||
]
|
||||
|
||||
-- | Type to represent informational data for Owners from UI
|
||||
data OwnerData = OwnerData
|
||||
{ od_first :: T.Text
|
||||
, od_last :: T.Text
|
||||
, od_name :: T.Text
|
||||
, od_street :: T.Text
|
||||
, od_city :: T.Text
|
||||
, od_state :: T.Text
|
||||
, od_postal :: T.Text
|
||||
, od_country :: T.Text
|
||||
, od_email :: T.Text
|
||||
, od_website :: T.Text
|
||||
, od_phone :: T.Text
|
||||
} deriving (Eq, Show, Generic)
|
||||
data OwnerData =
|
||||
OwnerData
|
||||
{ od_first :: T.Text
|
||||
, od_last :: T.Text
|
||||
, od_name :: T.Text
|
||||
, od_street :: T.Text
|
||||
, od_city :: T.Text
|
||||
, od_state :: T.Text
|
||||
, od_postal :: T.Text
|
||||
, od_country :: T.Text
|
||||
, od_email :: T.Text
|
||||
, od_website :: T.Text
|
||||
, od_phone :: T.Text
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON OwnerData where
|
||||
parseJSON =
|
||||
|
@ -304,23 +308,25 @@ instance FromJSON OwnerData where
|
|||
ph <- obj .: "phone"
|
||||
pure $ OwnerData f l n s c st p co e w ph
|
||||
|
||||
data OwnerSettings = OwnerSettings
|
||||
{ os_id :: Maybe ObjectId
|
||||
, os_address :: T.Text
|
||||
, os_name :: T.Text
|
||||
, os_currency :: T.Text
|
||||
, os_tax :: Bool
|
||||
, os_taxValue :: Double
|
||||
, os_vat :: Bool
|
||||
, os_vatValue :: Double
|
||||
, os_paid :: Bool
|
||||
, os_zats :: Bool
|
||||
, os_invoices :: Bool
|
||||
, os_expiration :: UTCTime
|
||||
, os_payconf :: Bool
|
||||
, os_crmToken :: T.Text
|
||||
, os_viewKey :: T.Text
|
||||
} deriving (Eq, Show, Generic)
|
||||
data OwnerSettings =
|
||||
OwnerSettings
|
||||
{ os_id :: Maybe ObjectId
|
||||
, os_address :: T.Text
|
||||
, os_name :: T.Text
|
||||
, os_currency :: T.Text
|
||||
, os_tax :: Bool
|
||||
, os_taxValue :: Double
|
||||
, os_vat :: Bool
|
||||
, os_vatValue :: Double
|
||||
, os_paid :: Bool
|
||||
, os_zats :: Bool
|
||||
, os_invoices :: Bool
|
||||
, os_expiration :: UTCTime
|
||||
, os_payconf :: Bool
|
||||
, os_crmToken :: T.Text
|
||||
, os_viewKey :: T.Text
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON OwnerSettings where
|
||||
parseJSON =
|
||||
|
@ -418,11 +424,6 @@ findExpiringOwners now =
|
|||
["paid" =: True, "expiration" =: ["$lte" =: addUTCTime 172800 now]]
|
||||
"owners")
|
||||
|
||||
findWithKeys :: Action IO [Document]
|
||||
findWithKeys =
|
||||
rest =<<
|
||||
find (select ["paid" =: True, "invoices" =: True, "payconf" =: True] "owners")
|
||||
|
||||
removePro :: T.Text -> Action IO ()
|
||||
removePro o =
|
||||
modify (select ["address" =: o] "owners") ["$set" =: ["invoices" =: False]]
|
||||
|
@ -449,12 +450,14 @@ upsertViewingKey o vk =
|
|||
modify (select ["_id" =: o_id o] "owners") ["$set" =: ["viewKey" =: vk]]
|
||||
|
||||
-- | Type for a pro session
|
||||
data ZGoProSession = ZGoProSession
|
||||
{ ps_id :: Maybe ObjectId
|
||||
, psaddress :: T.Text
|
||||
, psexpiration :: UTCTime
|
||||
, psclosed :: Bool
|
||||
} deriving (Eq, Show)
|
||||
data ZGoProSession =
|
||||
ZGoProSession
|
||||
{ ps_id :: Maybe ObjectId
|
||||
, psaddress :: T.Text
|
||||
, psexpiration :: UTCTime
|
||||
, psclosed :: Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Val ZGoProSession where
|
||||
cast' (Doc d) = do
|
||||
|
|
|
@ -25,7 +25,7 @@ import Data.Char
|
|||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.HexString
|
||||
import Data.Maybe
|
||||
import qualified Data.Scientific as SC
|
||||
import qualified Data.Scientific as Scientific
|
||||
import Data.SecureMem
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
@ -37,8 +37,9 @@ import Data.Time.Format
|
|||
import Data.Typeable
|
||||
import qualified Data.UUID as U
|
||||
import qualified Data.Vector as V
|
||||
import Data.Vector.Internal.Check (doChecks)
|
||||
import Data.Word
|
||||
import Database.MongoDB hiding (Order, lookup)
|
||||
import Database.MongoDB hiding (Order)
|
||||
import Debug.Trace
|
||||
import GHC.Generics
|
||||
import Item
|
||||
|
@ -65,20 +66,47 @@ import Web.Scotty
|
|||
import WooCommerce
|
||||
import Xero
|
||||
import ZGoTx
|
||||
import ZcashHaskell.Orchard
|
||||
import ZcashHaskell.Sapling
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, RawData(..)
|
||||
, RawTxResponse(..)
|
||||
, RpcCall(..)
|
||||
, RpcError(..)
|
||||
, RpcResponse(..)
|
||||
, UnifiedFullViewingKey(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (decodeBech32, makeZcashCall)
|
||||
import ZcashHaskell.Types (RawData(..))
|
||||
import ZcashHaskell.Utils (decodeBech32)
|
||||
|
||||
-- Models for API objects
|
||||
-- | A type to model Zcash RPC calls
|
||||
data RpcCall = RpcCall
|
||||
{ jsonrpc :: T.Text
|
||||
, callId :: T.Text
|
||||
, method :: T.Text
|
||||
, parameters :: [Data.Aeson.Value]
|
||||
} deriving (Show, Generic)
|
||||
|
||||
instance ToJSON RpcCall where
|
||||
toJSON (RpcCall j c m p) =
|
||||
object ["jsonrpc" .= j, "id" .= c, "method" .= m, "params" .= p]
|
||||
|
||||
-- | A type to model the response of the Zcash RPC
|
||||
data RpcResponse r = MakeRpcResponse
|
||||
{ err :: Maybe RpcError
|
||||
, respId :: T.Text
|
||||
, result :: Maybe r
|
||||
} deriving (Show, Generic, ToJSON)
|
||||
|
||||
instance (FromJSON r) => FromJSON (RpcResponse r) where
|
||||
parseJSON (Object obj) =
|
||||
MakeRpcResponse <$> obj .: "error" <*> obj .: "id" <*> obj .: "result"
|
||||
parseJSON _ = mzero
|
||||
|
||||
data RpcError = RpcError
|
||||
{ ecode :: Double
|
||||
, emessage :: T.Text
|
||||
} deriving (Show, Generic, ToJSON)
|
||||
|
||||
instance FromJSON RpcError where
|
||||
parseJSON =
|
||||
withObject "RpcError" $ \obj -> do
|
||||
c <- obj .: "code"
|
||||
m <- obj .: "message"
|
||||
pure $ RpcError c m
|
||||
|
||||
data Payload r = Payload
|
||||
{ payload :: r
|
||||
} deriving (Show, Generic, ToJSON)
|
||||
|
@ -1193,7 +1221,7 @@ routes pipe config = do
|
|||
"z_importviewingkey"
|
||||
[ Data.Aeson.String (T.strip . T.pack $ q)
|
||||
, "no"
|
||||
] -- TODO: Remove this call to the node
|
||||
]
|
||||
let content =
|
||||
getResponseBody vkInfo :: RpcResponse Object
|
||||
if isNothing (err content)
|
||||
|
@ -1205,7 +1233,7 @@ routes pipe config = do
|
|||
text $ L.pack . show $ err content
|
||||
status badRequest400
|
||||
else status forbidden403
|
||||
else status badRequest400 -- TODO: add Unified VK support
|
||||
else status badRequest400
|
||||
--Get items associated with the given address
|
||||
get "/api/items" $ do
|
||||
session <- param "session"
|
||||
|
@ -1439,24 +1467,25 @@ routes pipe config = do
|
|||
{-liftAndCatchIO $-}
|
||||
{-mapM (run . loadLangComponent) (langComp :: [LangComponent])-}
|
||||
{-status created201-}
|
||||
{-(MonadIO m, FromJSON a)-}
|
||||
{-=> BS.ByteString-}
|
||||
{--> BS.ByteString-}
|
||||
{--> T.Text-}
|
||||
{--> [Data.Aeson.Value]-}
|
||||
{--> m (Response a)-}
|
||||
{-let payload =-}
|
||||
{-RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p}-}
|
||||
{-let myRequest =-}
|
||||
{-setRequestBodyJSON payload $-}
|
||||
{-setRequestPort 8232 $-}
|
||||
{-setRequestBasicAuth username password $-}
|
||||
{-setRequestMethod "POST" defaultRequest-}
|
||||
{-httpJSON myRequest-}
|
||||
|
||||
-- | Make a Zcash RPC call
|
||||
{-makeZcashCall ::-}
|
||||
{-makeZcashCall username password m p = do-}
|
||||
makeZcashCall ::
|
||||
(MonadIO m, FromJSON a)
|
||||
=> BS.ByteString
|
||||
-> BS.ByteString
|
||||
-> T.Text
|
||||
-> [Data.Aeson.Value]
|
||||
-> m (Response a)
|
||||
makeZcashCall username password m p = do
|
||||
let payload =
|
||||
RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p}
|
||||
let myRequest =
|
||||
setRequestBodyJSON payload $
|
||||
setRequestPort 8232 $
|
||||
setRequestBasicAuth username password $
|
||||
setRequestMethod "POST" defaultRequest
|
||||
httpJSON myRequest
|
||||
|
||||
-- |Timer for repeating actions
|
||||
setInterval :: Int -> IO () -> IO ()
|
||||
setInterval secs func = do
|
||||
|
@ -1498,7 +1527,7 @@ listTxs user pwd a confs = do
|
|||
user
|
||||
pwd
|
||||
"z_listreceivedbyaddress"
|
||||
[Data.Aeson.String a, Data.Aeson.Number $ SC.scientific confs 0] :: IO
|
||||
[Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO
|
||||
(Either HttpException (Response (RpcResponse [ZcashTx])))
|
||||
case res of
|
||||
Right txList -> do
|
||||
|
@ -1696,7 +1725,7 @@ payOwner p d x =
|
|||
markOwnerPaid :: Pipe -> T.Text -> Payment -> IO ()
|
||||
markOwnerPaid pipe db pmt = do
|
||||
user <- access pipe master db (findUser $ psession pmt)
|
||||
-- print pmt
|
||||
print pmt
|
||||
let parsedUser = parseUserBson =<< user
|
||||
let zaddy = maybe "" uaddress parsedUser
|
||||
owner <- access pipe master db $ findOwner zaddy
|
||||
|
@ -1802,119 +1831,4 @@ generateToken = do
|
|||
rngState <- newCryptoRNGState
|
||||
runCryptoRNGT rngState $ randomString 24 "abcdef0123456789"
|
||||
|
||||
getBlockInfo ::
|
||||
BS.ByteString -> BS.ByteString -> SC.Scientific -> IO (Maybe BlockResponse)
|
||||
getBlockInfo nodeUser nodePwd bh = do
|
||||
blockInfo <- makeZcashCall nodeUser nodePwd "getblock" [Number bh]
|
||||
let content = getResponseBody blockInfo :: RpcResponse BlockResponse
|
||||
if isNothing (err content)
|
||||
then return $ result content
|
||||
else do
|
||||
print $ err content
|
||||
return Nothing
|
||||
|
||||
scanTxNative :: Pipe -> T.Text -> BS.ByteString -> BS.ByteString -> IO ()
|
||||
scanTxNative pipe db nodeUser nodePwd = do
|
||||
keyOwnerList <- access pipe master db findWithKeys
|
||||
unless (null keyOwnerList) $ do
|
||||
let ownerList = cast' . Doc <$> keyOwnerList
|
||||
let keyList = map (maybe "" oviewkey) ownerList
|
||||
lastBlockData <- access pipe master db findBlock
|
||||
latestBlock <- getBlockInfo nodeUser nodePwd (SC.scientific (-1) 0)
|
||||
case latestBlock of
|
||||
Nothing -> fail "No block data from node"
|
||||
Just lB -> do
|
||||
case cast' . Doc =<< lastBlockData of
|
||||
Nothing -> do
|
||||
blockList <-
|
||||
mapM
|
||||
(getBlockInfo nodeUser nodePwd . fromInteger)
|
||||
[2220000 .. (bl_height lB)]
|
||||
let filteredBlockList = filter filterBlock blockList
|
||||
let txIdList = concatMap extractTxs filteredBlockList
|
||||
txList <- mapM (getTxData nodeUser nodePwd) txIdList
|
||||
let filteredTxList = map fromJust $ filter filterTx txList
|
||||
mapM_ (checkTx filteredTxList) keyList
|
||||
Just lastBlock -> do
|
||||
let blockList' = [(bl_height lastBlock + 1) .. (bl_height lB)]
|
||||
print blockList'
|
||||
print keyList
|
||||
where
|
||||
filterBlock :: Maybe BlockResponse -> Bool
|
||||
filterBlock b = maybe 0 bl_confirmations b >= 5
|
||||
filterTx :: Maybe RawTxResponse -> Bool
|
||||
filterTx t =
|
||||
not (null (maybe [] rt_shieldedOutputs t)) &&
|
||||
not (null (maybe [] rt_orchardActions t))
|
||||
extractTxs :: Maybe BlockResponse -> [T.Text]
|
||||
extractTxs = maybe [] bl_txs
|
||||
getTxData ::
|
||||
BS.ByteString -> BS.ByteString -> T.Text -> IO (Maybe RawTxResponse)
|
||||
getTxData nodeUser nodePwd txid = do
|
||||
txInfo <-
|
||||
makeZcashCall
|
||||
nodeUser
|
||||
nodePwd
|
||||
"getrawtransaction"
|
||||
[Data.Aeson.String txid]
|
||||
let content = getResponseBody txInfo :: RpcResponse RawTxResponse
|
||||
if isNothing (err content)
|
||||
then return $ result content
|
||||
else do
|
||||
print $ err content
|
||||
return Nothing
|
||||
checkTx :: [RawTxResponse] -> T.Text -> IO ()
|
||||
checkTx txList k = do
|
||||
if isValidSaplingViewingKey (E.encodeUtf8 k)
|
||||
then do
|
||||
let decodedTxList =
|
||||
map
|
||||
(decodeSaplingOutput (E.encodeUtf8 k))
|
||||
(concatMap
|
||||
rt_shieldedOutputs
|
||||
(filter (\x -> rt_shieldedOutputs x /= []) txList))
|
||||
print decodedTxList
|
||||
else do
|
||||
let vk = decodeUfvk $ E.encodeUtf8 k
|
||||
case vk of
|
||||
Nothing -> print "Not a valid key"
|
||||
Just v -> do
|
||||
let decodedSapList =
|
||||
map
|
||||
(decodeSaplingOutput (s_key v))
|
||||
(concatMap rt_shieldedOutputs txList)
|
||||
print decodedSapList
|
||||
let decodedOrchList =
|
||||
map
|
||||
(decryptOrchardAction v)
|
||||
(concatMap rt_orchardActions txList)
|
||||
print decodedOrchList
|
||||
|
||||
debug = flip trace
|
||||
|
||||
instance Val BlockResponse where
|
||||
cast' (Doc d) = do
|
||||
c <- B.lookup "confirmations" d
|
||||
h <- B.lookup "height" d
|
||||
t <- B.lookup "time" d
|
||||
txs <- B.lookup "tx" d
|
||||
Just (BlockResponse c h t txs)
|
||||
cast' _ = Nothing
|
||||
val (BlockResponse c h t txs) =
|
||||
Doc
|
||||
[ "confirmations" =: c
|
||||
, "height" =: h
|
||||
, "time" =: t
|
||||
, "tx" =: txs
|
||||
, "network" =: ("mainnet" :: String)
|
||||
]
|
||||
|
||||
upsertBlock :: BlockResponse -> Action IO ()
|
||||
upsertBlock b = do
|
||||
let block = val b
|
||||
case block of
|
||||
Doc d -> upsert (select ["network" =: ("mainnet" :: String)] "blocks") d
|
||||
_ -> return ()
|
||||
|
||||
findBlock :: Action IO (Maybe Document)
|
||||
findBlock = findOne (select ["network" =: ("mainnet" :: String)] "blocks")
|
||||
|
|
51
src/ZGoTx.hs
51
src/ZGoTx.hs
|
@ -9,27 +9,26 @@ import qualified Data.Bson as B
|
|||
import Data.Char
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.UUID as U
|
||||
import Data.Void
|
||||
import Database.MongoDB
|
||||
import GHC.Generics
|
||||
import Text.Megaparsec hiding (State)
|
||||
import Text.Megaparsec.Char
|
||||
import ZcashHaskell.Orchard
|
||||
import ZcashHaskell.Sapling (isValidShieldedAddress)
|
||||
|
||||
-- | Type to model a ZGo transaction
|
||||
data ZGoTx = ZGoTx
|
||||
{ _id :: Maybe ObjectId
|
||||
, address :: T.Text
|
||||
, session :: T.Text
|
||||
, confirmations :: Integer
|
||||
, blocktime :: Integer
|
||||
, amount :: Double
|
||||
, txid :: T.Text
|
||||
, memo :: T.Text
|
||||
} deriving (Eq, Show, Generic)
|
||||
data ZGoTx =
|
||||
ZGoTx
|
||||
{ _id :: Maybe ObjectId
|
||||
, address :: T.Text
|
||||
, session :: T.Text
|
||||
, confirmations :: Integer
|
||||
, blocktime :: Integer
|
||||
, amount :: Double
|
||||
, txid :: T.Text
|
||||
, memo :: T.Text
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
parseZGoTxBson :: B.Document -> Maybe ZGoTx
|
||||
parseZGoTxBson d = do
|
||||
|
@ -101,11 +100,13 @@ instance Val ZGoTx where
|
|||
]
|
||||
|
||||
-- | Type to represent and parse ZGo memos
|
||||
data ZGoMemo = ZGoMemo
|
||||
{ m_session :: Maybe U.UUID
|
||||
, m_address :: Maybe T.Text
|
||||
, m_payment :: Bool
|
||||
} deriving (Eq, Show)
|
||||
data ZGoMemo =
|
||||
ZGoMemo
|
||||
{ m_session :: Maybe U.UUID
|
||||
, m_address :: Maybe T.Text
|
||||
, m_payment :: Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data MemoToken
|
||||
= Login !U.UUID
|
||||
|
@ -134,17 +135,9 @@ pSaplingAddress :: Parser MemoToken
|
|||
pSaplingAddress = do
|
||||
string "zs"
|
||||
a <- some alphaNumChar
|
||||
if isValidShieldedAddress (E.encodeUtf8 $ "zs" <> T.pack a)
|
||||
then pure $ Address $ T.pack ("zs" <> a)
|
||||
else fail "Failed to parse Sapling address"
|
||||
|
||||
pUnifiedAddress :: Parser MemoToken
|
||||
pUnifiedAddress = do
|
||||
string "u1"
|
||||
a <- some alphaNumChar
|
||||
if isValidUnifiedAddress (E.encodeUtf8 $ "u1" <> T.pack a)
|
||||
then pure $ Address $ T.pack ("u1" <> a)
|
||||
else fail "Failed to parse Unified Address"
|
||||
if length a /= 76
|
||||
then fail "Failed to parse Sapling address"
|
||||
else pure $ Address $ T.pack ("zs" <> a)
|
||||
|
||||
pMsg :: Parser MemoToken
|
||||
pMsg = do
|
||||
|
|
|
@ -45,7 +45,7 @@ extra-deps:
|
|||
- git: https://github.com/reach-sh/haskell-hexstring.git
|
||||
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
|
||||
- git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
||||
commit: d78c269d96fe7d8a626cf701b8051c40f251e232
|
||||
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
|
||||
- git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
|
||||
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
|
||||
- git: https://github.com/well-typed/borsh.git
|
||||
|
|
|
@ -16,15 +16,15 @@ packages:
|
|||
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
|
||||
git: https://github.com/reach-sh/haskell-hexstring.git
|
||||
- completed:
|
||||
commit: d78c269d96fe7d8a626cf701b8051c40f251e232
|
||||
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
|
||||
git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
||||
name: zcash-haskell
|
||||
pantry-tree:
|
||||
sha256: 69201a27ac966be478ef0b8e3fa8e8bf5cbcc67a58cd254326545eb4f3e93569
|
||||
size: 1229
|
||||
version: 0.2.0
|
||||
sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
|
||||
size: 1126
|
||||
version: 0.1.0
|
||||
original:
|
||||
commit: d78c269d96fe7d8a626cf701b8051c40f251e232
|
||||
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
|
||||
git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
||||
- completed:
|
||||
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
|
||||
|
|
41
test/Spec.hs
41
test/Spec.hs
|
@ -59,7 +59,7 @@ main = do
|
|||
describe "Memo parsers" $
|
||||
--prop "memo parsing" testMemoParser
|
||||
do
|
||||
it "parse ZecWallet memo - Sapling" $ do
|
||||
it "parse ZecWallet memo" $ do
|
||||
let m =
|
||||
runParser
|
||||
pZGoMemo
|
||||
|
@ -70,7 +70,7 @@ main = do
|
|||
Right m' ->
|
||||
m_session m' `shouldBe`
|
||||
U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
|
||||
it "parse YWallet memo - Sapling" $ do
|
||||
it "parse YWallet memo" $ do
|
||||
let m =
|
||||
runParser
|
||||
pZGoMemo
|
||||
|
@ -81,7 +81,7 @@ main = do
|
|||
Right m' ->
|
||||
m_session m' `shouldBe`
|
||||
U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
|
||||
it "parse Zingo memo - Sapling" $ do
|
||||
it "parse Zingo memo" $ do
|
||||
let m =
|
||||
runParser
|
||||
pZGoMemo
|
||||
|
@ -92,39 +92,6 @@ main = do
|
|||
Right m' ->
|
||||
m_session m' `shouldBe`
|
||||
U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
|
||||
it "parse ZecWallet memo - Orchard" $ do
|
||||
let m =
|
||||
runParser
|
||||
pZGoMemo
|
||||
"Zecwalllet memo"
|
||||
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
|
||||
case m of
|
||||
Left e -> putStrLn $ errorBundlePretty e
|
||||
Right m' ->
|
||||
m_session m' `shouldBe`
|
||||
U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
|
||||
it "parse YWallet memo - Orchard" $ do
|
||||
let m =
|
||||
runParser
|
||||
pZGoMemo
|
||||
"Ywallet memo"
|
||||
"\128737MSG\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x\n\nZGO::ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
|
||||
case m of
|
||||
Left e -> putStrLn $ errorBundlePretty e
|
||||
Right m' ->
|
||||
m_session m' `shouldBe`
|
||||
U.fromString "ad8477d3-4fdd-4c97-90b2-76630b5f77e1"
|
||||
it "parse Zingo memo - Orchard" $ do
|
||||
let m =
|
||||
runParser
|
||||
pZGoMemo
|
||||
"Zingo memo"
|
||||
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply to:\nu17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
|
||||
case m of
|
||||
Left e -> putStrLn $ errorBundlePretty e
|
||||
Right m' ->
|
||||
m_session m' `shouldBe`
|
||||
U.fromString "5d3d4494-51c0-432d-8495-050419957aea"
|
||||
describe "PIN generator" $ do
|
||||
it "should give a 7 digit" $ do
|
||||
pin <- generatePin
|
||||
|
@ -295,7 +262,7 @@ main = do
|
|||
it "return owner by id" $ do
|
||||
req <-
|
||||
testGet
|
||||
"/ownerid"
|
||||
"/api/ownerid"
|
||||
[ ("id", Just "627ad3492b05a76be3000001")
|
||||
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
||||
]
|
||||
|
|
Loading…
Reference in a new issue