zgo-backend/src/Owner.hs

{-# 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 ["expiration" =: ["$lte" =: addUTCTime 172800 now]] "owners")