zgo-backend/src/WooCommerce.hs

{-# LANGUAGE OverloadedStrings #-}

module WooCommerce where

import Data.Aeson
import qualified Data.Bson as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import Database.MongoDB

-- | Type to represent the WooCommerce token
data WooToken =
  WooToken
    { w_id :: Maybe ObjectId
    , w_owner :: ObjectId
    , w_token :: T.Text
    , w_url :: Maybe T.Text
    }
  deriving (Eq, Show)

instance Val WooToken where
  val (WooToken i o t u) =
    if isJust i
      then Doc ["_id" =: i, "owner" =: o, "token" =: t, "url" =: u]
      else Doc ["owner" =: o, "token" =: t, "url" =: u]
  cast' (Doc d) = do
    i <- B.lookup "_id" d
    o <- B.lookup "owner" d
    t <- B.lookup "token" d
    u <- B.lookup "url" d
    Just
      (WooToken
         i
         o
         t
         (E.decodeUtf8With lenientDecode . B64.decodeLenient . C.pack <$> u))
  cast' _ = Nothing

-- Database actions
findWooToken :: ObjectId -> Action IO (Maybe Document)
findWooToken oid = findOne (select ["owner" =: oid] "wootokens")

addUrl :: WooToken -> T.Text -> Action IO ()
addUrl t u =
  modify (select ["_id" =: w_id t] "wootokens") ["$set" =: ["url" =: u]]