Unified Address support #8

Merged
pitmutt merged 61 commits from dev18 into master 2023-10-28 12:24:28 +00:00
3 changed files with 66 additions and 6 deletions
Showing only changes of commit 7daa9a9687 - Show all commits

View file

@ -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

View file

@ -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"

View file

@ -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