Unified Address support #8
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
|
, opayconf :: Bool
|
||||||
, oviewkey :: T.Text
|
, oviewkey :: T.Text
|
||||||
, ocrmToken :: T.Text
|
, ocrmToken :: T.Text
|
||||||
|
, otips :: Bool
|
||||||
} deriving (Eq, Show, Generic, Typeable)
|
} deriving (Eq, Show, Generic, Typeable)
|
||||||
|
|
||||||
instance ToJSON Owner where
|
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
|
case i of
|
||||||
Just oid ->
|
Just oid ->
|
||||||
object
|
object
|
||||||
|
@ -72,6 +73,7 @@ instance ToJSON Owner where
|
||||||
, "payconf" .= pc
|
, "payconf" .= pc
|
||||||
, "viewkey" .= vk
|
, "viewkey" .= vk
|
||||||
, "crmToken" .= cT
|
, "crmToken" .= cT
|
||||||
|
, "tips" .= oT
|
||||||
]
|
]
|
||||||
Nothing ->
|
Nothing ->
|
||||||
object
|
object
|
||||||
|
@ -100,6 +102,7 @@ instance ToJSON Owner where
|
||||||
, "payconf" .= pc
|
, "payconf" .= pc
|
||||||
, "viewkey" .= vk
|
, "viewkey" .= vk
|
||||||
, "crmToken" .= cT
|
, "crmToken" .= cT
|
||||||
|
, "tips" .= oT
|
||||||
]
|
]
|
||||||
|
|
||||||
instance FromJSON Owner where
|
instance FromJSON Owner where
|
||||||
|
@ -130,6 +133,7 @@ instance FromJSON Owner where
|
||||||
pc <- obj .:? "payconf"
|
pc <- obj .:? "payconf"
|
||||||
vk <- obj .:? "viewkey"
|
vk <- obj .:? "viewkey"
|
||||||
cT <- obj .:? "crmToken"
|
cT <- obj .:? "crmToken"
|
||||||
|
oT <- obj .:? "tips"
|
||||||
pure $
|
pure $
|
||||||
Owner
|
Owner
|
||||||
(if not (null i)
|
(if not (null i)
|
||||||
|
@ -159,6 +163,7 @@ instance FromJSON Owner where
|
||||||
(fromMaybe False pc)
|
(fromMaybe False pc)
|
||||||
(fromMaybe "" vk)
|
(fromMaybe "" vk)
|
||||||
(fromMaybe "" cT)
|
(fromMaybe "" cT)
|
||||||
|
(fromMaybe False oT)
|
||||||
|
|
||||||
instance Val Owner where
|
instance Val Owner where
|
||||||
cast' (Doc d) = do
|
cast' (Doc d) = do
|
||||||
|
@ -187,6 +192,7 @@ instance Val Owner where
|
||||||
pc <- B.lookup "payconf" d
|
pc <- B.lookup "payconf" d
|
||||||
vk <- B.lookup "viewKey" d
|
vk <- B.lookup "viewKey" d
|
||||||
cT <- B.lookup "crmToken" d
|
cT <- B.lookup "crmToken" d
|
||||||
|
oT <- B.lookup "tips" d
|
||||||
Just
|
Just
|
||||||
(Owner
|
(Owner
|
||||||
i
|
i
|
||||||
|
@ -213,9 +219,10 @@ instance Val Owner where
|
||||||
ets
|
ets
|
||||||
pc
|
pc
|
||||||
vk
|
vk
|
||||||
cT)
|
cT
|
||||||
|
oT)
|
||||||
cast' _ = Nothing
|
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
|
case i of
|
||||||
Just oid ->
|
Just oid ->
|
||||||
Doc
|
Doc
|
||||||
|
@ -244,6 +251,7 @@ instance Val Owner where
|
||||||
, "payconf" =: pc
|
, "payconf" =: pc
|
||||||
, "viewKey" =: vk
|
, "viewKey" =: vk
|
||||||
, "crmToken" =: cT
|
, "crmToken" =: cT
|
||||||
|
, "tips" =: oT
|
||||||
]
|
]
|
||||||
Nothing ->
|
Nothing ->
|
||||||
Doc
|
Doc
|
||||||
|
@ -271,6 +279,7 @@ instance Val Owner where
|
||||||
, "payconf" =: pc
|
, "payconf" =: pc
|
||||||
, "viewKey" =: vk
|
, "viewKey" =: vk
|
||||||
, "crmToken" =: cT
|
, "crmToken" =: cT
|
||||||
|
, "tips" =: oT
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Type to represent informational data for Owners from UI
|
-- | Type to represent informational data for Owners from UI
|
||||||
|
@ -320,6 +329,7 @@ data OwnerSettings = OwnerSettings
|
||||||
, os_payconf :: Bool
|
, os_payconf :: Bool
|
||||||
, os_crmToken :: T.Text
|
, os_crmToken :: T.Text
|
||||||
, os_viewKey :: T.Text
|
, os_viewKey :: T.Text
|
||||||
|
, os_tips :: Bool
|
||||||
} deriving (Eq, Show, Generic)
|
} deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
instance FromJSON OwnerSettings where
|
instance FromJSON OwnerSettings where
|
||||||
|
@ -340,11 +350,28 @@ instance FromJSON OwnerSettings where
|
||||||
pc <- obj .: "payconf"
|
pc <- obj .: "payconf"
|
||||||
cT <- obj .: "crmToken"
|
cT <- obj .: "crmToken"
|
||||||
vK <- obj .: "viewkey"
|
vK <- obj .: "viewkey"
|
||||||
|
oT <- obj .: "tips"
|
||||||
pure $
|
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
|
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
|
object
|
||||||
[ "_id" .= maybe "" show i
|
[ "_id" .= maybe "" show i
|
||||||
, "address" .= a
|
, "address" .= a
|
||||||
|
@ -361,6 +388,7 @@ instance ToJSON OwnerSettings where
|
||||||
, "payconf" .= pc
|
, "payconf" .= pc
|
||||||
, "crmToken" .= cT
|
, "crmToken" .= cT
|
||||||
, "viewkey" .= keyObfuscate vK
|
, "viewkey" .= keyObfuscate vK
|
||||||
|
, "tips" .= oT
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
keyObfuscate s
|
keyObfuscate s
|
||||||
|
@ -386,6 +414,7 @@ getOwnerSettings o =
|
||||||
(opayconf o)
|
(opayconf o)
|
||||||
(ocrmToken o)
|
(ocrmToken o)
|
||||||
(oviewkey o)
|
(oviewkey o)
|
||||||
|
(otips o)
|
||||||
|
|
||||||
-- Database actions
|
-- Database actions
|
||||||
-- | Function to upsert an Owner
|
-- | Function to upsert an Owner
|
||||||
|
|
|
@ -1201,6 +1201,7 @@ routes pipe config = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
|
False
|
||||||
status accepted202
|
status accepted202
|
||||||
post "/api/ownersettings" $ do
|
post "/api/ownersettings" $ do
|
||||||
s <- param "session"
|
s <- param "session"
|
||||||
|
|
32
test/Spec.hs
32
test/Spec.hs
|
@ -1248,6 +1248,7 @@ startAPI config = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
|
False
|
||||||
let myOwner1 =
|
let myOwner1 =
|
||||||
Owner
|
Owner
|
||||||
(Just (read "627ad3492b05a76be3000008"))
|
(Just (read "627ad3492b05a76be3000008"))
|
||||||
|
@ -1275,6 +1276,7 @@ startAPI config = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
|
False
|
||||||
let myOwner2 =
|
let myOwner2 =
|
||||||
Owner
|
Owner
|
||||||
(Just (read "627ad3492b05a76be3700008"))
|
(Just (read "627ad3492b05a76be3700008"))
|
||||||
|
@ -1302,6 +1304,7 @@ startAPI config = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
|
False
|
||||||
let myOwner3 =
|
let myOwner3 =
|
||||||
Owner
|
Owner
|
||||||
(Just (read "627ad3492b05a76be3750008"))
|
(Just (read "627ad3492b05a76be3750008"))
|
||||||
|
@ -1329,6 +1332,7 @@ startAPI config = do
|
||||||
False
|
False
|
||||||
""
|
""
|
||||||
""
|
""
|
||||||
|
False
|
||||||
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
|
_ <- access pipe master "test" (Database.MongoDB.delete (select [] "owners"))
|
||||||
let o = val myOwner
|
let o = val myOwner
|
||||||
case o of
|
case o of
|
||||||
|
@ -1468,7 +1472,33 @@ instance Arbitrary Owner where
|
||||||
exp <- arbitrary
|
exp <- arbitrary
|
||||||
payconf <- arbitrary
|
payconf <- arbitrary
|
||||||
vk <- 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
|
arbitrary
|
||||||
|
|
||||||
instance Arbitrary Item where
|
instance Arbitrary Item where
|
||||||
|
|
Loading…
Reference in a new issue