zgo-backend/src/Owner.hs

304 lines
7.1 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Owner where
import Data.Aeson
import qualified Data.Bson as B
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Clock
import Data.Typeable
import Database.MongoDB
import GHC.Generics
-- | Type to represent a ZGo shop owner/business
data Owner =
Owner
{ o_id :: Maybe ObjectId
, oaddress :: T.Text
, oname :: T.Text
, ocurrency :: T.Text
, otax :: Bool
, otaxValue :: Double
, ovat :: Bool
, ovatValue :: Double
, ofirst :: T.Text
, olast :: T.Text
, oemail :: T.Text
, ostreet :: T.Text
, ocity :: T.Text
, ostate :: T.Text
, opostal :: T.Text
, ophone :: T.Text
, owebsite :: T.Text
, ocountry :: T.Text
, opaid :: Bool
, ozats :: Bool
, oinvoices :: Bool
, 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 cT) =
case i of
Just oid ->
object
[ "_id" .= show oid
, "address" .= a
, "name" .= n
, "currency" .= c
, "tax" .= t
, "taxValue" .= tV
, "vat" .= v
, "vatValue" .= vV
, "first" .= f
, "last" .= l
, "email" .= e
, "street" .= s
, "city" .= ct
, "state" .= st
, "postal" .= p
, "phone" .= ph
, "website" .= w
, "country" .= co
, "paid" .= paid
, "zats" .= zats
, "invoices" .= inv
, "expiration" .= eTs
, "payconf" .= pc
, "viewkey" .= vk
, "crmToken" .= cT
]
Nothing ->
object
[ "_id" .= ("" :: String)
, "address" .= a
, "name" .= n
, "currency" .= c
, "tax" .= t
, "taxValue" .= tV
, "vat" .= v
, "vatValue" .= vV
, "first" .= f
, "last" .= l
, "email" .= e
, "street" .= s
, "city" .= ct
, "state" .= st
, "postal" .= p
, "phone" .= ph
, "website" .= w
, "country" .= co
, "paid" .= paid
, "zats" .= zats
, "invoices" .= inv
, "expiration" .= eTs
, "payconf" .= pc
, "viewkey" .= vk
, "crmToken" .= cT
]
instance FromJSON Owner where
parseJSON =
withObject "Owner" $ \obj -> do
i <- obj .: "_id"
a <- obj .: "address"
n <- obj .: "name"
c <- obj .: "currency"
t <- obj .: "tax"
tV <- obj .: "taxValue"
v <- obj .: "vat"
vV <- obj .: "vatValue"
f <- obj .: "first"
l <- obj .: "last"
e <- obj .: "email"
s <- obj .: "street"
ct <- obj .: "city"
st <- obj .: "state"
p <- obj .: "postal"
ph <- obj .: "phone"
w <- obj .: "website"
co <- obj .: "country"
paid <- obj .: "paid"
zats <- obj .: "zats"
inv <- obj .: "invoices"
ets <- obj .: "expiration"
pc <- obj .:? "payconf"
vk <- obj .:? "viewkey"
cT <- obj .:? "crmToken"
pure $
Owner
(if not (null i)
then Just (read i)
else Nothing)
a
n
c
t
tV
v
vV
f
l
e
s
ct
st
p
ph
w
co
paid
zats
inv
ets
(fromMaybe False pc)
(fromMaybe "" vk)
(fromMaybe "" cT)
instance Val Owner where
cast' (Doc d) = do
i <- B.lookup "_id" d
a <- B.lookup "address" d
n <- B.lookup "name" d
c <- B.lookup "currency" d
t <- B.lookup "tax" d
tV <- B.lookup "taxValue" d
v <- B.lookup "vat" d
vV <- B.lookup "vatValue" d
f <- B.lookup "first" d
l <- B.lookup "last" d
e <- B.lookup "email" d
s <- B.lookup "street" d
ct <- B.lookup "city" d
st <- B.lookup "state" d
p <- B.lookup "postal" d
ph <- B.lookup "phone" d
w <- B.lookup "website" d
co <- B.lookup "country" d
paid <- B.lookup "paid" d
zats <- B.lookup "zats" d
inv <- B.lookup "invoices" d
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
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 cT) =
case i of
Just oid ->
Doc
[ "_id" =: oid
, "address" =: a
, "name" =: n
, "currency" =: c
, "tax" =: t
, "taxValue" =: tV
, "vat" =: v
, "vatValue" =: vV
, "first" =: f
, "last" =: l
, "email" =: e
, "street" =: s
, "city" =: ct
, "state" =: st
, "postal" =: p
, "phone" =: ph
, "website" =: w
, "country" =: co
, "paid" =: paid
, "zats" =: zats
, "invoices" =: inv
, "expiration" =: ets
, "payconf" =: pc
, "viewKey" =: vk
, "crmToken" =: cT
]
Nothing ->
Doc
[ "address" =: a
, "name" =: n
, "currency" =: c
, "tax" =: t
, "taxValue" =: tV
, "vat" =: v
, "vatValue" =: vV
, "first" =: f
, "last" =: l
, "email" =: e
, "street" =: s
, "city" =: ct
, "state" =: st
, "postal" =: p
, "phone" =: ph
, "website" =: w
, "country" =: co
, "paid" =: paid
, "zats" =: zats
, "invoices" =: inv
, "expiration" =: ets
, "payconf" =: pc
, "viewKey" =: vk
, "crmToken" =: cT
]
-- Database actions
-- | Function to upsert an Owner
upsertOwner :: Owner -> Action IO ()
upsertOwner o = do
let owner = val o
case owner of
Doc d -> upsert (select ["address" =: oaddress o] "owners") d
_ -> return ()
-- | Function to get an Owner
findOwner :: T.Text -> Action IO (Maybe Document)
findOwner zaddy = findOne (select ["address" =: zaddy] "owners")
-- | Function to get an Owner by id
findOwnerById :: T.Text -> Action IO (Maybe Document)
findOwnerById i =
findOne (select ["_id" =: (read (T.unpack i) :: ObjectId)] "owners")
-- | Function to find Owners about to expire
findExpiringOwners :: UTCTime -> Action IO [Document]
findExpiringOwners now =
rest =<<
find
(select
["paid" =: True, "expiration" =: ["$lte" =: addUTCTime 172800 now]]
"owners")