Update tests

package.yaml

@@ -161,3 +161,5 @@ tests:
     - time
     - configurator
     - scotty
+    - megaparsec
+    - uuid

src/ZGoTx.hs

@@ -119,7 +119,6 @@ type Parser = Parsec Void T.Text
 
 pSession :: Parser MemoToken
 pSession = do
-  optional spaceChar
   string "ZGO"
   pay <- optional $ char 'p'
   string "::"
@@ -142,13 +141,18 @@ pSaplingAddress = do
 
 pMsg :: Parser MemoToken
 pMsg = do
-  Msg . T.pack <$>
+  msg <-
-    some (alphaNumChar <|> punctuationChar <|> charCategory OtherSymbol)
+    some
+      (alphaNumChar <|> punctuationChar <|> symbolChar <|>
+       charCategory OtherSymbol)
+  pure $ Msg . T.pack $ msg
 
 pMemo :: Parser MemoToken
 pMemo = do
-  optional spaceChar
+  optional $ some spaceChar
-  pSession <|> pSaplingAddress <|> pMsg
+  t <- pSession <|> pSaplingAddress <|> pMsg
+  optional $ some spaceChar
+  return t
 
 isMemoToken :: T.Text -> MemoToken -> Bool
 isMemoToken kind t =

test/Spec.hs

@@ -17,6 +17,7 @@ import Data.Time
 import Data.Time.Calendar
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
+import qualified Data.UUID as U
 import Database.MongoDB
 import Item
 import LangComponent
@@ -32,6 +33,7 @@ import Test.Hspec.QuickCheck
 import Test.QuickCheck
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Monadic
+import Text.Megaparsec
 import User
 import Web.Scotty
 import WooCommerce
@@ -53,7 +55,31 @@ main = do
       describe "hex strings" $ do
         prop "encoding and decoding are inverse" $ \x ->
           (decodeHexText . encodeHexText) x == x
-      describe "zToZGoTx" $ do
+      describe "zToZGoTx" $
+        --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
           let t =
                 ZcashTx
@@ -156,32 +182,13 @@ main = do
             getResponseStatus res `shouldBe` accepted202
         describe "Price endpoint" $ do
           it "returns a price for an existing currency" $ do
-            req <-
+            req <- testGet "/price" [("currency", Just "usd")]
-              testGet
-                "/api/price"
-                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
-                , ("currency", Just "usd")
-                ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "returns 204 when the currency is not supported" $ do
-            req <-
+            req <- testGet "/price" [("currency", Just "jpy")]
-              testGet
-                "/api/price"
-                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
-                , ("currency", Just "jpy")
-                ]
             res <- httpLBS req
             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
           it "returns a list of countries" $ do
             req <-
@@ -201,7 +208,7 @@ main = do
           it "returns a block number" $ do
             req <-
               testGet
-                "/api/blockheight"
+                "/blockheight"
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             height (getResponseBody (res :: Response Block)) `shouldSatisfy` \x ->
@@ -800,6 +807,23 @@ testDelete endpoint par body = do
         setRequestPath (B.append endpoint par) defaultRequest
   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 o =
   monadicIO $ do

zgo-backend.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.5.0
+version:        1.5.1
 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>
 category:       Web
@@ -175,10 +175,12 @@ test-suite zgo-backend-test
     , hspec-wai
     , http-conduit
     , http-types
+    , megaparsec
     , mongoDB
     , scotty
     , securemem
     , text
     , time
+    , uuid
     , zgo-backend
   default-language: Haskell2010