From 0f333fd92c8d83c958495f54ec4202c258d02c60 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 3 Aug 2022 13:48:51 -0500
Subject: [PATCH] Add CRM access token to Owner

---
 CHANGELOG.md      |  4 ++++
 src/Owner.hs      | 39 ++++++++++++++++++++++++++++++++++++---
 test/Spec.hs      |  7 ++++---
 zgo-backend.cabal |  2 +-
 4 files changed, 45 insertions(+), 7 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 84a4955..5c2b4e0 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+### Added
+
+- Field `crmToken` for `Owner`
+
 ## [1.0.0] - 2022-07-27
 
 ### Added
diff --git a/src/Owner.hs b/src/Owner.hs
index 7dd8cef..b6d81d7 100644
--- a/src/Owner.hs
+++ b/src/Owner.hs
@@ -40,11 +40,12 @@ data Owner =
     , oexpiration :: UTCTime
     , opayconf :: Bool
     , oviewkey :: T.Text
+    , ocrmToken :: T.Text
     }
   deriving (Eq, Show, Generic, Typeable)
 
 instance ToJSON Owner where
-  toJSON (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv eTs pc vk) =
+  toJSON (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv eTs pc vk cT) =
     case i of
       Just oid ->
         object
@@ -72,6 +73,7 @@ instance ToJSON Owner where
           , "expiration" .= eTs
           , "payconf" .= pc
           , "viewkey" .= vk
+          , "crmToken" .= cT
           ]
       Nothing ->
         object
@@ -99,6 +101,7 @@ instance ToJSON Owner where
           , "expiration" .= eTs
           , "payconf" .= pc
           , "viewkey" .= vk
+          , "crmToken" .= cT
           ]
 
 instance FromJSON Owner where
@@ -128,6 +131,7 @@ instance FromJSON Owner where
       ets <- obj .: "expiration"
       pc <- obj .:? "payconf"
       vk <- obj .:? "viewkey"
+      cT <- obj .:? "crmToken"
       pure $
         Owner
           (if not (null i)
@@ -156,6 +160,7 @@ instance FromJSON Owner where
           ets
           (fromMaybe False pc)
           (fromMaybe "" vk)
+          (fromMaybe "" cT)
 
 instance Val Owner where
   cast' (Doc d) = do
@@ -183,10 +188,36 @@ instance Val Owner where
     ets <- B.lookup "expiration" d
     pc <- B.lookup "payconf" d
     vk <- B.lookup "viewKey" d
+    cT <- B.lookup "crmToken" d
     Just
-      (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets pc vk)
+      (Owner
+         i
+         a
+         n
+         c
+         t
+         tV
+         v
+         vV
+         f
+         l
+         e
+         s
+         ct
+         st
+         p
+         ph
+         w
+         co
+         paid
+         zats
+         inv
+         ets
+         pc
+         vk
+         cT)
   cast' _ = Nothing
-  val (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets pc vk) =
+  val (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets pc vk cT) =
     case i of
       Just oid ->
         Doc
@@ -214,6 +245,7 @@ instance Val Owner where
           , "expiration" =: ets
           , "payconf" =: pc
           , "viewKey" =: vk
+          , "crmToken" =: cT
           ]
       Nothing ->
         Doc
@@ -240,6 +272,7 @@ instance Val Owner where
           , "expiration" =: ets
           , "payconf" =: pc
           , "viewKey" =: vk
+          , "crmToken" =: cT
           ]
 
 -- Database actions
diff --git a/test/Spec.hs b/test/Spec.hs
index 55c32f5..83cd2b9 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -74,7 +74,7 @@ main = do
               "ZGO::5d3d4494-51c0-432d-8495-050419957aea\nReply-To:\nzs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
       describe "PIN generator" $ do
         it "should give a 7 digit" $ do
-          length (T.unpack (unsafePerformIO generatePin)) `shouldBe` 7
+          length (T.unpack (unsafePerformIO (generatePin 1010))) `shouldBe` 7
     describe "API endpoints" $ do
       beforeAll_ (startAPI loadedConfig) $ do
         describe "Price endpoint" $ do
@@ -518,6 +518,7 @@ startAPI config = do
           (UTCTime (fromGregorian 2022 4 16) (secondsToDiffTime 0))
           False
           ""
+          ""
   _ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
   let o = val myOwner
   case o of
@@ -604,8 +605,8 @@ instance Arbitrary Owner where
     inv <- arbitrary
     exp <- arbitrary
     payconf <- arbitrary
-    --exp <- arbitrary
-    Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv exp payconf <$>
+    vk <- arbitrary
+    Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv exp payconf vk <$>
       arbitrary
 
 instance Arbitrary Item where
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index f77af56..2d5202d 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        0.1.0.2
+version:        1.0.0
 synopsis:       Haskell Back-end for the ZGo point-of-sale application
 description:    Please see the README on GitLab at <https://gitlab.com/pitmutt/zgo-backend#readme>
 category:       Web