Compare commits
No commits in common. "ea731df20d38199c7d3f88423ba18b193c1d64d3" and "a8d4329e7d5b860facbd95b2d6e329985f72c4fb" have entirely different histories.
ea731df20d
...
a8d4329e7d
18 changed files with 432 additions and 1301 deletions
34
CHANGELOG.md
34
CHANGELOG.md
|
@ -4,39 +4,7 @@ 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).
|
||||||
|
|
||||||
## [1.7.0]
|
## [1.5.0]
|
||||||
|
|
||||||
### Added
|
|
||||||
|
|
||||||
- Parameter to config for number of confirmations for scan
|
|
||||||
- Endpoint for language for invoices
|
|
||||||
|
|
||||||
### Changed
|
|
||||||
|
|
||||||
- Modified payment confirmation to use new WooCommerce plugin API endpoint.
|
|
||||||
- Consolidated the `invdata`, `orderid` and `orderx` endpoints
|
|
||||||
- The `xerotoken` endpoint uses `session` for authentication
|
|
||||||
- The order by ID/token endpoint includes shop name
|
|
||||||
|
|
||||||
### Fixed
|
|
||||||
|
|
||||||
- The viewing key obfuscation of blank viewing keys
|
|
||||||
|
|
||||||
## [1.6.0]
|
|
||||||
|
|
||||||
### Added
|
|
||||||
|
|
||||||
- New JSON serialization for WooTokens.
|
|
||||||
- New `/api/ownervk` endpoint to save viewing keys
|
|
||||||
- Use of `zcash-haskell` library to validate Sapling viewing keys
|
|
||||||
|
|
||||||
### Changed
|
|
||||||
|
|
||||||
- Modified the process of scanning for payments to only scan addresses that have an active ZGo session and have enabled payment confirmations
|
|
||||||
- Modified the process to mark paid orders to ensure only payments to the shop's wallet get marked as paid
|
|
||||||
- Modified the `items` endpoint to use the login session to identify records
|
|
||||||
|
|
||||||
## [1.5.0] - 2023-05-15
|
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|
||||||
|
|
|
@ -6,8 +6,7 @@ The API server behind the [ZGo.cash](https://zgo.cash) app.
|
||||||
|
|
||||||
## Dependencies
|
## Dependencies
|
||||||
|
|
||||||
- Zcash Full node (`zcashd`)
|
- Zcash Full node
|
||||||
- [Zcash Haskell](https://git.vergara.tech/Vergara_Tech/zcash-haskell)
|
|
||||||
- MongoDB
|
- MongoDB
|
||||||
|
|
||||||
## Configuration
|
## Configuration
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: zgo-backend
|
name: zgo-backend
|
||||||
version: 1.7.0
|
version: 1.5.0
|
||||||
git: "https://git.vergara.tech/Vergara_Tech/zgo-backend"
|
git: "https://git.vergara.tech/Vergara_Tech/zgo-backend"
|
||||||
license: BOSL
|
license: BOSL
|
||||||
author: "Rene Vergara"
|
author: "Rene Vergara"
|
||||||
|
@ -62,7 +62,6 @@ library:
|
||||||
- crypto-rng
|
- crypto-rng
|
||||||
- megaparsec
|
- megaparsec
|
||||||
- uuid
|
- uuid
|
||||||
- zcash-haskell
|
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
zgo-backend-exe:
|
zgo-backend-exe:
|
||||||
|
@ -162,6 +161,3 @@ tests:
|
||||||
- time
|
- time
|
||||||
- configurator
|
- configurator
|
||||||
- scotty
|
- scotty
|
||||||
- megaparsec
|
|
||||||
- uuid
|
|
||||||
- zcash-haskell
|
|
||||||
|
|
|
@ -26,7 +26,6 @@ data Config =
|
||||||
, c_smtpPort :: Integer
|
, c_smtpPort :: Integer
|
||||||
, c_smtpUser :: String
|
, c_smtpUser :: String
|
||||||
, c_smtpPwd :: String
|
, c_smtpPwd :: String
|
||||||
, c_confirmations :: Integer
|
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
@ -49,7 +48,6 @@ loadZGoConfig path = do
|
||||||
mailPort <- require config "smtpPort"
|
mailPort <- require config "smtpPort"
|
||||||
mailUser <- require config "smtpUser"
|
mailUser <- require config "smtpUser"
|
||||||
mailPwd <- require config "smtpPwd"
|
mailPwd <- require config "smtpPwd"
|
||||||
conf <- require config "confirmations"
|
|
||||||
return $
|
return $
|
||||||
Config
|
Config
|
||||||
dbHost
|
dbHost
|
||||||
|
@ -68,4 +66,3 @@ loadZGoConfig path = do
|
||||||
mailPort
|
mailPort
|
||||||
mailUser
|
mailUser
|
||||||
mailPwd
|
mailPwd
|
||||||
conf
|
|
||||||
|
|
|
@ -12,7 +12,6 @@ import Data.Time.Clock
|
||||||
import Database.MongoDB
|
import Database.MongoDB
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import User
|
|
||||||
|
|
||||||
-- | Type to represent a ZGo item
|
-- | Type to represent a ZGo item
|
||||||
data Item =
|
data Item =
|
||||||
|
@ -88,9 +87,6 @@ findItems :: T.Text -> Action IO [Document]
|
||||||
findItems a =
|
findItems a =
|
||||||
rest =<< find (select ["owner" =: a] "items") {sort = ["name" =: (1 :: Int)]}
|
rest =<< find (select ["owner" =: a] "items") {sort = ["name" =: (1 :: Int)]}
|
||||||
|
|
||||||
findItemById :: String -> Action IO (Maybe Document)
|
|
||||||
findItemById i = findOne (select ["_id" =: (read i :: ObjectId)] "items")
|
|
||||||
|
|
||||||
upsertItem :: Item -> Action IO ()
|
upsertItem :: Item -> Action IO ()
|
||||||
upsertItem i = do
|
upsertItem i = do
|
||||||
let item = val i
|
let item = val i
|
||||||
|
|
19
src/Order.hs
19
src/Order.hs
|
@ -29,12 +29,11 @@ data ZGoOrder =
|
||||||
, qpaid :: Bool
|
, qpaid :: Bool
|
||||||
, qexternalInvoice :: T.Text
|
, qexternalInvoice :: T.Text
|
||||||
, qshortCode :: T.Text
|
, qshortCode :: T.Text
|
||||||
, qtoken :: T.Text
|
|
||||||
}
|
}
|
||||||
deriving (Eq, Show, Generic)
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
instance ToJSON ZGoOrder where
|
instance ToJSON ZGoOrder where
|
||||||
toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk) =
|
toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC) =
|
||||||
case i of
|
case i of
|
||||||
Just oid ->
|
Just oid ->
|
||||||
object
|
object
|
||||||
|
@ -51,7 +50,6 @@ instance ToJSON ZGoOrder where
|
||||||
, "paid" .= paid
|
, "paid" .= paid
|
||||||
, "externalInvoice" .= eI
|
, "externalInvoice" .= eI
|
||||||
, "shortCode" .= sC
|
, "shortCode" .= sC
|
||||||
, "token" .= tk
|
|
||||||
]
|
]
|
||||||
Nothing ->
|
Nothing ->
|
||||||
object
|
object
|
||||||
|
@ -68,7 +66,6 @@ instance ToJSON ZGoOrder where
|
||||||
, "paid" .= paid
|
, "paid" .= paid
|
||||||
, "externalInvoice" .= eI
|
, "externalInvoice" .= eI
|
||||||
, "shortCode" .= sC
|
, "shortCode" .= sC
|
||||||
, "token" .= tk
|
|
||||||
]
|
]
|
||||||
|
|
||||||
instance FromJSON ZGoOrder where
|
instance FromJSON ZGoOrder where
|
||||||
|
@ -87,7 +84,6 @@ instance FromJSON ZGoOrder where
|
||||||
pd <- obj .: "paid"
|
pd <- obj .: "paid"
|
||||||
eI <- obj .: "externalInvoice"
|
eI <- obj .: "externalInvoice"
|
||||||
sC <- obj .: "shortCode"
|
sC <- obj .: "shortCode"
|
||||||
tk <- obj .: "token"
|
|
||||||
pure $
|
pure $
|
||||||
ZGoOrder
|
ZGoOrder
|
||||||
(if not (null i)
|
(if not (null i)
|
||||||
|
@ -105,10 +101,9 @@ instance FromJSON ZGoOrder where
|
||||||
pd
|
pd
|
||||||
eI
|
eI
|
||||||
sC
|
sC
|
||||||
tk
|
|
||||||
|
|
||||||
instance Val ZGoOrder where
|
instance Val ZGoOrder where
|
||||||
val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
|
val (ZGoOrder i a s ts c cur p t tZ l pd eI sC) =
|
||||||
if isJust i
|
if isJust i
|
||||||
then Doc
|
then Doc
|
||||||
[ "_id" =: i
|
[ "_id" =: i
|
||||||
|
@ -124,7 +119,6 @@ instance Val ZGoOrder where
|
||||||
, "paid" =: pd
|
, "paid" =: pd
|
||||||
, "externalInvoice" =: eI
|
, "externalInvoice" =: eI
|
||||||
, "shortCode" =: sC
|
, "shortCode" =: sC
|
||||||
, "token" =: tk
|
|
||||||
]
|
]
|
||||||
else Doc
|
else Doc
|
||||||
[ "address" =: a
|
[ "address" =: a
|
||||||
|
@ -139,7 +133,6 @@ instance Val ZGoOrder where
|
||||||
, "paid" =: pd
|
, "paid" =: pd
|
||||||
, "externalInvoice" =: eI
|
, "externalInvoice" =: eI
|
||||||
, "shortCode" =: sC
|
, "shortCode" =: sC
|
||||||
, "token" =: tk
|
|
||||||
]
|
]
|
||||||
cast' (Doc d) = do
|
cast' (Doc d) = do
|
||||||
i <- B.lookup "_id" d
|
i <- B.lookup "_id" d
|
||||||
|
@ -155,8 +148,7 @@ instance Val ZGoOrder where
|
||||||
pd <- B.lookup "paid" d
|
pd <- B.lookup "paid" d
|
||||||
eI <- B.lookup "externalInvoice" d
|
eI <- B.lookup "externalInvoice" d
|
||||||
sC <- B.lookup "shortCode" d
|
sC <- B.lookup "shortCode" d
|
||||||
tk <- B.lookup "token" d
|
Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC)
|
||||||
Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk)
|
|
||||||
cast' _ = Nothing
|
cast' _ = Nothing
|
||||||
|
|
||||||
-- Type to represent an order line item
|
-- Type to represent an order line item
|
||||||
|
@ -232,17 +224,12 @@ updateOrderTotals o =
|
||||||
(qpaid o)
|
(qpaid o)
|
||||||
(qexternalInvoice o)
|
(qexternalInvoice o)
|
||||||
(qshortCode o)
|
(qshortCode o)
|
||||||
(qtoken o)
|
|
||||||
where
|
where
|
||||||
newTotal :: ZGoOrder -> Double
|
newTotal :: ZGoOrder -> Double
|
||||||
newTotal x = foldr tallyItems 0 (qlines x)
|
newTotal x = foldr tallyItems 0 (qlines x)
|
||||||
tallyItems :: LineItem -> Double -> Double
|
tallyItems :: LineItem -> Double -> Double
|
||||||
tallyItems y z = (lqty y * lcost y) + z
|
tallyItems y z = (lqty y * lcost y) + z
|
||||||
|
|
||||||
setOrderToken :: T.Text -> ZGoOrder -> ZGoOrder
|
|
||||||
setOrderToken token (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
|
|
||||||
ZGoOrder i a s ts c cur p t tZ l pd eI sC token
|
|
||||||
|
|
||||||
findOrder :: T.Text -> Action IO (Maybe Document)
|
findOrder :: T.Text -> Action IO (Maybe Document)
|
||||||
findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")
|
findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")
|
||||||
|
|
||||||
|
|
14
src/Owner.hs
14
src/Owner.hs
|
@ -366,12 +366,8 @@ instance ToJSON OwnerSettings where
|
||||||
, "expiration" .= e
|
, "expiration" .= e
|
||||||
, "payconf" .= pc
|
, "payconf" .= pc
|
||||||
, "crmToken" .= cT
|
, "crmToken" .= cT
|
||||||
, "viewkey" .= keyObfuscate vK
|
, "viewkey" .= (T.take 8 vK <> "...." <> T.takeEnd 8 vK)
|
||||||
]
|
]
|
||||||
where
|
|
||||||
keyObfuscate s
|
|
||||||
| s == "" = ""
|
|
||||||
| otherwise = T.take 8 s <> "...." <> T.takeEnd 8 s
|
|
||||||
|
|
||||||
-- Helper Functions
|
-- Helper Functions
|
||||||
getOwnerSettings :: Owner -> OwnerSettings
|
getOwnerSettings :: Owner -> OwnerSettings
|
||||||
|
@ -411,10 +407,6 @@ findOwnerById :: T.Text -> Action IO (Maybe Document)
|
||||||
findOwnerById i =
|
findOwnerById i =
|
||||||
findOne (select ["_id" =: (read (T.unpack i) :: ObjectId)] "owners")
|
findOne (select ["_id" =: (read (T.unpack i) :: ObjectId)] "owners")
|
||||||
|
|
||||||
findActiveOwners :: Action IO [Document]
|
|
||||||
findActiveOwners =
|
|
||||||
rest =<< find (select ["paid" =: True, "payconf" =: True] "owners")
|
|
||||||
|
|
||||||
-- | Function to find Owners about to expire
|
-- | Function to find Owners about to expire
|
||||||
findExpiringOwners :: UTCTime -> Action IO [Document]
|
findExpiringOwners :: UTCTime -> Action IO [Document]
|
||||||
findExpiringOwners now =
|
findExpiringOwners now =
|
||||||
|
@ -445,10 +437,6 @@ updateOwnerSettings os =
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
upsertViewingKey :: Owner -> String -> Action IO ()
|
|
||||||
upsertViewingKey o vk =
|
|
||||||
modify (select ["_id" =: o_id o] "owners") ["$set" =: ["viewKey" =: vk]]
|
|
||||||
|
|
||||||
-- | Type for a pro session
|
-- | Type for a pro session
|
||||||
data ZGoProSession =
|
data ZGoProSession =
|
||||||
ZGoProSession
|
ZGoProSession
|
||||||
|
|
33
src/User.hs
33
src/User.hs
|
@ -69,36 +69,6 @@ instance FromJSON User where
|
||||||
""
|
""
|
||||||
v
|
v
|
||||||
|
|
||||||
instance Val User where
|
|
||||||
cast' (Doc d) = do
|
|
||||||
i <- B.lookup "_id" d
|
|
||||||
a <- B.lookup "address" d
|
|
||||||
s <- B.lookup "session" d
|
|
||||||
b <- B.lookup "blocktime" d
|
|
||||||
p <- B.lookup "pin" d
|
|
||||||
v <- B.lookup "validated" d
|
|
||||||
Just $ User i a s b p v
|
|
||||||
cast' _ = Nothing
|
|
||||||
val (User i a s b p v) =
|
|
||||||
case i of
|
|
||||||
Just oid ->
|
|
||||||
Doc
|
|
||||||
[ "_id" =: oid
|
|
||||||
, "address" =: a
|
|
||||||
, "session" =: s
|
|
||||||
, "blocktime" =: b
|
|
||||||
, "pin" =: p
|
|
||||||
, "validated" =: v
|
|
||||||
]
|
|
||||||
Nothing ->
|
|
||||||
Doc
|
|
||||||
[ "address" =: a
|
|
||||||
, "session" =: s
|
|
||||||
, "blocktime" =: b
|
|
||||||
, "pin" =: p
|
|
||||||
, "validated" =: v
|
|
||||||
]
|
|
||||||
|
|
||||||
parseUserBson :: B.Document -> Maybe User
|
parseUserBson :: B.Document -> Maybe User
|
||||||
parseUserBson d = do
|
parseUserBson d = do
|
||||||
i <- B.lookup "_id" d
|
i <- B.lookup "_id" d
|
||||||
|
@ -114,9 +84,6 @@ parseUserBson d = do
|
||||||
findUser :: T.Text -> Action IO (Maybe Document)
|
findUser :: T.Text -> Action IO (Maybe Document)
|
||||||
findUser s = findOne (select ["session" =: s] "users")
|
findUser s = findOne (select ["session" =: s] "users")
|
||||||
|
|
||||||
findUserById :: String -> Action IO (Maybe Document)
|
|
||||||
findUserById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "users")
|
|
||||||
|
|
||||||
-- | Function to delete user by ID
|
-- | Function to delete user by ID
|
||||||
deleteUser :: String -> Action IO ()
|
deleteUser :: String -> Action IO ()
|
||||||
deleteUser i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "users")
|
deleteUser i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "users")
|
||||||
|
|
|
@ -28,29 +28,6 @@ data WooToken =
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
instance FromJSON WooToken where
|
|
||||||
parseJSON =
|
|
||||||
withObject "WooToken" $ \obj -> do
|
|
||||||
i <- obj .:? "_id"
|
|
||||||
o <- obj .: "ownerid"
|
|
||||||
t <- obj .: "token"
|
|
||||||
u <- obj .: "siteurl"
|
|
||||||
pure $ WooToken (read <$> i) (read o) t u
|
|
||||||
|
|
||||||
instance ToJSON WooToken where
|
|
||||||
toJSON (WooToken i o t u) =
|
|
||||||
case i of
|
|
||||||
Just oid ->
|
|
||||||
object
|
|
||||||
["_id" .= show oid, "ownerid" .= show o, "token" .= t, "siteurl" .= u]
|
|
||||||
Nothing ->
|
|
||||||
object
|
|
||||||
[ "_id" .= ("" :: String)
|
|
||||||
, "ownerid" .= show o
|
|
||||||
, "token" .= t
|
|
||||||
, "siteurl" .= u
|
|
||||||
]
|
|
||||||
|
|
||||||
instance Val WooToken where
|
instance Val WooToken where
|
||||||
val (WooToken i o t u) =
|
val (WooToken i o t u) =
|
||||||
if isJust i
|
if isJust i
|
||||||
|
@ -70,11 +47,8 @@ instance Val WooToken where
|
||||||
cast' _ = Nothing
|
cast' _ = Nothing
|
||||||
|
|
||||||
-- Database actions
|
-- Database actions
|
||||||
findWooToken :: Maybe ObjectId -> Action IO (Maybe Document)
|
findWooToken :: ObjectId -> Action IO (Maybe Document)
|
||||||
findWooToken oid =
|
findWooToken oid = findOne (select ["owner" =: oid] "wootokens")
|
||||||
case oid of
|
|
||||||
Nothing -> return Nothing
|
|
||||||
Just o -> findOne (select ["owner" =: o] "wootokens")
|
|
||||||
|
|
||||||
addUrl :: WooToken -> T.Text -> Action IO ()
|
addUrl :: WooToken -> T.Text -> Action IO ()
|
||||||
addUrl t u =
|
addUrl t u =
|
||||||
|
@ -89,9 +63,8 @@ payWooOrder ::
|
||||||
-> BS.ByteString -- Total ZEC for order
|
-> BS.ByteString -- Total ZEC for order
|
||||||
-> IO ()
|
-> IO ()
|
||||||
payWooOrder u i o t p z = do
|
payWooOrder u i o t p z = do
|
||||||
wooReq <- parseRequest u
|
wooReq <- parseRequest $ u ++ "/wc-api/zpmtcallback"
|
||||||
let req =
|
let req =
|
||||||
setRequestPath "/wp-json/wc/v3/zgocallback" $
|
|
||||||
setRequestQueryString
|
setRequestQueryString
|
||||||
[ ("token", Just t)
|
[ ("token", Just t)
|
||||||
, ("orderid", Just o)
|
, ("orderid", Just o)
|
||||||
|
@ -104,15 +77,23 @@ payWooOrder u i o t p z = do
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
if getResponseStatus res == ok200
|
if getResponseStatus res == ok200
|
||||||
then return ()
|
then return ()
|
||||||
else do
|
else error "Failed to report payment to WooCommerce"
|
||||||
print $ getResponseStatus res
|
|
||||||
error "Failed to report payment to WooCommerce"
|
|
||||||
|
|
||||||
generateWooToken :: Owner -> String -> Action IO ()
|
generateWooToken :: Owner -> Action IO ()
|
||||||
generateWooToken o s =
|
generateWooToken o =
|
||||||
case o_id o of
|
case o_id o of
|
||||||
Just ownerid -> do
|
Just ownerid -> do
|
||||||
let wooToken = val $ WooToken Nothing ownerid (T.pack s) Nothing
|
let tokenHash =
|
||||||
|
BLK.hash
|
||||||
|
[ BA.pack . BS.unpack . C.pack . T.unpack $ oname o <> oaddress o :: BA.Bytes
|
||||||
|
]
|
||||||
|
let wooToken =
|
||||||
|
val $
|
||||||
|
WooToken
|
||||||
|
Nothing
|
||||||
|
ownerid
|
||||||
|
(T.pack . show $ (tokenHash :: BLK.Digest BLK.DEFAULT_DIGEST_LEN))
|
||||||
|
Nothing
|
||||||
case wooToken of
|
case wooToken of
|
||||||
Doc wT -> insert_ "wootokens" wT
|
Doc wT -> insert_ "wootokens" wT
|
||||||
_ -> error "Couldn't create the WooCommerce token"
|
_ -> error "Couldn't create the WooCommerce token"
|
||||||
|
|
21
src/Xero.hs
21
src/Xero.hs
|
@ -171,26 +171,6 @@ instance FromJSON XeroTenant where
|
||||||
--u <- obj .: "updatedDateUtc"
|
--u <- obj .: "updatedDateUtc"
|
||||||
pure $ XeroTenant i aei tI tT tN
|
pure $ XeroTenant i aei tI tT tN
|
||||||
|
|
||||||
data XeroInvoiceRequest =
|
|
||||||
XeroInvoiceRequest
|
|
||||||
{ xr_owner :: T.Text
|
|
||||||
, xr_invNo :: T.Text
|
|
||||||
, xr_amount :: Double
|
|
||||||
, xr_currency :: T.Text
|
|
||||||
, xr_shortCode :: T.Text
|
|
||||||
}
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
instance FromJSON XeroInvoiceRequest where
|
|
||||||
parseJSON =
|
|
||||||
withObject "XeroInvoiceRequest" $ \obj -> do
|
|
||||||
o <- obj .: "ownerId"
|
|
||||||
i <- obj .: "invoice"
|
|
||||||
a <- obj .: "amount"
|
|
||||||
c <- obj .: "currency"
|
|
||||||
s <- obj .: "shortcode"
|
|
||||||
pure $ XeroInvoiceRequest o i a c s
|
|
||||||
|
|
||||||
data XeroInvoice =
|
data XeroInvoice =
|
||||||
XeroInvoice
|
XeroInvoice
|
||||||
{ xi_id :: Maybe ObjectId
|
{ xi_id :: Maybe ObjectId
|
||||||
|
@ -463,6 +443,5 @@ payXeroInvoice pipe dbName inv address amt zec = do
|
||||||
setRequestHost "api.xero.com" $
|
setRequestHost "api.xero.com" $
|
||||||
setRequestMethod "PUT" defaultRequest
|
setRequestMethod "PUT" defaultRequest
|
||||||
res <- httpJSON req :: IO (Response Object)
|
res <- httpJSON req :: IO (Response Object)
|
||||||
print res
|
|
||||||
return ()
|
return ()
|
||||||
else error "Invalid parameters"
|
else error "Invalid parameters"
|
||||||
|
|
|
@ -12,8 +12,6 @@ import Control.Concurrent (forkIO, threadDelay)
|
||||||
import Control.Exception (try)
|
import Control.Exception (try)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Crypto.RNG (newCryptoRNGState, runCryptoRNGT)
|
|
||||||
import Crypto.RNG.Utils (randomString)
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Array
|
import Data.Array
|
||||||
import qualified Data.Bson as B
|
import qualified Data.Bson as B
|
||||||
|
@ -39,7 +37,7 @@ import qualified Data.UUID as U
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import Data.Vector.Internal.Check (doChecks)
|
import Data.Vector.Internal.Check (doChecks)
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import Database.MongoDB hiding (Order)
|
import Database.MongoDB
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Item
|
import Item
|
||||||
|
@ -66,9 +64,6 @@ import Web.Scotty
|
||||||
import WooCommerce
|
import WooCommerce
|
||||||
import Xero
|
import Xero
|
||||||
import ZGoTx
|
import ZGoTx
|
||||||
import ZcashHaskell.Sapling
|
|
||||||
import ZcashHaskell.Types (RawData(..))
|
|
||||||
import ZcashHaskell.Utils (decodeBech32)
|
|
||||||
|
|
||||||
-- Models for API objects
|
-- Models for API objects
|
||||||
-- | A type to model Zcash RPC calls
|
-- | A type to model Zcash RPC calls
|
||||||
|
@ -591,7 +586,7 @@ routes pipe config = do
|
||||||
simpleCorsResourcePolicy
|
simpleCorsResourcePolicy
|
||||||
{ corsRequestHeaders = ["Authorization", "Content-Type"]
|
{ corsRequestHeaders = ["Authorization", "Content-Type"]
|
||||||
, corsMethods = "DELETE" : simpleMethods
|
, corsMethods = "DELETE" : simpleMethods
|
||||||
, corsOrigins = Nothing
|
--, corsOrigins = Nothing
|
||||||
}
|
}
|
||||||
middleware $
|
middleware $
|
||||||
basicAuth
|
basicAuth
|
||||||
|
@ -628,288 +623,102 @@ routes pipe config = do
|
||||||
])
|
])
|
||||||
get "/api/xerotoken" $ do
|
get "/api/xerotoken" $ do
|
||||||
code <- param "code"
|
code <- param "code"
|
||||||
session <- param "session"
|
address <- param "address"
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
|
||||||
xeroConfig <- liftAndCatchIO $ run findXero
|
xeroConfig <- liftAndCatchIO $ run findXero
|
||||||
case cast' . Doc =<< xeroConfig of
|
case xeroConfig of
|
||||||
Nothing -> status noContent204
|
Nothing -> status noContent204
|
||||||
Just c -> do
|
Just x -> do
|
||||||
case cast' . Doc =<< user of
|
let xConfig = cast' (Doc x)
|
||||||
Nothing -> status unauthorized401
|
case xConfig of
|
||||||
Just u -> do
|
Nothing -> status noContent204
|
||||||
|
Just c -> do
|
||||||
res <-
|
res <-
|
||||||
liftAndCatchIO $
|
liftAndCatchIO $
|
||||||
requestXeroToken pipe (c_dbName config) c code $ uaddress u
|
requestXeroToken pipe (c_dbName config) c code address
|
||||||
if res
|
if res
|
||||||
then status ok200
|
then status ok200
|
||||||
else status noContent204
|
else status noContent204
|
||||||
post "/invdata" $ do
|
get "/api/invdata" $ do
|
||||||
invData <- jsonData
|
inv <- param "inv"
|
||||||
|
oAddress <- param "address"
|
||||||
xeroConfig <- liftAndCatchIO $ run findXero
|
xeroConfig <- liftAndCatchIO $ run findXero
|
||||||
let invReq = payload (invData :: Payload XeroInvoiceRequest)
|
case xeroConfig of
|
||||||
case cast' . Doc =<< xeroConfig of
|
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
status noContent204
|
||||||
|
text "Xero App credentials not found"
|
||||||
|
Just x -> do
|
||||||
|
let xConfig = cast' (Doc x)
|
||||||
|
case xConfig of
|
||||||
|
Nothing -> do
|
||||||
|
status noContent204
|
||||||
|
text "Xero App credentials corrupted"
|
||||||
|
Just c -> do
|
||||||
|
res <-
|
||||||
|
liftAndCatchIO $
|
||||||
|
requestXeroToken pipe (c_dbName config) c "none" oAddress
|
||||||
|
if res
|
||||||
|
then do
|
||||||
|
resInv <-
|
||||||
|
liftAndCatchIO $
|
||||||
|
getXeroInvoice pipe (c_dbName config) inv oAddress
|
||||||
|
case resInv of
|
||||||
|
Nothing -> do
|
||||||
|
status noContent204
|
||||||
|
text "Xero invoice not found"
|
||||||
|
Just xI -> do
|
||||||
|
status ok200
|
||||||
|
Web.Scotty.json (object ["invdata" .= toJSON xI])
|
||||||
|
else status noContent204
|
||||||
|
-- Get the xeroaccount code
|
||||||
|
get "/api/xeroaccount" $ do
|
||||||
|
oAdd <- param "address"
|
||||||
|
res <- liftAndCatchIO $ run (findToken oAdd)
|
||||||
|
let c = cast' . Doc =<< res
|
||||||
|
case c of
|
||||||
|
Nothing -> status noContent204
|
||||||
|
Just c1 -> do
|
||||||
status ok200
|
status ok200
|
||||||
Web.Scotty.json
|
Web.Scotty.json
|
||||||
(object
|
(object
|
||||||
[ "reportType" .= (1 :: Integer)
|
[ "message" .= ("Xero account code found" :: String)
|
||||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
, "code" .= t_code c1
|
||||||
, "shop" .= (Nothing :: Maybe String)
|
|
||||||
])
|
])
|
||||||
Just c -> do
|
|
||||||
o <- liftAndCatchIO $ run $ findOwnerById $ xr_owner invReq
|
|
||||||
case cast' . Doc =<< o of
|
|
||||||
Nothing -> do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .= (2 :: Integer)
|
|
||||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .= (Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
Just o' -> do
|
|
||||||
existingOrder <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
run $
|
|
||||||
findXeroOrder
|
|
||||||
(oaddress o')
|
|
||||||
(xr_invNo invReq)
|
|
||||||
(xr_shortCode invReq)
|
|
||||||
case cast' . Doc =<< existingOrder of
|
|
||||||
Nothing -> do
|
|
||||||
res <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
requestXeroToken pipe (c_dbName config) c "none" $ oaddress o'
|
|
||||||
if res
|
|
||||||
then do
|
|
||||||
resInv <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
getXeroInvoice pipe (c_dbName config) (xr_invNo invReq) $
|
|
||||||
oaddress o'
|
|
||||||
case resInv of
|
|
||||||
Nothing -> do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .= (2 :: Integer)
|
|
||||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .= (Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
Just xI -> do
|
|
||||||
if xi_type xI == "ACCREC"
|
|
||||||
then if xi_status xI == "AUTHORISED"
|
|
||||||
then if xi_currency xI ==
|
|
||||||
T.toUpper (ocurrency o')
|
|
||||||
then if xi_total xI == xr_amount invReq
|
|
||||||
then do
|
|
||||||
now <- liftIO getCurrentTime
|
|
||||||
tk <- liftIO generateToken
|
|
||||||
pr <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
run
|
|
||||||
(findPrice $
|
|
||||||
T.unpack . ocurrency $ o')
|
|
||||||
case parseZGoPrice =<< pr of
|
|
||||||
Nothing -> do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .=
|
|
||||||
(7 :: Integer)
|
|
||||||
, "order" .=
|
|
||||||
(Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .=
|
|
||||||
(Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
Just cp -> do
|
|
||||||
let newOrder =
|
|
||||||
ZGoOrder
|
|
||||||
Nothing
|
|
||||||
(oaddress o')
|
|
||||||
("Xero-" <>
|
|
||||||
maybe
|
|
||||||
""
|
|
||||||
(T.pack . show)
|
|
||||||
(o_id o'))
|
|
||||||
now
|
|
||||||
True
|
|
||||||
(ocurrency o')
|
|
||||||
(price cp)
|
|
||||||
(xi_total xI)
|
|
||||||
(xi_total xI /
|
|
||||||
price cp)
|
|
||||||
[ LineItem
|
|
||||||
1
|
|
||||||
("Invoice from " <>
|
|
||||||
oname o' <>
|
|
||||||
" [" <>
|
|
||||||
xi_number xI <>
|
|
||||||
"]")
|
|
||||||
(xi_total xI)
|
|
||||||
]
|
|
||||||
False
|
|
||||||
(xi_number xI)
|
|
||||||
(xr_shortCode
|
|
||||||
invReq)
|
|
||||||
(T.pack tk)
|
|
||||||
_ <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
run $
|
|
||||||
upsertOrder newOrder
|
|
||||||
finalOrder <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
run $
|
|
||||||
findXeroOrder
|
|
||||||
(oaddress o')
|
|
||||||
(xi_number xI)
|
|
||||||
(xr_shortCode invReq)
|
|
||||||
case cast' . Doc =<<
|
|
||||||
finalOrder of
|
|
||||||
Nothing -> do
|
|
||||||
status
|
|
||||||
internalServerError500
|
|
||||||
text
|
|
||||||
"Unable to save order to DB"
|
|
||||||
Just fO -> do
|
|
||||||
status created201
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .=
|
|
||||||
(0 :: Integer)
|
|
||||||
, "order" .=
|
|
||||||
toJSON
|
|
||||||
(fO :: ZGoOrder)
|
|
||||||
, "shop" .=
|
|
||||||
oname o'
|
|
||||||
])
|
|
||||||
else do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .=
|
|
||||||
(8 :: Integer)
|
|
||||||
, "order" .=
|
|
||||||
(Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .=
|
|
||||||
(Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
else do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .= (7 :: Integer)
|
|
||||||
, "order" .=
|
|
||||||
(Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .=
|
|
||||||
(Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
else do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .= (6 :: Integer)
|
|
||||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .= (Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
else do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .= (5 :: Integer)
|
|
||||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .= (Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
else do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .= (1 :: Integer)
|
|
||||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
|
||||||
, "shop" .= (Nothing :: Maybe String)
|
|
||||||
])
|
|
||||||
Just eO -> do
|
|
||||||
status created201
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "reportType" .= (0 :: Integer)
|
|
||||||
, "order" .= toJSON (eO :: ZGoOrder)
|
|
||||||
, "shop" .= oname o'
|
|
||||||
])
|
|
||||||
-- Get the xeroaccount code
|
|
||||||
get "/api/xeroaccount" $ do
|
|
||||||
session <- param "session"
|
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
|
||||||
case cast' . Doc =<< user of
|
|
||||||
Nothing -> status unauthorized401
|
|
||||||
Just u -> do
|
|
||||||
res <- liftAndCatchIO $ run (findToken $ uaddress u)
|
|
||||||
let c = cast' . Doc =<< res
|
|
||||||
case c of
|
|
||||||
Nothing -> status noContent204
|
|
||||||
Just c1 -> do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "message" .= ("Xero account code found" :: String)
|
|
||||||
, "code" .= t_code c1
|
|
||||||
])
|
|
||||||
-- Save the xeroaccount code
|
-- Save the xeroaccount code
|
||||||
post "/api/xeroaccount" $ do
|
post "/api/xeroaccount" $ do
|
||||||
session <- param "session"
|
oAdd <- param "address"
|
||||||
c <- param "code"
|
c <- param "code"
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
liftAndCatchIO $ run (addAccCode oAdd c)
|
||||||
case cast' . Doc =<< user of
|
status accepted202
|
||||||
Nothing -> status unauthorized401
|
|
||||||
Just u -> do
|
|
||||||
let oAdd = uaddress u
|
|
||||||
liftAndCatchIO $ run (addAccCode oAdd c)
|
|
||||||
status accepted202
|
|
||||||
-- Get the WooCommerce token
|
-- Get the WooCommerce token
|
||||||
get "/api/wootoken" $ do
|
get "/api/wootoken" $ do
|
||||||
session <- param "session"
|
oid <- param "ownerid"
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
res <- liftAndCatchIO $ run (findWooToken (read oid))
|
||||||
case cast' . Doc =<< user of
|
let t1 = cast' . Doc =<< res
|
||||||
Nothing -> status unauthorized401
|
case t1 of
|
||||||
Just u -> do
|
Nothing -> status noContent204
|
||||||
owner <- liftAndCatchIO $ run (findOwner $ uaddress u)
|
Just t -> do
|
||||||
case cast' . Doc =<< owner of
|
status ok200
|
||||||
Nothing -> status internalServerError500
|
Web.Scotty.json
|
||||||
Just o -> do
|
(object
|
||||||
res <- liftAndCatchIO $ run (findWooToken $ o_id o)
|
[ "ownerid" .= show (w_owner t)
|
||||||
let t1 = cast' . Doc =<< res
|
, "token" .= w_token t
|
||||||
case t1 of
|
, "siteurl" .= w_url t
|
||||||
Nothing -> status noContent204
|
])
|
||||||
Just t -> do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "ownerid" .= show (w_owner t)
|
|
||||||
, "token" .= w_token t
|
|
||||||
, "siteurl" .= w_url t
|
|
||||||
])
|
|
||||||
post "/api/wootoken" $ do
|
post "/api/wootoken" $ do
|
||||||
oid <- param "ownerid"
|
oid <- param "ownerid"
|
||||||
session <- param "session"
|
res <- liftAndCatchIO $ run (findOwnerById oid)
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
let o1 = cast' . Doc =<< res
|
||||||
case cast' . Doc =<< user of
|
case o1 of
|
||||||
Nothing -> status unauthorized401
|
Nothing -> status noContent204
|
||||||
Just u -> do
|
Just o -> do
|
||||||
res <- liftAndCatchIO $ run (findOwnerById oid)
|
liftAndCatchIO $ run (generateWooToken o)
|
||||||
case cast' . Doc =<< res of
|
status accepted202
|
||||||
Nothing -> status badRequest400
|
|
||||||
Just o -> do
|
|
||||||
if oaddress o == uaddress u
|
|
||||||
then do
|
|
||||||
tk <- liftIO generateToken
|
|
||||||
liftAndCatchIO $ run (generateWooToken o tk)
|
|
||||||
status accepted202
|
|
||||||
else status forbidden403
|
|
||||||
-- Authenticate the WooCommerce plugin
|
-- Authenticate the WooCommerce plugin
|
||||||
get "/auth" $ do
|
get "/auth" $ do
|
||||||
oid <- param "ownerid"
|
oid <- param "ownerid"
|
||||||
t <- param "token"
|
t <- param "token"
|
||||||
siteurl <- param "siteurl"
|
siteurl <- param "siteurl"
|
||||||
res <- liftAndCatchIO $ run (findWooToken $ Just (read oid))
|
res <- liftAndCatchIO $ run (findWooToken (read oid))
|
||||||
let c1 = cast' . Doc =<< res
|
let c1 = cast' . Doc =<< res
|
||||||
case c1 of
|
case c1 of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -918,7 +727,7 @@ routes pipe config = do
|
||||||
(object
|
(object
|
||||||
["authorized" .= False, "message" .= ("Owner not found" :: String)])
|
["authorized" .= False, "message" .= ("Owner not found" :: String)])
|
||||||
Just c ->
|
Just c ->
|
||||||
if blk3Hash t == blk3Hash (T.unpack $ w_token c)
|
if t == w_token c
|
||||||
then if isNothing (w_url c)
|
then if isNothing (w_url c)
|
||||||
then do
|
then do
|
||||||
liftAndCatchIO $ run (addUrl c siteurl)
|
liftAndCatchIO $ run (addUrl c siteurl)
|
||||||
|
@ -956,10 +765,6 @@ routes pipe config = do
|
||||||
[ "authorized" .= False
|
[ "authorized" .= False
|
||||||
, "message" .= ("Token mismatch" :: String)
|
, "message" .= ("Token mismatch" :: String)
|
||||||
])
|
])
|
||||||
where blk3Hash :: String -> String
|
|
||||||
blk3Hash s =
|
|
||||||
show
|
|
||||||
(BLK.hash [BA.pack . BS.unpack . C.pack $ s :: BA.Bytes] :: BLK.Digest BLK.DEFAULT_DIGEST_LEN)
|
|
||||||
get "/woopayment" $ do
|
get "/woopayment" $ do
|
||||||
oid <- param "ownerid"
|
oid <- param "ownerid"
|
||||||
t <- param "token"
|
t <- param "token"
|
||||||
|
@ -969,7 +774,7 @@ routes pipe config = do
|
||||||
amount <- param "amount"
|
amount <- param "amount"
|
||||||
sUrl <- param "siteurl"
|
sUrl <- param "siteurl"
|
||||||
orderKey <- param "orderkey"
|
orderKey <- param "orderkey"
|
||||||
res <- liftAndCatchIO $ run (findWooToken $ Just (read oid))
|
res <- liftAndCatchIO $ run (findWooToken (read oid))
|
||||||
let c = cast' . Doc =<< res
|
let c = cast' . Doc =<< res
|
||||||
case c of
|
case c of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -1001,7 +806,6 @@ routes pipe config = do
|
||||||
Just o ->
|
Just o ->
|
||||||
if opaid o
|
if opaid o
|
||||||
then do
|
then do
|
||||||
tk <- liftIO generateToken
|
|
||||||
let newOrder =
|
let newOrder =
|
||||||
ZGoOrder
|
ZGoOrder
|
||||||
Nothing
|
Nothing
|
||||||
|
@ -1028,11 +832,9 @@ routes pipe config = do
|
||||||
(T.concat
|
(T.concat
|
||||||
[T.pack sUrl, "-", ordId, "-", orderKey])
|
[T.pack sUrl, "-", ordId, "-", orderKey])
|
||||||
""
|
""
|
||||||
(T.pack tk)
|
|
||||||
newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
|
newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
|
||||||
status ok200
|
status ok200
|
||||||
Web.Scotty.json
|
Web.Scotty.json (object ["order" .= show newId])
|
||||||
(object ["order" .= show newId, "token" .= tk])
|
|
||||||
else do
|
else do
|
||||||
status accepted202
|
status accepted202
|
||||||
Web.Scotty.json
|
Web.Scotty.json
|
||||||
|
@ -1091,20 +893,12 @@ routes pipe config = do
|
||||||
--Delete user
|
--Delete user
|
||||||
Web.Scotty.delete "/api/user/:id" $ do
|
Web.Scotty.delete "/api/user/:id" $ do
|
||||||
userId <- param "id"
|
userId <- param "id"
|
||||||
session <- param "session"
|
|
||||||
let r = mkRegex "^[a-f0-9]{24}$"
|
let r = mkRegex "^[a-f0-9]{24}$"
|
||||||
if matchTest r userId
|
if matchTest r userId
|
||||||
then do
|
then do
|
||||||
u <- liftAndCatchIO $ run (findUserById userId)
|
liftAndCatchIO $ run (deleteUser userId)
|
||||||
case cast' . Doc =<< u of
|
status ok200
|
||||||
Nothing -> status badRequest400
|
else status noContent204
|
||||||
Just u' ->
|
|
||||||
if session == usession u'
|
|
||||||
then do
|
|
||||||
liftAndCatchIO $ run (deleteUser userId)
|
|
||||||
status ok200
|
|
||||||
else status forbidden403
|
|
||||||
else status badRequest400
|
|
||||||
--Get current blockheight from Zcash node
|
--Get current blockheight from Zcash node
|
||||||
get "/blockheight" $ do
|
get "/blockheight" $ do
|
||||||
blockInfo <-
|
blockInfo <-
|
||||||
|
@ -1135,7 +929,7 @@ routes pipe config = do
|
||||||
[ "message" .= ("Owner found!" :: String)
|
[ "message" .= ("Owner found!" :: String)
|
||||||
, "owner" .= getOwnerSettings o
|
, "owner" .= getOwnerSettings o
|
||||||
])
|
])
|
||||||
get "/ownerid" $ do
|
get "/api/ownerid" $ do
|
||||||
id <- param "id"
|
id <- param "id"
|
||||||
owner <- liftAndCatchIO $ run (findOwnerById id)
|
owner <- liftAndCatchIO $ run (findOwnerById id)
|
||||||
case owner of
|
case owner of
|
||||||
|
@ -1149,7 +943,23 @@ routes pipe config = do
|
||||||
Web.Scotty.json
|
Web.Scotty.json
|
||||||
(object
|
(object
|
||||||
[ "message" .= ("Owner found!" :: String)
|
[ "message" .= ("Owner found!" :: String)
|
||||||
, "owner" .= getOwnerSettings q
|
, "owner" .=
|
||||||
|
object
|
||||||
|
[ "_id" .= (maybe "" show $ o_id q :: String)
|
||||||
|
, "address" .= oaddress q
|
||||||
|
, "name" .= oname q
|
||||||
|
, "currency" .= ocurrency q
|
||||||
|
, "tax" .= otax q
|
||||||
|
, "taxValue" .= otaxValue q
|
||||||
|
, "vat" .= ovat q
|
||||||
|
, "vatValue" .= ovatValue q
|
||||||
|
, "paid" .= opaid q
|
||||||
|
, "zats" .= ozats q
|
||||||
|
, "invoices" .= oinvoices q
|
||||||
|
, "expiration" .= oexpiration q
|
||||||
|
, "payconf" .= opayconf q
|
||||||
|
, "crmToken" .= ocrmToken q
|
||||||
|
]
|
||||||
])
|
])
|
||||||
--Upsert owner to DB
|
--Upsert owner to DB
|
||||||
post "/api/owner" $ do
|
post "/api/owner" $ do
|
||||||
|
@ -1205,99 +1015,33 @@ routes pipe config = do
|
||||||
liftAndCatchIO $ run $ updateOwnerSettings q
|
liftAndCatchIO $ run $ updateOwnerSettings q
|
||||||
status accepted202
|
status accepted202
|
||||||
else status noContent204
|
else status noContent204
|
||||||
post "/api/ownervk" $ do
|
|
||||||
s <- param "session"
|
|
||||||
u <- liftAndCatchIO $ run (findUser s)
|
|
||||||
o <- jsonData
|
|
||||||
let q = payload (o :: Payload String)
|
|
||||||
let qRaw = decodeBech32 $ C.pack q
|
|
||||||
if hrp qRaw == "fail"
|
|
||||||
then status badRequest400
|
|
||||||
else do
|
|
||||||
let qBytes = bytes qRaw
|
|
||||||
case cast' . Doc =<< u of
|
|
||||||
Nothing -> status unauthorized401
|
|
||||||
Just u' -> do
|
|
||||||
if isValidSaplingViewingKey qBytes
|
|
||||||
then if matchSaplingAddress
|
|
||||||
qBytes
|
|
||||||
(bytes . decodeBech32 . C.pack . T.unpack $ uaddress u')
|
|
||||||
then do
|
|
||||||
owner <- liftAndCatchIO $ run (findOwner $ uaddress u')
|
|
||||||
case cast' . Doc =<< owner of
|
|
||||||
Nothing -> status badRequest400
|
|
||||||
Just o' -> do
|
|
||||||
unless (oviewkey o' /= "") $ do
|
|
||||||
vkInfo <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
makeZcashCall
|
|
||||||
nodeUser
|
|
||||||
nodePwd
|
|
||||||
"z_importviewingkey"
|
|
||||||
[ Data.Aeson.String (T.strip . T.pack $ q)
|
|
||||||
, "no"
|
|
||||||
]
|
|
||||||
let content =
|
|
||||||
getResponseBody vkInfo :: RpcResponse Object
|
|
||||||
if isNothing (err content)
|
|
||||||
then do
|
|
||||||
_ <-
|
|
||||||
liftAndCatchIO $ run (upsertViewingKey o' q)
|
|
||||||
status created201
|
|
||||||
else do
|
|
||||||
text $ L.pack . show $ err content
|
|
||||||
status badRequest400
|
|
||||||
else status forbidden403
|
|
||||||
else status badRequest400
|
|
||||||
--Get items associated with the given address
|
--Get items associated with the given address
|
||||||
get "/api/items" $ do
|
get "/api/items" $ do
|
||||||
session <- param "session"
|
addr <- param "address"
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
items <- liftAndCatchIO $ run (findItems addr)
|
||||||
case cast' . Doc =<< user of
|
case items of
|
||||||
Nothing -> status forbidden403
|
[] -> status noContent204
|
||||||
Just u -> do
|
_ -> do
|
||||||
items <- liftAndCatchIO $ run (findItems $ uaddress u)
|
let pItems = map (cast' . Doc) items :: [Maybe Item]
|
||||||
case items of
|
status ok200
|
||||||
[] -> status noContent204
|
Web.Scotty.json
|
||||||
_ -> do
|
(object
|
||||||
let pItems = map (cast' . Doc) items :: [Maybe Item]
|
["message" .= ("Items found!" :: String), "items" .= toJSON pItems])
|
||||||
status ok200
|
|
||||||
Web.Scotty.json
|
|
||||||
(object
|
|
||||||
[ "message" .= ("Items found!" :: String)
|
|
||||||
, "items" .= toJSON pItems
|
|
||||||
])
|
|
||||||
--Upsert item
|
--Upsert item
|
||||||
post "/api/item" $ do
|
post "/api/item" $ do
|
||||||
i <- jsonData
|
i <- jsonData
|
||||||
session <- param "session"
|
let q = payload (i :: Payload Item)
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
_ <- liftAndCatchIO $ run (upsertItem q)
|
||||||
case cast' . Doc =<< user of
|
status created201
|
||||||
Nothing -> status forbidden403
|
|
||||||
Just u -> do
|
|
||||||
let q = payload (i :: Payload Item)
|
|
||||||
if uaddress u == iowner q
|
|
||||||
then do
|
|
||||||
_ <- liftAndCatchIO $ run (upsertItem q)
|
|
||||||
status created201
|
|
||||||
else status forbidden403
|
|
||||||
--Delete item
|
--Delete item
|
||||||
Web.Scotty.delete "/api/item/:id" $ do
|
Web.Scotty.delete "/api/item/:id" $ do
|
||||||
session <- param "session"
|
|
||||||
oId <- param "id"
|
oId <- param "id"
|
||||||
u' <- liftAndCatchIO $ checkUser run session
|
let r = mkRegex "^[a-f0-9]{24}$"
|
||||||
case u' of
|
if matchTest r oId
|
||||||
Nothing -> status forbidden403
|
then do
|
||||||
Just u -> do
|
liftAndCatchIO $ run (deleteItem oId)
|
||||||
i <- liftAndCatchIO $ run (findItemById oId)
|
status ok200
|
||||||
case cast' . Doc =<< i of
|
else status noContent204
|
||||||
Nothing -> status badRequest400
|
|
||||||
Just i' -> do
|
|
||||||
if iowner i' == uaddress u
|
|
||||||
then do
|
|
||||||
liftAndCatchIO $ run (deleteItem oId)
|
|
||||||
status ok200
|
|
||||||
else status forbidden403
|
|
||||||
--Get price for Zcash
|
--Get price for Zcash
|
||||||
get "/price" $ do
|
get "/price" $ do
|
||||||
curr <- param "currency"
|
curr <- param "currency"
|
||||||
|
@ -1313,48 +1057,39 @@ routes pipe config = do
|
||||||
])
|
])
|
||||||
--Get all closed orders for the address
|
--Get all closed orders for the address
|
||||||
get "/api/allorders" $ do
|
get "/api/allorders" $ do
|
||||||
session <- param "session"
|
addr <- param "address"
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
myOrders <- liftAndCatchIO $ run (findAllOrders addr)
|
||||||
case cast' . Doc =<< user of
|
case myOrders of
|
||||||
Nothing -> status unauthorized401
|
[] -> status noContent204
|
||||||
Just u -> do
|
_ -> do
|
||||||
myOrders <- liftAndCatchIO $ run (findAllOrders $ uaddress u)
|
let pOrders = map (cast' . Doc) myOrders :: [Maybe ZGoOrder]
|
||||||
case myOrders of
|
status ok200
|
||||||
[] -> status noContent204
|
Web.Scotty.json
|
||||||
_ -> do
|
(object
|
||||||
let pOrders = map (cast' . Doc) myOrders :: [Maybe ZGoOrder]
|
[ "message" .= ("Orders found!" :: String)
|
||||||
status ok200
|
, "orders" .= toJSON pOrders
|
||||||
Web.Scotty.json
|
])
|
||||||
(object
|
|
||||||
[ "message" .= ("Orders found!" :: String)
|
|
||||||
, "orders" .= toJSON pOrders
|
|
||||||
])
|
|
||||||
--Get order by id for receipts
|
--Get order by id for receipts
|
||||||
get "/order/:id" $ do
|
get "/api/order/:id" $ do
|
||||||
oId <- param "id"
|
oId <- param "id"
|
||||||
token <- param "token"
|
|
||||||
let r = mkRegex "^[a-f0-9]{24}$"
|
let r = mkRegex "^[a-f0-9]{24}$"
|
||||||
if matchTest r oId
|
if matchTest r oId
|
||||||
then do
|
then do
|
||||||
myOrder <- liftAndCatchIO $ run (findOrderById oId)
|
myOrder <- liftAndCatchIO $ run (findOrderById oId)
|
||||||
case cast' . Doc =<< myOrder of
|
case myOrder of
|
||||||
Nothing -> status noContent204
|
Nothing -> status noContent204
|
||||||
Just pOrder -> do
|
Just o -> do
|
||||||
if qtoken pOrder == token
|
let o' = cast' (Doc o)
|
||||||
then do
|
case o' of
|
||||||
shop <- liftAndCatchIO $ run (findOwner $ qaddress pOrder)
|
Nothing -> status internalServerError500
|
||||||
case cast' . Doc =<< shop of
|
Just pOrder -> do
|
||||||
Nothing -> status badRequest400
|
status ok200
|
||||||
Just s -> do
|
Web.Scotty.json
|
||||||
status ok200
|
(object
|
||||||
Web.Scotty.json
|
[ "message" .= ("Order found!" :: String)
|
||||||
(object
|
, "order" .= toJSON (pOrder :: ZGoOrder)
|
||||||
[ "message" .= ("Order found!" :: String)
|
])
|
||||||
, "order" .= toJSON (pOrder :: ZGoOrder)
|
else status noContent204
|
||||||
, "shop" .= (oname s :: T.Text)
|
|
||||||
])
|
|
||||||
else status forbidden403
|
|
||||||
else status badRequest400
|
|
||||||
--Get order by session
|
--Get order by session
|
||||||
get "/api/order" $ do
|
get "/api/order" $ do
|
||||||
sess <- param "session"
|
sess <- param "session"
|
||||||
|
@ -1397,37 +1132,13 @@ routes pipe config = do
|
||||||
post "/api/order" $ do
|
post "/api/order" $ do
|
||||||
newOrder <- jsonData
|
newOrder <- jsonData
|
||||||
let q = payload (newOrder :: Payload ZGoOrder)
|
let q = payload (newOrder :: Payload ZGoOrder)
|
||||||
session <- param "session"
|
_ <- liftAndCatchIO $ run (upsertOrder q)
|
||||||
user <- liftAndCatchIO $ run (findUser session)
|
status created201
|
||||||
case cast' . Doc =<< user of
|
|
||||||
Nothing -> status unauthorized401
|
|
||||||
Just u -> do
|
|
||||||
if uaddress u == qaddress q
|
|
||||||
then do
|
|
||||||
if qtoken q == ""
|
|
||||||
then do
|
|
||||||
t <- liftIO generateToken
|
|
||||||
_ <-
|
|
||||||
liftAndCatchIO $
|
|
||||||
run (upsertOrder $ setOrderToken (T.pack t) q)
|
|
||||||
status created201
|
|
||||||
else do
|
|
||||||
_ <- liftAndCatchIO $ run (upsertOrder q)
|
|
||||||
status created201
|
|
||||||
else status forbidden403
|
|
||||||
--Delete order
|
--Delete order
|
||||||
Web.Scotty.delete "/api/order/:id" $ do
|
Web.Scotty.delete "/api/order/:id" $ do
|
||||||
oId <- param "id"
|
oId <- param "id"
|
||||||
session <- param "session"
|
liftAndCatchIO $ run (deleteOrder oId)
|
||||||
o <- liftAndCatchIO $ run (findOrderById oId)
|
status ok200
|
||||||
case cast' . Doc =<< o of
|
|
||||||
Nothing -> status badRequest400
|
|
||||||
Just order -> do
|
|
||||||
if qsession order == session
|
|
||||||
then do
|
|
||||||
liftAndCatchIO $ run (deleteOrder oId)
|
|
||||||
status ok200
|
|
||||||
else status forbidden403
|
|
||||||
-- Get language for component
|
-- Get language for component
|
||||||
get "/getmainlang" $ do
|
get "/getmainlang" $ do
|
||||||
lang <- param "lang"
|
lang <- param "lang"
|
||||||
|
@ -1453,22 +1164,6 @@ routes pipe config = do
|
||||||
Just textPack -> do
|
Just textPack -> do
|
||||||
status ok200
|
status ok200
|
||||||
Web.Scotty.json $ toJSON (textPack :: LangComponent)
|
Web.Scotty.json $ toJSON (textPack :: LangComponent)
|
||||||
get "/getinvoicelang" $ do
|
|
||||||
lang <- param "lang"
|
|
||||||
txtPack' <- liftAndCatchIO $ run (findLangComponent lang "invoice")
|
|
||||||
case cast' . Doc =<< txtPack' of
|
|
||||||
Nothing -> status noContent204
|
|
||||||
Just textPack -> do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json $ toJSON (textPack :: LangComponent)
|
|
||||||
get "/getpmtservicelang" $ do
|
|
||||||
lang <- param "lang"
|
|
||||||
txtPack' <- liftAndCatchIO $ run (findLangComponent lang "pmtservice")
|
|
||||||
case cast' . Doc =<< txtPack' of
|
|
||||||
Nothing -> status noContent204
|
|
||||||
Just textPack -> do
|
|
||||||
status ok200
|
|
||||||
Web.Scotty.json $ toJSON (textPack :: LangComponent)
|
|
||||||
get "/api/getlang" $ do
|
get "/api/getlang" $ do
|
||||||
component <- param "component"
|
component <- param "component"
|
||||||
lang <- param "lang"
|
lang <- param "lang"
|
||||||
|
@ -1556,10 +1251,36 @@ listTxs user pwd a confs = do
|
||||||
Just e -> return $ Left $ "Error reading transactions: " <> emessage e
|
Just e -> return $ Left $ "Error reading transactions: " <> emessage e
|
||||||
Left ex -> return $ Left $ (T.pack . show) ex
|
Left ex -> return $ Left $ (T.pack . show) ex
|
||||||
|
|
||||||
|
-- | Function to check the ZGo full node for new txs
|
||||||
|
scanZcash :: Config -> Pipe -> IO ()
|
||||||
|
scanZcash config pipe = do
|
||||||
|
myTxs <-
|
||||||
|
listTxs (c_nodeUser config) (c_nodePwd config) (c_nodeAddress config) 1
|
||||||
|
case myTxs of
|
||||||
|
Right txs -> do
|
||||||
|
let r =
|
||||||
|
mkRegex
|
||||||
|
".*ZGO::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12})\\sReply-To:\\s(zs[a-z0-9]{76}).*"
|
||||||
|
let p =
|
||||||
|
mkRegex
|
||||||
|
".*ZGOp::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
|
||||||
|
let y =
|
||||||
|
mkRegex
|
||||||
|
".*MSG\\s(zs[a-z0-9]{76})\\s+ZGO::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
|
||||||
|
let k = map zToZGoTx (filter (isRelevant r) txs)
|
||||||
|
mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") k
|
||||||
|
let j = map zToZGoTx (filter (isRelevant p) txs)
|
||||||
|
mapM_ (upsertPayment pipe (c_dbName config)) j
|
||||||
|
let l = map zToZGoTx (filter (isRelevant y) txs)
|
||||||
|
mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") l
|
||||||
|
Left e -> do
|
||||||
|
putStrLn $ "Error scanning node transactions: " ++ T.unpack e
|
||||||
|
return ()
|
||||||
|
|
||||||
-- | Function to filter transactions
|
-- | Function to filter transactions
|
||||||
isRelevant :: Integer -> Text.Regex.Regex -> ZcashTx -> Bool
|
isRelevant :: Text.Regex.Regex -> ZcashTx -> Bool
|
||||||
isRelevant conf re t
|
isRelevant re t
|
||||||
| zconfirmations t < conf && (matchTest re . T.unpack . zmemo) t = True
|
| zconfirmations t < 100 && (matchTest re . T.unpack . zmemo) t = True
|
||||||
| otherwise = False
|
| otherwise = False
|
||||||
|
|
||||||
-- | New function to scan transactions with parser
|
-- | New function to scan transactions with parser
|
||||||
|
@ -1575,103 +1296,85 @@ scanZcash' config pipe = do
|
||||||
-- | Function to scan loaded viewing keys for payments
|
-- | Function to scan loaded viewing keys for payments
|
||||||
scanPayments :: Config -> Pipe -> IO ()
|
scanPayments :: Config -> Pipe -> IO ()
|
||||||
scanPayments config pipe = do
|
scanPayments config pipe = do
|
||||||
shopRecords <- access pipe master (c_dbName config) findActiveOwners
|
shops <- listAddresses (c_nodeUser config) (c_nodePwd config)
|
||||||
case shopRecords of
|
mapM_ (findPaidOrders config pipe) shops
|
||||||
[] -> return ()
|
where
|
||||||
_ -> do
|
findPaidOrders :: Config -> Pipe -> ZcashAddress -> IO ()
|
||||||
let shops = cast' . Doc <$> shopRecords :: [Maybe Owner]
|
findPaidOrders c p z = do
|
||||||
let validShopAddresses = map (maybe "" oaddress) $ filter isJust shops
|
paidTxs <- listTxs (c_nodeUser c) (c_nodePwd c) (addy z) 5
|
||||||
mapM_ (findPaidOrders config pipe) validShopAddresses
|
case paidTxs of
|
||||||
where findPaidOrders :: Config -> Pipe -> T.Text -> IO ()
|
Right txs -> do
|
||||||
findPaidOrders c p z = do
|
let r = mkRegex ".*ZGo Order::([0-9a-fA-F]{24}).*"
|
||||||
print z
|
let k = filter (isRelevant r) txs
|
||||||
paidTxs <- listTxs (c_nodeUser c) (c_nodePwd c) z 5
|
let j = map (getOrderId r) k
|
||||||
case paidTxs of
|
mapM_ (recordPayment p (c_dbName config)) j
|
||||||
Right txs -> do
|
mapM_ (access p master (c_dbName config) . markOrderPaid) j
|
||||||
let r = mkRegex ".*ZGo Order::([0-9a-fA-F]{24}).*"
|
Left e -> print e
|
||||||
let k = filter (isRelevant (c_confirmations c) r) txs
|
getOrderId :: Text.Regex.Regex -> ZcashTx -> (String, Double)
|
||||||
print k
|
getOrderId re t = do
|
||||||
let j = map (getOrderId r) k
|
let reg = matchAllText re (T.unpack $ zmemo t)
|
||||||
mapM_ (recordPayment p (c_dbName config) z) j
|
if not (null reg)
|
||||||
Left e -> print e
|
then (fst $ head reg ! 1, zamount t)
|
||||||
getOrderId :: Text.Regex.Regex -> ZcashTx -> (String, Double)
|
else ("", 0)
|
||||||
getOrderId re t = do
|
recordPayment :: Pipe -> T.Text -> (String, Double) -> IO ()
|
||||||
let reg = matchAllText re (T.unpack $ zmemo t)
|
recordPayment p dbName x = do
|
||||||
if not (null reg)
|
o <- access p master dbName $ findOrderById (fst x)
|
||||||
then (fst $ head reg ! 1, zamount t)
|
let xOrder = o >>= (cast' . Doc)
|
||||||
else ("", 0)
|
case xOrder of
|
||||||
recordPayment ::
|
Nothing -> error "Failed to retrieve order from database"
|
||||||
Pipe -> T.Text -> T.Text -> (String, Double) -> IO ()
|
Just xO ->
|
||||||
recordPayment p dbName z x = do
|
when
|
||||||
print x
|
(not (qpaid xO) &&
|
||||||
o <- access p master dbName $ findOrderById (fst x)
|
qexternalInvoice xO /= "" && qtotalZec xO == snd x) $ do
|
||||||
let xOrder = o >>= (cast' . Doc)
|
let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})"
|
||||||
case xOrder of
|
let sResult = matchAllText sReg (T.unpack $ qsession xO)
|
||||||
Nothing -> error "Failed to retrieve order from database"
|
if not (null sResult)
|
||||||
Just xO ->
|
then case fst $ head sResult ! 1 of
|
||||||
when
|
"Xero" -> do
|
||||||
(not (qpaid xO) && qtotalZec xO == snd x && z == qaddress xO) $ do
|
xeroConfig <- access p master dbName findXero
|
||||||
let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})"
|
let xC = xeroConfig >>= (cast' . Doc)
|
||||||
let sResult = matchAllText sReg (T.unpack $ qsession xO)
|
case xC of
|
||||||
if not (null sResult)
|
Nothing -> error "Failed to read Xero config"
|
||||||
then case fst $ head sResult ! 1 of
|
Just xConf -> do
|
||||||
"Xero" -> do
|
requestXeroToken p dbName xConf "" (qaddress xO)
|
||||||
xeroConfig <- access p master dbName findXero
|
payXeroInvoice
|
||||||
let xC = xeroConfig >>= (cast' . Doc)
|
p
|
||||||
case xC of
|
dbName
|
||||||
Nothing -> error "Failed to read Xero config"
|
(qexternalInvoice xO)
|
||||||
Just xConf -> do
|
(qaddress xO)
|
||||||
requestXeroToken
|
(qtotal xO)
|
||||||
p
|
(qtotalZec xO)
|
||||||
dbName
|
"WC" -> do
|
||||||
xConf
|
let wOwner = fst $ head sResult ! 2
|
||||||
""
|
wooT <-
|
||||||
(qaddress xO)
|
access p master dbName $ findWooToken (read wOwner)
|
||||||
payXeroInvoice
|
let wT = wooT >>= (cast' . Doc)
|
||||||
p
|
case wT of
|
||||||
dbName
|
Nothing -> error "Failed to read WooCommerce token"
|
||||||
(qexternalInvoice xO)
|
Just wt -> do
|
||||||
(qaddress xO)
|
let iReg = mkRegex "(.*)-(.*)-.*"
|
||||||
(qtotal xO)
|
let iResult =
|
||||||
(qtotalZec xO)
|
matchAllText
|
||||||
liftIO $
|
iReg
|
||||||
access p master dbName $ markOrderPaid x
|
(T.unpack $ qexternalInvoice xO)
|
||||||
"WC" -> do
|
if not (null iResult)
|
||||||
let wOwner = fst $ head sResult ! 2
|
then do
|
||||||
wooT <-
|
let wUrl =
|
||||||
access p master dbName $
|
E.decodeUtf8With lenientDecode .
|
||||||
findWooToken $ Just (read wOwner)
|
B64.decodeLenient . C.pack $
|
||||||
let wT = wooT >>= (cast' . Doc)
|
fst $ head iResult ! 1
|
||||||
case wT of
|
let iNum = fst $ head iResult ! 2
|
||||||
Nothing ->
|
payWooOrder
|
||||||
error "Failed to read WooCommerce token"
|
(T.unpack wUrl)
|
||||||
Just wt -> do
|
(C.pack iNum)
|
||||||
let iReg = mkRegex "(.*)-(.*)-.*"
|
(C.pack $ maybe "" show (q_id xO))
|
||||||
let iResult =
|
(C.pack . T.unpack $ w_token wt)
|
||||||
matchAllText
|
(C.pack . show $ qprice xO)
|
||||||
iReg
|
(C.pack . show $ qtotalZec xO)
|
||||||
(T.unpack $ qexternalInvoice xO)
|
else error
|
||||||
if not (null iResult)
|
"Couldn't parse externalInvoice for WooCommerce"
|
||||||
then do
|
_ -> putStrLn "Not an integration order"
|
||||||
let wUrl =
|
else putStrLn "Not an integration order"
|
||||||
E.decodeUtf8With lenientDecode .
|
|
||||||
B64.decodeLenient . C.pack $
|
|
||||||
fst $ head iResult ! 1
|
|
||||||
let iNum = fst $ head iResult ! 2
|
|
||||||
payWooOrder
|
|
||||||
(T.unpack wUrl)
|
|
||||||
(C.pack iNum)
|
|
||||||
(C.pack $ maybe "" show (q_id xO))
|
|
||||||
(C.pack . T.unpack $ w_token wt)
|
|
||||||
(C.pack . show $ qprice xO)
|
|
||||||
(C.pack . show $ qtotalZec xO)
|
|
||||||
liftIO $
|
|
||||||
access p master dbName $
|
|
||||||
markOrderPaid x
|
|
||||||
else error
|
|
||||||
"Couldn't parse externalInvoice for WooCommerce"
|
|
||||||
_ -> putStrLn "Not an integration order"
|
|
||||||
else liftIO $ access p master dbName $ markOrderPaid x
|
|
||||||
|
|
||||||
-- | RPC methods
|
-- | RPC methods
|
||||||
-- | List addresses with viewing keys loaded
|
-- | List addresses with viewing keys loaded
|
||||||
|
@ -1834,17 +1537,4 @@ expireProSessions pipe db = do
|
||||||
access pipe master db $ removePro (psaddress z)
|
access pipe master db $ removePro (psaddress z)
|
||||||
access pipe master db $ closeProSession z
|
access pipe master db $ closeProSession z
|
||||||
|
|
||||||
checkUser ::
|
|
||||||
(Action IO (Maybe Document) -> IO (Maybe Document))
|
|
||||||
-> T.Text
|
|
||||||
-> IO (Maybe User)
|
|
||||||
checkUser run s = do
|
|
||||||
user <- run (findUser s)
|
|
||||||
return $ cast' . Doc =<< user
|
|
||||||
|
|
||||||
generateToken :: IO String
|
|
||||||
generateToken = do
|
|
||||||
rngState <- newCryptoRNGState
|
|
||||||
runCryptoRNGT rngState $ randomString 24 "abcdef0123456789"
|
|
||||||
|
|
||||||
debug = flip trace
|
debug = flip trace
|
||||||
|
|
14
src/ZGoTx.hs
14
src/ZGoTx.hs
|
@ -119,6 +119,7 @@ type Parser = Parsec Void T.Text
|
||||||
|
|
||||||
pSession :: Parser MemoToken
|
pSession :: Parser MemoToken
|
||||||
pSession = do
|
pSession = do
|
||||||
|
optional spaceChar
|
||||||
string "ZGO"
|
string "ZGO"
|
||||||
pay <- optional $ char 'p'
|
pay <- optional $ char 'p'
|
||||||
string "::"
|
string "::"
|
||||||
|
@ -141,18 +142,13 @@ pSaplingAddress = do
|
||||||
|
|
||||||
pMsg :: Parser MemoToken
|
pMsg :: Parser MemoToken
|
||||||
pMsg = do
|
pMsg = do
|
||||||
msg <-
|
Msg . T.pack <$>
|
||||||
some
|
some (alphaNumChar <|> punctuationChar <|> charCategory OtherSymbol)
|
||||||
(alphaNumChar <|> punctuationChar <|> symbolChar <|>
|
|
||||||
charCategory OtherSymbol)
|
|
||||||
pure $ Msg . T.pack $ msg
|
|
||||||
|
|
||||||
pMemo :: Parser MemoToken
|
pMemo :: Parser MemoToken
|
||||||
pMemo = do
|
pMemo = do
|
||||||
optional $ some spaceChar
|
optional spaceChar
|
||||||
t <- pSession <|> pSaplingAddress <|> pMsg
|
pSession <|> pSaplingAddress <|> pMsg
|
||||||
optional $ some spaceChar
|
|
||||||
return t
|
|
||||||
|
|
||||||
isMemoToken :: T.Text -> MemoToken -> Bool
|
isMemoToken :: T.Text -> MemoToken -> Bool
|
||||||
isMemoToken kind t =
|
isMemoToken kind t =
|
||||||
|
|
12
stack.yaml
12
stack.yaml
|
@ -17,7 +17,7 @@
|
||||||
#
|
#
|
||||||
# resolver: ./custom-snapshot.yaml
|
# resolver: ./custom-snapshot.yaml
|
||||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||||
resolver: lts-20.23
|
resolver: lts-20.19
|
||||||
#url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
|
#url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml
|
||||||
|
|
||||||
# User packages to be built.
|
# User packages to be built.
|
||||||
|
@ -44,16 +44,6 @@ packages:
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- git: https://github.com/reach-sh/haskell-hexstring.git
|
- git: https://github.com/reach-sh/haskell-hexstring.git
|
||||||
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
|
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
|
||||||
- git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
|
||||||
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
|
|
||||||
- git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
|
|
||||||
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
|
|
||||||
- git: https://github.com/well-typed/borsh.git
|
|
||||||
commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
|
|
||||||
- aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
|
|
||||||
- vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
|
|
||||||
- generically-0.1.1
|
|
||||||
- vector-algorithms-0.9.0.1
|
|
||||||
- blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
|
- blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
|
||||||
- crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
|
- crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
|
||||||
# Override default flag values for local packages and extra-deps
|
# Override default flag values for local packages and extra-deps
|
||||||
|
|
|
@ -15,67 +15,6 @@ packages:
|
||||||
original:
|
original:
|
||||||
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
|
commit: 085c16fb21b9f856a435a3faab980e7e0b319341
|
||||||
git: https://github.com/reach-sh/haskell-hexstring.git
|
git: https://github.com/reach-sh/haskell-hexstring.git
|
||||||
- completed:
|
|
||||||
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
|
|
||||||
git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
|
||||||
name: zcash-haskell
|
|
||||||
pantry-tree:
|
|
||||||
sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
|
|
||||||
size: 1126
|
|
||||||
version: 0.1.0
|
|
||||||
original:
|
|
||||||
commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
|
|
||||||
git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
|
||||||
- completed:
|
|
||||||
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
|
|
||||||
git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
|
|
||||||
name: foreign-rust
|
|
||||||
pantry-tree:
|
|
||||||
sha256: be2f6fc0fab58a90fec657bdb6bd0ccf0810c7dccfe95c78b85e174fae227e42
|
|
||||||
size: 2315
|
|
||||||
version: 0.1.0
|
|
||||||
original:
|
|
||||||
commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
|
|
||||||
git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
|
|
||||||
- completed:
|
|
||||||
commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
|
|
||||||
git: https://github.com/well-typed/borsh.git
|
|
||||||
name: borsh
|
|
||||||
pantry-tree:
|
|
||||||
sha256: 8335925f495a5a653fcb74b6b8bb18cd0b6b7fe7099a1686108704e6ab82f47b
|
|
||||||
size: 2268
|
|
||||||
version: 0.3.0
|
|
||||||
original:
|
|
||||||
commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
|
|
||||||
git: https://github.com/well-typed/borsh.git
|
|
||||||
- completed:
|
|
||||||
hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
|
|
||||||
pantry-tree:
|
|
||||||
sha256: 58d33beedd6e0ff79920c636d8a4295deb684b6e97c9b1ca94d3c780958d6302
|
|
||||||
size: 82465
|
|
||||||
original:
|
|
||||||
hackage: aeson-2.1.2.1@sha256:5b8d62a60963a925c4d123a46e42a8e235a32188522c9f119f64ac228c2612a7,6359
|
|
||||||
- completed:
|
|
||||||
hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
|
|
||||||
pantry-tree:
|
|
||||||
sha256: d2461d28022c8c0a91da08b579b1bff478f617102d2f5ef596cc5b28d14b8b6a
|
|
||||||
size: 4092
|
|
||||||
original:
|
|
||||||
hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
|
|
||||||
- completed:
|
|
||||||
hackage: generically-0.1.1@sha256:2b9b5efb6eea2fb65377565d53d85b0ccc5b37404fba4bef1d60277caa877e5e,1155
|
|
||||||
pantry-tree:
|
|
||||||
sha256: 98a8fe89d516d3752a9cc0af22cfa652f098cc6613da080762b63aa1d596e56d
|
|
||||||
size: 233
|
|
||||||
original:
|
|
||||||
hackage: generically-0.1.1
|
|
||||||
- completed:
|
|
||||||
hackage: vector-algorithms-0.9.0.1@sha256:f3e5c6695529a94edf762117cafd91c989cb642ad3f8ca4014dbb13c8f6c2a20,3826
|
|
||||||
pantry-tree:
|
|
||||||
sha256: aef389e57ae6020e5da719bee40aaf6cccf1c4d1e7743a85d30c9d8c25d170a0
|
|
||||||
size: 1510
|
|
||||||
original:
|
|
||||||
hackage: vector-algorithms-0.9.0.1
|
|
||||||
- completed:
|
- completed:
|
||||||
hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
|
hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
|
||||||
pantry-tree:
|
pantry-tree:
|
||||||
|
@ -92,7 +31,7 @@ packages:
|
||||||
hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
|
hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
|
||||||
snapshots:
|
snapshots:
|
||||||
- completed:
|
- completed:
|
||||||
sha256: 4c972e067bae16b95961dbfdd12e07f1ee6c8fffabbfa05c3d65100b03f548b7
|
sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
|
||||||
size: 650253
|
size: 649618
|
||||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/23.yaml
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
|
||||||
original: lts-20.23
|
original: lts-20.19
|
||||||
|
|
622
test/Spec.hs
622
test/Spec.hs
|
@ -13,12 +13,10 @@ import Data.Either
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.SecureMem
|
import Data.SecureMem
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
import qualified Data.UUID as U
|
|
||||||
import Database.MongoDB
|
import Database.MongoDB
|
||||||
import Item
|
import Item
|
||||||
import LangComponent
|
import LangComponent
|
||||||
|
@ -34,7 +32,6 @@ import Test.Hspec.QuickCheck
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import Test.QuickCheck.Gen
|
import Test.QuickCheck.Gen
|
||||||
import Test.QuickCheck.Monadic
|
import Test.QuickCheck.Monadic
|
||||||
import Text.Megaparsec
|
|
||||||
import User
|
import User
|
||||||
import Web.Scotty
|
import Web.Scotty
|
||||||
import WooCommerce
|
import WooCommerce
|
||||||
|
@ -56,31 +53,7 @@ main = do
|
||||||
describe "hex strings" $ do
|
describe "hex strings" $ do
|
||||||
prop "encoding and decoding are inverse" $ \x ->
|
prop "encoding and decoding are inverse" $ \x ->
|
||||||
(decodeHexText . encodeHexText) x == x
|
(decodeHexText . encodeHexText) x == x
|
||||||
describe "zToZGoTx" $
|
describe "zToZGoTx" $ do
|
||||||
--prop "memo parsing" testMemoParser
|
|
||||||
do
|
|
||||||
it "parse ZecWallet memo" $ do
|
|
||||||
let m =
|
|
||||||
runParser
|
|
||||||
pZGoMemo
|
|
||||||
"Zecwalllet memo"
|
|
||||||
"ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
||||||
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" $ do
|
|
||||||
let m =
|
|
||||||
runParser
|
|
||||||
pZGoMemo
|
|
||||||
"Ywallet memo"
|
|
||||||
"\128737MSG\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e\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 "converts ZecWallet tx to ZGo tx" $ do
|
it "converts ZecWallet tx to ZGo tx" $ do
|
||||||
let t =
|
let t =
|
||||||
ZcashTx
|
ZcashTx
|
||||||
|
@ -183,13 +156,32 @@ main = do
|
||||||
getResponseStatus res `shouldBe` accepted202
|
getResponseStatus res `shouldBe` accepted202
|
||||||
describe "Price endpoint" $ do
|
describe "Price endpoint" $ do
|
||||||
it "returns a price for an existing currency" $ do
|
it "returns a price for an existing currency" $ do
|
||||||
req <- testGet "/price" [("currency", Just "usd")]
|
req <-
|
||||||
|
testGet
|
||||||
|
"/api/price"
|
||||||
|
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
||||||
|
, ("currency", Just "usd")
|
||||||
|
]
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
||||||
it "returns 204 when the currency is not supported" $ do
|
it "returns 204 when the currency is not supported" $ do
|
||||||
req <- testGet "/price" [("currency", Just "jpy")]
|
req <-
|
||||||
|
testGet
|
||||||
|
"/api/price"
|
||||||
|
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
||||||
|
, ("currency", Just "jpy")
|
||||||
|
]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` noContent204
|
getResponseStatus res `shouldBe` noContent204
|
||||||
|
it "returs 401 when the session is not valid" $ do
|
||||||
|
req <-
|
||||||
|
testGet
|
||||||
|
"/api/price"
|
||||||
|
[ ("session", Just "th7s1sa-fake-6u1d-7h47-1m4deuph3r3")
|
||||||
|
, ("currency", Just "usd")
|
||||||
|
]
|
||||||
|
res <- httpLBS req
|
||||||
|
getResponseStatus res `shouldBe` unauthorized401
|
||||||
describe "Countries endpoint" $ do
|
describe "Countries endpoint" $ do
|
||||||
it "returns a list of countries" $ do
|
it "returns a list of countries" $ do
|
||||||
req <-
|
req <-
|
||||||
|
@ -209,7 +201,7 @@ main = do
|
||||||
it "returns a block number" $ do
|
it "returns a block number" $ do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/blockheight"
|
"/api/blockheight"
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x ->
|
height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x ->
|
||||||
|
@ -233,32 +225,18 @@ main = do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/api/xeroaccount"
|
"/api/xeroaccount"
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
||||||
|
, ("address", Just "Zaddy")
|
||||||
|
]
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
||||||
it "reading returns 401 with invalid session" $ do
|
it "returns 401 with invalid session" $ do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/api/xeroaccount"
|
"/api/xeroaccount"
|
||||||
[("session", Just "fnelrkgnlyebrlvns82949")]
|
[("session", Just "fnelrkgnlyebrlvns82949")]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
getResponseStatus res `shouldBe` unauthorized401
|
||||||
it "setting returns 401 with invalid session" $ do
|
|
||||||
req <-
|
|
||||||
testPost
|
|
||||||
"/api/xeroaccount"
|
|
||||||
[("session", Just "fnelrkgnlyebrlvns82949")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
|
||||||
it "setting succeeds with valid session" $ do
|
|
||||||
req <-
|
|
||||||
testPost
|
|
||||||
"/api/xeroaccount"
|
|
||||||
[ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
|
||||||
, ("code", Just "ZEC")
|
|
||||||
]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` accepted202
|
|
||||||
describe "User endpoint" $ do
|
describe "User endpoint" $ do
|
||||||
it "returns a user for a session" $ do
|
it "returns a user for a session" $ do
|
||||||
req <-
|
req <-
|
||||||
|
@ -274,39 +252,14 @@ main = do
|
||||||
[("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
|
[("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
getResponseStatus res `shouldBe` unauthorized401
|
||||||
describe "delete" $ do
|
it "deletes user by id" $ do
|
||||||
it "returns 401 when session is invalid" $ do
|
req <-
|
||||||
req <-
|
testDelete
|
||||||
testDelete
|
"/api/user/"
|
||||||
"/api/user/"
|
"6272a90f2b05a74cf1000003"
|
||||||
"6272a90f2b05a74cf1000005"
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
||||||
[("session", Just "suchafak-euui-dican-eve-nbelieveitca")]
|
res <- httpLBS req
|
||||||
res <- httpLBS req
|
getResponseStatus res `shouldBe` ok200
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
|
||||||
it "returns 403 when user and session don't match" $ do
|
|
||||||
req <-
|
|
||||||
testDelete
|
|
||||||
"/api/user/"
|
|
||||||
"6272a90f2b05a74cf1000005"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` forbidden403
|
|
||||||
it "returns 400 when user is invalid" $ do
|
|
||||||
req <-
|
|
||||||
testDelete
|
|
||||||
"/api/user/"
|
|
||||||
"000000000000000000000000"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` badRequest400
|
|
||||||
it "deletes user by id" $ do
|
|
||||||
req <-
|
|
||||||
testDelete
|
|
||||||
"/api/user/"
|
|
||||||
"6272a90f2b05a74cf1000003"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` ok200
|
|
||||||
describe "Owner endpoint" $
|
describe "Owner endpoint" $
|
||||||
--prop "add owner" testOwnerAdd
|
--prop "add owner" testOwnerAdd
|
||||||
do
|
do
|
||||||
|
@ -341,90 +294,8 @@ main = do
|
||||||
]
|
]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` ok200
|
getResponseStatus res `shouldBe` ok200
|
||||||
describe "Order endpoints" $
|
describe "Order endpoints" $ do
|
||||||
--prop "upsert order" testOrderAdd
|
prop "upsert order" testOrderAdd
|
||||||
do
|
|
||||||
it "adding order with bad session fails with 401" $ do
|
|
||||||
myTs <- liftIO getCurrentTime
|
|
||||||
let testOrder =
|
|
||||||
ZGoOrder
|
|
||||||
(Just (read "627ab3ea2b05a76be3000011"))
|
|
||||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
||||||
myTs
|
|
||||||
False
|
|
||||||
"usd"
|
|
||||||
102.0
|
|
||||||
0
|
|
||||||
0
|
|
||||||
[]
|
|
||||||
False
|
|
||||||
""
|
|
||||||
""
|
|
||||||
"testToken4321"
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/order" $
|
|
||||||
A.object ["payload" A..= A.toJSON testOrder]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
|
||||||
it "adding order with mismatched session fails with 403" $ do
|
|
||||||
myTs <- liftIO getCurrentTime
|
|
||||||
let testOrder =
|
|
||||||
ZGoOrder
|
|
||||||
(Just (read "627ab3ea2b05a76be3000011"))
|
|
||||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
||||||
myTs
|
|
||||||
False
|
|
||||||
"usd"
|
|
||||||
102.0
|
|
||||||
0
|
|
||||||
0
|
|
||||||
[]
|
|
||||||
False
|
|
||||||
""
|
|
||||||
""
|
|
||||||
"testToken4321"
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/order" $
|
|
||||||
A.object ["payload" A..= A.toJSON testOrder]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` forbidden403
|
|
||||||
it "adding order with correct session succeeds" $ do
|
|
||||||
myTs <- liftIO getCurrentTime
|
|
||||||
let testOrder =
|
|
||||||
ZGoOrder
|
|
||||||
(Just (read "627ab3ea2b05a76be3000011"))
|
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
|
||||||
myTs
|
|
||||||
False
|
|
||||||
"usd"
|
|
||||||
102.0
|
|
||||||
0
|
|
||||||
0
|
|
||||||
[]
|
|
||||||
False
|
|
||||||
""
|
|
||||||
""
|
|
||||||
"testToken4321"
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/order" $
|
|
||||||
A.object ["payload" A..= A.toJSON testOrder]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` created201
|
|
||||||
it "get order by session" $ do
|
it "get order by session" $ do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
|
@ -432,7 +303,7 @@ main = do
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
||||||
it "get order by session fails with bad session" $ do
|
it "get order by session fails when invalid" $ do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/api/order"
|
"/api/order"
|
||||||
|
@ -442,49 +313,40 @@ main = do
|
||||||
it "get order by id" $ do
|
it "get order by id" $ do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/order/627ab3ea2b05a76be3000000"
|
"/api/order/627ab3ea2b05a76be3000000"
|
||||||
[("token", Just "testToken1234")]
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
||||||
it "get order with invalid id fails with 400" $ do
|
it "get order with wrong id" $ do
|
||||||
req <- testGet "/order/6273hrb" [("token", Just "testToken1234")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` badRequest400
|
|
||||||
it "get order by id fails with bad token" $ do
|
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/order/627ab3ea2b05a76be3000000"
|
"/api/order/6273hrb"
|
||||||
[("token", Just "wrongToken1234")]
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` forbidden403
|
getResponseStatus res `shouldBe` noContent204
|
||||||
|
it "get order by id fails with bad session" $ do
|
||||||
|
req <-
|
||||||
|
testGet
|
||||||
|
"/api/order/627ab3ea2b05a76be3000000"
|
||||||
|
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
||||||
|
res <- httpLBS req
|
||||||
|
getResponseStatus res `shouldBe` unauthorized401
|
||||||
it "get all orders for owner" $ do
|
it "get all orders for owner" $ do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/api/allorders"
|
"/api/allorders"
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
[ ("address", Just "Zaddy")
|
||||||
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
||||||
|
]
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
||||||
it "get all orders for owner fails with bad session" $ do
|
it "get all orders for owner fails with bad session" $ do
|
||||||
req <-
|
req <-
|
||||||
testGet
|
testGet
|
||||||
"/api/allorders"
|
"/api/allorders"
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
[ ("address", Just "Zaddy")
|
||||||
res <- httpLBS req
|
, ("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
]
|
||||||
it "delete order by id fails with mismatched session" $ do
|
|
||||||
req <-
|
|
||||||
testDelete
|
|
||||||
"/api/order/"
|
|
||||||
"627ab3ea2b05a76be3000000"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` forbidden403
|
|
||||||
it "delete order by id fails with bad session" $ do
|
|
||||||
req <-
|
|
||||||
testDelete
|
|
||||||
"/api/order/"
|
|
||||||
"627ab3ea2b05a76be3000000"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
getResponseStatus res `shouldBe` unauthorized401
|
||||||
it "delete order by id" $ do
|
it "delete order by id" $ do
|
||||||
|
@ -495,98 +357,35 @@ main = do
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` ok200
|
getResponseStatus res `shouldBe` ok200
|
||||||
describe "Item endpoint" $ do
|
it "delete order by id fails with bad session" $ do
|
||||||
it "adding item with bad session fails" $ do
|
|
||||||
let item =
|
|
||||||
Item
|
|
||||||
Nothing
|
|
||||||
"Table"
|
|
||||||
"Oak"
|
|
||||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
|
||||||
499.99
|
|
||||||
req <-
|
req <-
|
||||||
testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
|
testDelete
|
||||||
res <-
|
"/api/order/"
|
||||||
httpLBS $
|
"627ab3ea2b05a76be3000000"
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
|
||||||
it "adding item with good session succeeds" $ do
|
|
||||||
let item =
|
|
||||||
Item
|
|
||||||
(Just (read "627d7ba92b05a76be3000013"))
|
|
||||||
"Table"
|
|
||||||
"Oak"
|
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
||||||
499.99
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` created201
|
|
||||||
it "get items with valid session succeeds" $ do
|
|
||||||
req <-
|
|
||||||
testGet
|
|
||||||
"/api/items"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
res <- httpJSON req
|
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
||||||
it "get items with invalid session returns 401" $ do
|
|
||||||
req <-
|
|
||||||
testGet
|
|
||||||
"/api/items"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
getResponseStatus res `shouldBe` unauthorized401
|
||||||
describe "delete item" $ do
|
describe "Item endpoint" $ do
|
||||||
it "returns 401 with invalid session and item ID" $ do
|
prop "add item" testItemAdd
|
||||||
req <-
|
it "get items" $ do
|
||||||
testDelete
|
req <-
|
||||||
"/api/item/"
|
testGet
|
||||||
"627d7ba92b05a76be3000003"
|
"/api/items"
|
||||||
[("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
|
[ ("address", Just "Zaddy")
|
||||||
res <- httpLBS req
|
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
]
|
||||||
it "returns 403 when item ID doesn't belong to session" $ do
|
res <- httpJSON req
|
||||||
req <-
|
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
||||||
testDelete
|
it "delete item" $ do
|
||||||
"/api/item/"
|
req <-
|
||||||
"627d7ba92b05a76be3000003"
|
testDelete
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
"/api/item/"
|
||||||
res <- httpLBS req
|
"627d7ba92b05a76be3000003"
|
||||||
getResponseStatus res `shouldBe` forbidden403
|
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
||||||
it "succeeds with valid session and item ID" $ do
|
res <- httpLBS req
|
||||||
req <-
|
getResponseStatus res `shouldBe` ok200
|
||||||
testDelete
|
|
||||||
"/api/item/"
|
|
||||||
"627d7ba92b05a76be3000013"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` ok200
|
|
||||||
describe "WooCommerce endpoints" $ do
|
describe "WooCommerce endpoints" $ do
|
||||||
it "generate token with invalid session gives 401" $ do
|
it "generate token" $ do
|
||||||
req <-
|
|
||||||
testPost
|
|
||||||
"/api/wootoken"
|
|
||||||
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
||||||
, ("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")
|
|
||||||
]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
|
||||||
it "generate token with mismatched session gives 403" $ do
|
|
||||||
req <-
|
|
||||||
testPost
|
|
||||||
"/api/wootoken"
|
|
||||||
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
|
||||||
, ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")
|
|
||||||
]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` forbidden403
|
|
||||||
it "generate token with valid session succeeds" $ do
|
|
||||||
req <-
|
req <-
|
||||||
testPost
|
testPost
|
||||||
"/api/wootoken"
|
"/api/wootoken"
|
||||||
|
@ -595,20 +394,6 @@ main = do
|
||||||
]
|
]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` accepted202
|
getResponseStatus res `shouldBe` accepted202
|
||||||
it "read token gives 401 with bad session" $ do
|
|
||||||
req <-
|
|
||||||
testGet
|
|
||||||
"/api/wootoken"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
||||||
res <- httpLBS req
|
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
|
||||||
it "read token succeeds with valid session" $ do
|
|
||||||
req <-
|
|
||||||
testGet
|
|
||||||
"/api/wootoken"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
res <- httpJSON req
|
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
|
||||||
it "authenticate with incorrect owner" $ do
|
it "authenticate with incorrect owner" $ do
|
||||||
req <-
|
req <-
|
||||||
testPublicGet
|
testPublicGet
|
||||||
|
@ -632,17 +417,13 @@ main = do
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
|
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
|
||||||
it "authenticate with correct token" $ do
|
it "authenticate with correct token" $ do
|
||||||
req1 <-
|
|
||||||
testGet
|
|
||||||
"/api/wootoken"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
res1 <- httpJSON req1
|
|
||||||
let tk = getResponseBody (res1 :: Response WooToken)
|
|
||||||
req <-
|
req <-
|
||||||
testPublicGet
|
testPublicGet
|
||||||
"/auth"
|
"/auth"
|
||||||
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
||||||
, ("token", Just $ (E.encodeUtf8 . w_token) tk)
|
, ( "token"
|
||||||
|
, Just
|
||||||
|
"0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
|
||||||
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
||||||
]
|
]
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
|
@ -660,17 +441,13 @@ main = do
|
||||||
res <- httpJSON req
|
res <- httpJSON req
|
||||||
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
|
getResponseStatus (res :: Response A.Value) `shouldBe` accepted202
|
||||||
it "request order creation" $ do
|
it "request order creation" $ do
|
||||||
req1 <-
|
|
||||||
testGet
|
|
||||||
"/api/wootoken"
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
res1 <- httpJSON req1
|
|
||||||
let tk = getResponseBody (res1 :: Response WooToken)
|
|
||||||
req <-
|
req <-
|
||||||
testPublicGet
|
testPublicGet
|
||||||
"/woopayment"
|
"/woopayment"
|
||||||
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
[ ("ownerid", Just "627ad3492b05a76be3000001")
|
||||||
, ("token", Just $ (E.encodeUtf8 . w_token) tk)
|
, ( "token"
|
||||||
|
, Just
|
||||||
|
"0c1702c16c7bd7e075b8bb129b24888a5cc2181fa1eb4ce9190cfcb625ecf0ee")
|
||||||
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
, ("siteurl", Just "aHR0cHM6Ly93d3cudGVjcHJvdmFsLmNvbS8")
|
||||||
, ("order_id", Just "1234")
|
, ("order_id", Just "1234")
|
||||||
, ("currency", Just "usd")
|
, ("currency", Just "usd")
|
||||||
|
@ -721,63 +498,6 @@ main = do
|
||||||
]
|
]
|
||||||
res <- httpLBS req
|
res <- httpLBS req
|
||||||
getResponseStatus res `shouldBe` noContent204
|
getResponseStatus res `shouldBe` noContent204
|
||||||
describe "Viewing Key endpoint" $ do
|
|
||||||
let vk0 =
|
|
||||||
"zxviews1qwrw0jlxqqqqpqr9faepwqpgj09f0ee55mfwl60eumv6duk5pwncntweah0xdlhqrwre2fgmgersah9atx92z6pmxec8t32mpz59t47yuplkcdcaw3873aalv7e59xhwv846g9q9qjy0ypc68ceypg6pux490dr4snsc4m482l57rvnzj2lsh4f3dv6mltc75z72pypkx0dchwpumdwfuajstfhwulv30kjt5l0x7juwe523ufwz2xleplxf37gk2pfh59gmdjr4zsql4ga9p"
|
|
||||||
let vk1 =
|
|
||||||
"zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
|
|
||||||
let vk2 =
|
|
||||||
"zxviews1qdjagrrpqqqqpq8es75mlufakef0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
|
|
||||||
it "returns 401 with bad session" $ do
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/ownervk" $
|
|
||||||
A.object ["payload" A..= (vk0 :: String)]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` unauthorized401
|
|
||||||
it "returns 403 with mismatched session" $ do
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/ownervk" $
|
|
||||||
A.object ["payload" A..= (vk0 :: String)]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` forbidden403
|
|
||||||
it "returns 400 with malformed key" $ do
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/ownervk" $
|
|
||||||
A.object ["payload" A..= (vk2 :: String)]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` badRequest400
|
|
||||||
it "returns 400 with non-key valid bech32" $ do
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/ownervk" $
|
|
||||||
A.object ["payload" A..= ("bech321qqqsyrhqy2a" :: String)]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` badRequest400
|
|
||||||
it "succeeds with correct key" $ do
|
|
||||||
req <-
|
|
||||||
testPostJson "/api/ownervk" $
|
|
||||||
A.object ["payload" A..= (vk1 :: String)]
|
|
||||||
res <-
|
|
||||||
httpLBS $
|
|
||||||
setRequestQueryString
|
|
||||||
[("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
|
|
||||||
req
|
|
||||||
getResponseStatus res `shouldBe` created201
|
|
||||||
around handleDb $
|
around handleDb $
|
||||||
describe "Database actions" $ do
|
describe "Database actions" $ do
|
||||||
describe "authentication" $ do
|
describe "authentication" $ do
|
||||||
|
@ -792,7 +512,7 @@ main = do
|
||||||
doc <-
|
doc <-
|
||||||
access p master "test" $
|
access p master "test" $
|
||||||
findProSession
|
findProSession
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||||
doc `shouldNotBe` Nothing
|
doc `shouldNotBe` Nothing
|
||||||
it "upsert to DB" $ const pending
|
it "upsert to DB" $ const pending
|
||||||
describe "Zcash prices" $ do
|
describe "Zcash prices" $ do
|
||||||
|
@ -853,7 +573,7 @@ main = do
|
||||||
let myOrder =
|
let myOrder =
|
||||||
ZGoOrder
|
ZGoOrder
|
||||||
(Just (read "627ab3ea2b05a76be3000001"))
|
(Just (read "627ab3ea2b05a76be3000001"))
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"Zaddy"
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
||||||
myTs
|
myTs
|
||||||
False
|
False
|
||||||
|
@ -865,7 +585,6 @@ main = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
"testToken1234"
|
|
||||||
let ordTest = val myOrder
|
let ordTest = val myOrder
|
||||||
case ordTest of
|
case ordTest of
|
||||||
Doc oT -> access p master "test" (insert_ "orders" oT)
|
Doc oT -> access p master "test" (insert_ "orders" oT)
|
||||||
|
@ -881,26 +600,25 @@ main = do
|
||||||
Just o2 -> qpaid o2 `shouldBe` True
|
Just o2 -> qpaid o2 `shouldBe` True
|
||||||
describe "Xero data" $ do
|
describe "Xero data" $ do
|
||||||
it "token is saved" $ \p -> do
|
it "token is saved" $ \p -> do
|
||||||
t <-
|
let myToken =
|
||||||
access p master "test" $
|
XeroToken
|
||||||
findToken
|
Nothing
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"Zaddy"
|
||||||
|
"superFakeToken123"
|
||||||
|
1800
|
||||||
|
"anotherSuperFakeToken"
|
||||||
|
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
|
||||||
|
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
|
||||||
|
""
|
||||||
|
_ <- access p master "test" $ upsertToken myToken
|
||||||
|
t <- access p master "test" $ findToken "Zaddy"
|
||||||
let t1 = (cast' . Doc) =<< t
|
let t1 = (cast' . Doc) =<< t
|
||||||
case t1 of
|
case t1 of
|
||||||
Nothing -> True `shouldBe` False
|
Nothing -> True `shouldBe` False
|
||||||
Just t2 ->
|
Just t2 -> t_address t2 `shouldBe` "Zaddy"
|
||||||
t_address t2 `shouldBe`
|
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
||||||
it "code is saved" $ \p -> do
|
it "code is saved" $ \p -> do
|
||||||
_ <-
|
_ <- access p master "test" $ addAccCode "Zaddy" "ZEC"
|
||||||
access p master "test" $
|
t <- access p master "test" $ findToken "Zaddy"
|
||||||
addAccCode
|
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
||||||
"ZEC"
|
|
||||||
t <-
|
|
||||||
access p master "test" $
|
|
||||||
findToken
|
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
||||||
let t1 = (cast' . Doc) =<< t
|
let t1 = (cast' . Doc) =<< t
|
||||||
case t1 of
|
case t1 of
|
||||||
Nothing -> True `shouldBe` False
|
Nothing -> True `shouldBe` False
|
||||||
|
@ -932,7 +650,7 @@ main = do
|
||||||
let myUser =
|
let myUser =
|
||||||
User
|
User
|
||||||
(Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
|
(Just (read "6272a90f2b05a74cf1000002" :: ObjectId))
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcb"
|
||||||
1613487
|
1613487
|
||||||
"1234567"
|
"1234567"
|
||||||
|
@ -974,13 +692,13 @@ main = do
|
||||||
findOne
|
findOne
|
||||||
(select
|
(select
|
||||||
[ "address" =:
|
[ "address" =:
|
||||||
("zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4" :: T.Text)
|
("zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" :: T.Text)
|
||||||
]
|
]
|
||||||
"owners")
|
"owners")
|
||||||
let s = (cast' . Doc) =<< t
|
let s = (cast' . Doc) =<< t
|
||||||
let ownerPaid = maybe False opaid s
|
let ownerPaid = maybe False opaid s
|
||||||
ownerPaid `shouldBe` True
|
ownerPaid `shouldBe` True
|
||||||
_ -> True `shouldBe` False --`debug` "Failed parsing payment"
|
_ -> True `shouldBe` False `debug` "Failed parsing payment"
|
||||||
xit "owners are expired" $ \p -> do
|
xit "owners are expired" $ \p -> do
|
||||||
_ <- expireOwners p "test"
|
_ <- expireOwners p "test"
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
|
@ -999,7 +717,7 @@ main = do
|
||||||
let myTx =
|
let myTx =
|
||||||
ZGoTx
|
ZGoTx
|
||||||
Nothing
|
Nothing
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca"
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca"
|
||||||
3
|
3
|
||||||
1613487
|
1613487
|
||||||
|
@ -1082,23 +800,6 @@ testDelete endpoint par body = do
|
||||||
setRequestPath (B.append endpoint par) defaultRequest
|
setRequestPath (B.append endpoint par) defaultRequest
|
||||||
return testRequest
|
return testRequest
|
||||||
|
|
||||||
testMemoParser :: T.Text -> T.Text -> T.Text -> Property
|
|
||||||
testMemoParser t1 t2 t3 =
|
|
||||||
monadicIO $ do
|
|
||||||
let res =
|
|
||||||
runParser pZGoMemo "Parser test" $
|
|
||||||
t1 <>
|
|
||||||
" zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e " <>
|
|
||||||
t2 <> " ZGO::5d3d4494-51c0-432d-8495-050419957aea " <> t3
|
|
||||||
case res of
|
|
||||||
Left e -> assert False `debug` errorBundlePretty e
|
|
||||||
Right zm ->
|
|
||||||
assert $
|
|
||||||
U.fromString "5d3d4494-51c0-432d-8495-050419957aea" == m_session zm &&
|
|
||||||
Just
|
|
||||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e" ==
|
|
||||||
m_address zm
|
|
||||||
|
|
||||||
testOwnerAdd :: Owner -> Property
|
testOwnerAdd :: Owner -> Property
|
||||||
testOwnerAdd o =
|
testOwnerAdd o =
|
||||||
monadicIO $ do
|
monadicIO $ do
|
||||||
|
@ -1147,14 +848,6 @@ closeDbConnection = close
|
||||||
handleDb :: (Pipe -> Expectation) -> IO ()
|
handleDb :: (Pipe -> Expectation) -> IO ()
|
||||||
handleDb = bracket openDbConnection closeDbConnection
|
handleDb = bracket openDbConnection closeDbConnection
|
||||||
|
|
||||||
filterDocs :: Value -> Bool
|
|
||||||
filterDocs (Doc v) = True
|
|
||||||
filterDocs _ = False
|
|
||||||
|
|
||||||
unwrapDoc :: Value -> Document
|
|
||||||
unwrapDoc (Doc v) = v
|
|
||||||
unwrapDoc _ = []
|
|
||||||
|
|
||||||
startAPI :: Config -> IO ()
|
startAPI :: Config -> IO ()
|
||||||
startAPI config = do
|
startAPI config = do
|
||||||
putStrLn "Starting test server ..."
|
putStrLn "Starting test server ..."
|
||||||
|
@ -1167,39 +860,54 @@ startAPI config = do
|
||||||
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "users"))
|
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "users"))
|
||||||
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "items"))
|
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "items"))
|
||||||
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
|
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
|
||||||
_ <-
|
|
||||||
access pipe master "test" (Database.MongoDB.delete (select [] "xerotokens"))
|
|
||||||
let myUser =
|
let myUser =
|
||||||
User
|
User
|
||||||
(Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
|
(Just (read "6272a90f2b05a74cf1000001" :: ObjectId))
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
||||||
1613487
|
1613487
|
||||||
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
|
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
|
||||||
False
|
False
|
||||||
|
_ <-
|
||||||
|
access
|
||||||
|
pipe
|
||||||
|
master
|
||||||
|
"test"
|
||||||
|
(insert_
|
||||||
|
"users"
|
||||||
|
[ "address" =: uaddress myUser
|
||||||
|
, "_id" =: u_id myUser
|
||||||
|
, "session" =: usession myUser
|
||||||
|
, "blocktime" =: ublocktime myUser
|
||||||
|
, "pin" =: upin myUser
|
||||||
|
, "validated" =: uvalidated myUser
|
||||||
|
])
|
||||||
let myUser1 =
|
let myUser1 =
|
||||||
User
|
User
|
||||||
(Just (read "6272a90f2b05a74cf1000003" :: ObjectId))
|
(Just (read "6272a90f2b05a74cf1000003" :: ObjectId))
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdaa"
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
||||||
1613487
|
1613487
|
||||||
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
|
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
|
||||||
True
|
True
|
||||||
let myUser2 =
|
_ <-
|
||||||
User
|
access
|
||||||
(Just (read "6272a90f2b05a74cf1000005" :: ObjectId))
|
pipe
|
||||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
|
master
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dfake"
|
"test"
|
||||||
1613487
|
(insert_
|
||||||
"8ea140fbb30615d6cae383c4f62f3ad9afb10b804f63138d5b53990bd56e0162"
|
"users"
|
||||||
True
|
[ "address" =: uaddress myUser1
|
||||||
let userList =
|
, "_id" =: u_id myUser1
|
||||||
map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2]
|
, "session" =: usession myUser1
|
||||||
_ <- access pipe master "test" (insertAll_ "users" userList)
|
, "blocktime" =: ublocktime myUser1
|
||||||
|
, "pin" =: upin myUser1
|
||||||
|
, "validated" =: uvalidated myUser1
|
||||||
|
])
|
||||||
let myOwner =
|
let myOwner =
|
||||||
Owner
|
Owner
|
||||||
(Just (read "627ad3492b05a76be3000001"))
|
(Just (read "627ad3492b05a76be3000001"))
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||||
"Test shop"
|
"Test shop"
|
||||||
"usd"
|
"usd"
|
||||||
False
|
False
|
||||||
|
@ -1223,48 +931,17 @@ startAPI config = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
let myOwner1 =
|
|
||||||
Owner
|
|
||||||
(Just (read "627ad3492b05a76be3000008"))
|
|
||||||
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3fake"
|
|
||||||
"Test shop 2"
|
|
||||||
"usd"
|
|
||||||
False
|
|
||||||
0
|
|
||||||
False
|
|
||||||
0
|
|
||||||
"Roxy"
|
|
||||||
"Foo"
|
|
||||||
"roxy@zgo.cash"
|
|
||||||
"1 Main St"
|
|
||||||
"Mpls"
|
|
||||||
"Minnesota"
|
|
||||||
"55401"
|
|
||||||
""
|
|
||||||
"missyfoo.io"
|
|
||||||
"United States"
|
|
||||||
True
|
|
||||||
False
|
|
||||||
False
|
|
||||||
(UTCTime (fromGregorian 2023 8 6) (secondsToDiffTime 0))
|
|
||||||
False
|
|
||||||
""
|
|
||||||
""
|
|
||||||
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
|
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
|
||||||
let o = val myOwner
|
let o = val myOwner
|
||||||
case o of
|
case o of
|
||||||
Doc d -> access pipe master "test" (insert_ "owners" d)
|
Doc d -> access pipe master "test" (insert_ "owners" d)
|
||||||
_ -> fail "Couldn't save Owner in DB"
|
_ -> fail "Couldn't save Owner in DB"
|
||||||
let o1 = val myOwner1
|
|
||||||
case o1 of
|
|
||||||
Doc d1 -> access pipe master "test" (insert_ "owners" d1)
|
|
||||||
_ -> fail "Couldn't save Owner1 in DB"
|
|
||||||
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
|
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "orders"))
|
||||||
myTs <- liftIO getCurrentTime
|
myTs <- liftIO getCurrentTime
|
||||||
let myOrder =
|
let myOrder =
|
||||||
ZGoOrder
|
ZGoOrder
|
||||||
(Just (read "627ab3ea2b05a76be3000000"))
|
(Just (read "627ab3ea2b05a76be3000000"))
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"Zaddy"
|
||||||
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
"35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
|
||||||
myTs
|
myTs
|
||||||
False
|
False
|
||||||
|
@ -1276,7 +953,6 @@ startAPI config = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
"testToken1234"
|
|
||||||
let ordTest = val myOrder
|
let ordTest = val myOrder
|
||||||
case ordTest of
|
case ordTest of
|
||||||
Doc oT -> access pipe master "test" (insert_ "orders" oT)
|
Doc oT -> access pipe master "test" (insert_ "orders" oT)
|
||||||
|
@ -1295,24 +971,13 @@ startAPI config = do
|
||||||
let proSession1 =
|
let proSession1 =
|
||||||
ZGoProSession
|
ZGoProSession
|
||||||
Nothing
|
Nothing
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
"zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
|
||||||
myTs
|
myTs
|
||||||
False
|
False
|
||||||
let proSessionTest = val proSession1
|
let proSessionTest = val proSession1
|
||||||
case proSessionTest of
|
case proSessionTest of
|
||||||
Doc pS1 -> access pipe master "test" (insert_ "prosessions" pS1)
|
Doc pS1 -> access pipe master "test" (insert_ "prosessions" pS1)
|
||||||
_ -> fail "Couldn't save test ZGoProSession in DB"
|
_ -> fail "Couldn't save test ZGoProSession in DB"
|
||||||
let myToken =
|
|
||||||
XeroToken
|
|
||||||
Nothing
|
|
||||||
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
|
|
||||||
"superFakeToken123"
|
|
||||||
1800
|
|
||||||
"anotherSuperFakeToken"
|
|
||||||
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
|
|
||||||
(UTCTime (fromGregorian 2022 9 16) (secondsToDiffTime 0))
|
|
||||||
""
|
|
||||||
_ <- access pipe master "test" $ upsertToken myToken
|
|
||||||
--let myWooToken =
|
--let myWooToken =
|
||||||
--WooToken
|
--WooToken
|
||||||
--Nothing
|
--Nothing
|
||||||
|
@ -1341,8 +1006,7 @@ instance Arbitrary ZGoOrder where
|
||||||
l <- arbitrary
|
l <- arbitrary
|
||||||
pd <- arbitrary
|
pd <- arbitrary
|
||||||
eI <- arbitrary
|
eI <- arbitrary
|
||||||
sc <- arbitrary
|
ZGoOrder i a s ts c cur p t tZ l pd eI <$> arbitrary
|
||||||
ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary
|
|
||||||
|
|
||||||
instance Arbitrary LineItem where
|
instance Arbitrary LineItem where
|
||||||
arbitrary = do
|
arbitrary = do
|
||||||
|
|
|
@ -5,7 +5,7 @@ cabal-version: 1.12
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
|
|
||||||
name: zgo-backend
|
name: zgo-backend
|
||||||
version: 1.6.0
|
version: 1.5.0
|
||||||
synopsis: Haskell Back-end for the ZGo point-of-sale application
|
synopsis: Haskell Back-end for the ZGo point-of-sale application
|
||||||
description: Please see the README at <https://git.vergara.tech/Vergara_Tech//zgo-backend#readme>
|
description: Please see the README at <https://git.vergara.tech/Vergara_Tech//zgo-backend#readme>
|
||||||
category: Web
|
category: Web
|
||||||
|
@ -78,7 +78,6 @@ library
|
||||||
, wai-cors
|
, wai-cors
|
||||||
, wai-extra
|
, wai-extra
|
||||||
, warp-tls
|
, warp-tls
|
||||||
, zcash-haskell
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable zgo-backend-exe
|
executable zgo-backend-exe
|
||||||
|
@ -176,13 +175,10 @@ test-suite zgo-backend-test
|
||||||
, hspec-wai
|
, hspec-wai
|
||||||
, http-conduit
|
, http-conduit
|
||||||
, http-types
|
, http-types
|
||||||
, megaparsec
|
|
||||||
, mongoDB
|
, mongoDB
|
||||||
, scotty
|
, scotty
|
||||||
, securemem
|
, securemem
|
||||||
, text
|
, text
|
||||||
, time
|
, time
|
||||||
, uuid
|
|
||||||
, zcash-haskell
|
|
||||||
, zgo-backend
|
, zgo-backend
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
1
zgo.cfg
1
zgo.cfg
|
@ -6,7 +6,6 @@ dbUser = "zgo"
|
||||||
dbPassword = "zcashrules"
|
dbPassword = "zcashrules"
|
||||||
nodeUser = "zecwallet"
|
nodeUser = "zecwallet"
|
||||||
nodePassword = "rdsxlun6v4a"
|
nodePassword = "rdsxlun6v4a"
|
||||||
confirmations = 100
|
|
||||||
port = 3000
|
port = 3000
|
||||||
tls = false
|
tls = false
|
||||||
certificate = "/path/to/cert.pem"
|
certificate = "/path/to/cert.pem"
|
||||||
|
|
|
@ -6,7 +6,6 @@ dbUser = "zgo"
|
||||||
dbPassword = "zcashrules"
|
dbPassword = "zcashrules"
|
||||||
nodeUser = "zecwallet"
|
nodeUser = "zecwallet"
|
||||||
nodePassword = "rdsxlun6v4a"
|
nodePassword = "rdsxlun6v4a"
|
||||||
confirmations = 100
|
|
||||||
port = 3000
|
port = 3000
|
||||||
tls = false
|
tls = false
|
||||||
certificate = "/path/to/cert.pem"
|
certificate = "/path/to/cert.pem"
|
||||||
|
|
Loading…
Reference in a new issue