Add tip setting to owners
This commit is contained in:
parent
1c3dfd2da1
commit
7daa9a9687
3 changed files with 66 additions and 6 deletions
39
src/Owner.hs
39
src/Owner.hs
|
@ -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
|
||||
|
|
|
@ -1201,6 +1201,7 @@ routes pipe config = do
|
|||
False
|
||||
""
|
||||
""
|
||||
False
|
||||
status accepted202
|
||||
post "/api/ownersettings" $ do
|
||||
s <- param "session"
|
||||
|
|
32
test/Spec.hs
32
test/Spec.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue