Add tip setting to owners

This commit is contained in:
Rene Vergara 2023-10-19 14:47:57 -05:00
parent 1c3dfd2da1
commit 7daa9a9687
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
3 changed files with 66 additions and 6 deletions

View File

@ -40,10 +40,11 @@ data Owner = Owner
, opayconf :: Bool
, oviewkey :: T.Text
, ocrmToken :: T.Text
, otips :: Bool
} 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 cT) =
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 oT) =
case i of
Just oid ->
object
@ -72,6 +73,7 @@ instance ToJSON Owner where
, "payconf" .= pc
, "viewkey" .= vk
, "crmToken" .= cT
, "tips" .= oT
]
Nothing ->
object
@ -100,6 +102,7 @@ instance ToJSON Owner where
, "payconf" .= pc
, "viewkey" .= vk
, "crmToken" .= cT
, "tips" .= oT
]
instance FromJSON Owner where
@ -130,6 +133,7 @@ instance FromJSON Owner where
pc <- obj .:? "payconf"
vk <- obj .:? "viewkey"
cT <- obj .:? "crmToken"
oT <- obj .:? "tips"
pure $
Owner
(if not (null i)
@ -159,6 +163,7 @@ instance FromJSON Owner where
(fromMaybe False pc)
(fromMaybe "" vk)
(fromMaybe "" cT)
(fromMaybe False oT)
instance Val Owner where
cast' (Doc d) = do
@ -187,6 +192,7 @@ instance Val Owner where
pc <- B.lookup "payconf" d
vk <- B.lookup "viewKey" d
cT <- B.lookup "crmToken" d
oT <- B.lookup "tips" d
Just
(Owner
i
@ -213,9 +219,10 @@ instance Val Owner where
ets
pc
vk
cT)
cT
oT)
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 cT) =
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 oT) =
case i of
Just oid ->
Doc
@ -244,6 +251,7 @@ instance Val Owner where
, "payconf" =: pc
, "viewKey" =: vk
, "crmToken" =: cT
, "tips" =: oT
]
Nothing ->
Doc
@ -271,6 +279,7 @@ instance Val Owner where
, "payconf" =: pc
, "viewKey" =: vk
, "crmToken" =: cT
, "tips" =: oT
]
-- | Type to represent informational data for Owners from UI
@ -320,6 +329,7 @@ data OwnerSettings = OwnerSettings
, os_payconf :: Bool
, os_crmToken :: T.Text
, os_viewKey :: T.Text
, os_tips :: Bool
} deriving (Eq, Show, Generic)
instance FromJSON OwnerSettings where
@ -340,11 +350,28 @@ instance FromJSON OwnerSettings where
pc <- obj .: "payconf"
cT <- obj .: "crmToken"
vK <- obj .: "viewkey"
oT <- obj .: "tips"
pure $
OwnerSettings ((Just . read) =<< i) a n c t tV v vV p z inv e pc cT vK
OwnerSettings
((Just . read) =<< i)
a
n
c
t
tV
v
vV
p
z
inv
e
pc
cT
vK
oT
instance ToJSON OwnerSettings where
toJSON (OwnerSettings i a n c t tV v vV p z inv e pc cT vK) =
toJSON (OwnerSettings i a n c t tV v vV p z inv e pc cT vK oT) =
object
[ "_id" .= maybe "" show i
, "address" .= a
@ -361,6 +388,7 @@ instance ToJSON OwnerSettings where
, "payconf" .= pc
, "crmToken" .= cT
, "viewkey" .= keyObfuscate vK
, "tips" .= oT
]
where
keyObfuscate s
@ -386,6 +414,7 @@ getOwnerSettings o =
(opayconf o)
(ocrmToken o)
(oviewkey o)
(otips o)
-- Database actions
-- | Function to upsert an Owner

View File

@ -1201,6 +1201,7 @@ routes pipe config = do
False
""
""
False
status accepted202
post "/api/ownersettings" $ do
s <- param "session"

View File

@ -1248,6 +1248,7 @@ startAPI config = do
False
""
""
False
let myOwner1 =
Owner
(Just (read "627ad3492b05a76be3000008"))
@ -1275,6 +1276,7 @@ startAPI config = do
False
""
""
False
let myOwner2 =
Owner
(Just (read "627ad3492b05a76be3700008"))
@ -1302,6 +1304,7 @@ startAPI config = do
False
""
""
False
let myOwner3 =
Owner
(Just (read "627ad3492b05a76be3750008"))
@ -1329,6 +1332,7 @@ startAPI config = do
False
""
""
False
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
let o = val myOwner
case o of
@ -1468,7 +1472,33 @@ instance Arbitrary Owner where
exp <- arbitrary
payconf <- arbitrary
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 <$>
cT <- 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
cT <$>
arbitrary
instance Arbitrary Item where