Implement account code endpoint

CHANGELOG.md

@@ -8,6 +8,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Added
 
+- Tests for Xero account code
+- Fields in `XeroToken` for Xero payment account code
+- Support for the YWallet memo format
 - API endpoint to request a Xero invoice
 - API endpoint to generate ZGo order from external invoice
 - Type `XeroInvResponse`
@@ -18,6 +21,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Field `crmToken` for `Owner`
 - Field `externalInvoice` and `shortCode` for `Order`
 
+
 ## [1.0.0] - 2022-07-27
 
 ### Added

src/Xero.hs

@@ -52,11 +52,12 @@ data XeroToken =
     , t_refresh :: T.Text
     , t_accdte :: UTCTime
     , t_refdte :: UTCTime
+    , t_code :: T.Text
     }
   deriving (Eq, Show)
 
 instance ToJSON XeroToken where
-  toJSON (XeroToken i a t e r aD d) =
+  toJSON (XeroToken i a t e r aD d c) =
     case i of
       Just oid ->
         object
@@ -67,6 +68,7 @@ instance ToJSON XeroToken where
           , "refreshToken" .= r
           , "accExpires" .= aD
           , "refExpires" .= d
+          , "accCode" .= c
           ]
       Nothing ->
         object
@@ -77,6 +79,7 @@ instance ToJSON XeroToken where
           , "refreshToken" .= r
           , "accExpires" .= aD
           , "refExpires" .= d
+          , "accCode" .= c
           ]
 
 instance FromJSON XeroToken where
@@ -94,9 +97,10 @@ instance FromJSON XeroToken where
           r
           (UTCTime (fromGregorian 2000 1 1) (secondsToDiffTime 0))
           (UTCTime (fromGregorian 2000 1 1) (secondsToDiffTime 0))
+          ""
 
 instance Val XeroToken where
-  val (XeroToken i a t e r aD d) =
+  val (XeroToken i a t e r aD d c) =
     if isJust i
       then Doc
              [ "_id" =: i
@@ -106,6 +110,7 @@ instance Val XeroToken where
              , "refreshToken" =: r
              , "accExpires" =: aD
              , "refExpires" =: d
+             , "accCode" =: c
              ]
       else Doc
              [ "address" =: a
@@ -114,6 +119,7 @@ instance Val XeroToken where
              , "refreshToken" =: r
              , "accExpires" =: aD
              , "refExpires" =: d
+             --, "accCode" =: c
              ]
   cast' (Doc d) = do
     i <- B.lookup "_id" d
@@ -122,8 +128,9 @@ instance Val XeroToken where
     e <- B.lookup "expires" d
     r <- B.lookup "refreshToken" d
     aD <- B.lookup "accExpires" d
-    d <- B.lookup "refExpires" d
-    Just (XeroToken i a t e r aD d)
+    dte <- B.lookup "refExpires" d
+    c <- B.lookup "accCode" d
+    Just (XeroToken i a t e r aD dte c)
   cast' _ = Nothing
 
 processToken :: XeroToken -> T.Text -> IO XeroToken
@@ -138,6 +145,7 @@ processToken t a = do
       (t_refresh t)
       (addUTCTime (fromIntegral $ t_expires t) now)
       (addUTCTime 5184000 now)
+      (t_code t)
 
 -- |Type to represent a Xero tenant
 data XeroTenant =
@@ -265,8 +273,13 @@ upsertToken t = do
   let token = val t
   case token of
     Doc d -> do
-      upsert (select ["address" =: t_address t] "xerotokens") d
-      findOne (select ["address" =: t_address t] "xerotokens")
+      if isJust (t_id t)
+        then do
+          upsert (select ["address" =: t_address t] "xerotokens") d
+          findOne (select ["address" =: t_address t] "xerotokens")
+        else do
+          insert_ "xerotokens" d
+          findOne (select ["address" =: t_address t] "xerotokens")
     _ -> return Nothing
 
 findToken :: T.Text -> Action IO (Maybe Document)
@@ -310,6 +323,11 @@ requestXeroToken pipe dbName cred code address = do
       print res
       return False
 
+-- |Function to add a Xero account code to the database
+addAccCode :: T.Text -> T.Text -> Action IO ()
+addAccCode a c =
+  modify (select ["address" =: a] "xerotokens") ["$set" =: ["accCode" =: c]]
+
 -- |Helper function to obtain the authentication event ID
 extractEventId :: T.Text -> Maybe Data.Aeson.Value
 extractEventId t = do

src/ZGoBackend.hs

@@ -568,7 +568,8 @@ routes pipe config = do
             text "Xero App credentials corrupted"
           Just c -> do
             res <-
-              liftIO $ requestXeroToken pipe (c_dbName config) c "none" oAddress
+              liftAndCatchIO $
+              requestXeroToken pipe (c_dbName config) c "none" oAddress
             if res
               then do
                 resInv <-
@@ -582,6 +583,26 @@ routes pipe config = 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 <- liftIO $ run (findToken oAdd)
+    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
+  post "/api/xeroaccount" $ do
+    oAdd <- param "address"
+    c <- param "code"
+    liftAndCatchIO $ run (addAccCode oAdd c)
+    status created201
   --Get user associated with session
   get "/api/user" $ do
     sess <- param "session"

test/Spec.hs

@@ -166,6 +166,10 @@ main = do
             req <- testGet "/api/xero" []
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
+          it "returns the account code" $ do
+            req <- testGet "/api/xeroaccount" [("address", Just "Zaddy")]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
         describe "User endpoint" $ do
           it "returns a user for a session" $ do
             req <-
@@ -348,12 +352,20 @@ main = do
                     "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
             case t1 of
               Nothing -> True `shouldBe` False
               Just t2 -> t_address t2 `shouldBe` "Zaddy"
+          it "code is saved" $ \p -> do
+            _ <- access p master "test" $ addAccCode "Zaddy" "ZEC"
+            t <- access p master "test" $ findToken "Zaddy"
+            let t1 = (cast' . Doc) =<< t
+            case t1 of
+              Nothing -> True `shouldBe` False
+              Just t2 -> t_code t2 `shouldBe` "ZEC"
         describe "Zcash transactions" $ do
           xit "logins are added to db" $ \p -> do
             _ <-
@@ -723,4 +735,5 @@ instance Arbitrary XeroToken where
     e <- arbitrary
     r <- arbitrary
     aD <- arbitrary
-    XeroToken i a t e r aD <$> arbitrary
+    dt <- arbitrary
+    XeroToken i a t e r aD dt <$> arbitrary