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 category: Web