content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TypeOperators #-}
  
  {-# OPTIONS -Wno-deprecations #-}
  module Routes.Admin.Customers
      ( CustomerAPI
      , customerRoutes
      ) where
  
  import Control.Monad (unless, forM, forM_)
  import Control.Monad.IO.Class (MonadIO, liftIO)
  import Data.Aeson ((.=), (.:), ToJSON(..), FromJSON(..), object, withObject)
  import Data.Maybe (fromMaybe, catMaybes)
  import Database.Persist
      ( (=.), (==.), Entity(..), Filter, Update, count, selectFirst, get, update
      , selectList, getBy, insert, updateWhere, deleteCascade
      )
  import Data.Time (UTCTime)
  import Data.Text.Encoding (encodeUtf8, decodeUtf8)
  import Servant
      ( (:<|>)(..), (:>), AuthProtect, QueryParam, Capture, ReqBody, Get, Patch
      , Delete, JSON, err404, ServerT
      )
  
  import Auth (Cookied, WrappedAuthToken, withAdminCookie, validateAdminAndParameters)
  import qualified Helcim.API.Types.Customer as Helcim (CustomerId(..))
  import Models
      ( CustomerId, Customer(..), Address(..), EntityField(..), Unique(..)
      , Order(..), OrderId, getOrderTotal, AddressId
      )
  import Models.Fields (Cents, StripeCustomerId, OrderStatus, AvalaraCustomerCode, mkCents)
  import Routes.CommonData (AddressData, toAddressData)
  import Routes.Utils (deletedEmail, extractRowCount, buildWhereQuery, hashPassword, generateUniqueToken, mapUpdate)
  import Server (App, AppSQL, runDB, serverError)
  import Validation (Validation(..))
  
  import qualified Crypto.BCrypt as BCrypt
  import qualified Data.Text as T
  import qualified Data.UUID as UUID
  import qualified Data.UUID.V4 as UUID4
  import qualified Database.Esqueleto.Experimental as E
  import qualified Validation as V
  
  
  type CustomerAPI =
           "list" :> CustomerListRoute
      :<|> "edit" :> CustomerEditDataRoute
      :<|> "edit" :> CustomerEditRoute
      :<|> "delete" :> CustomerDeleteRoute
  
  type CustomerRoutes = ServerT CustomerAPI App
  
  customerRoutes :: CustomerRoutes
  customerRoutes =
           customerListRoute
      :<|> customerEditDataRoute
      :<|> customerEditRoute
      :<|> customerDeleteRoute
  
  
  -- LIST
  
  
  type CustomerListRoute =
         AuthProtect "cookie-auth"
      :> QueryParam "page" Int
      :> QueryParam "perPage" Int
      :> QueryParam "query" T.Text
      :> Get '[JSON] (Cookied CustomerListData)
  
  data CustomerListData =
      CustomerListData
          { cldCustomers :: [ListCustomer]
          , cldTotalCustomers :: Int
          } deriving (Show)
  
  instance ToJSON CustomerListData where
      toJSON CustomerListData {..} =
          object
              [ "customers" .= cldCustomers
              , "total" .= cldTotalCustomers
              ]
  
  data ListCustomer =
      ListCustomer
          { lcId :: CustomerId
          , lcEmail :: T.Text
          , lcName :: T.Text
          } deriving (Show)
  
  instance ToJSON ListCustomer where
      toJSON ListCustomer {..} =
          object
              [ "id" .= lcId
              , "email" .= lcEmail
              , "name" .= lcName
              ]
  
  customerListRoute :: WrappedAuthToken -> Maybe Int -> Maybe Int -> Maybe T.Text -> App (Cookied CustomerListData)
  customerListRoute t mPage mPerPage maybeQuery = withAdminCookie t $ \_ -> do
      let perPage = fromMaybe 50 mPerPage
          page = fromMaybe 1 mPage
          offset = perPage * (page - 1)
          query = fromMaybe "" maybeQuery
      (customers, customerCount) <- runDB $ do
          customerCount <-
              if T.null query then
                  count ([] :: [Filter Customer])
              else
                  extractRowCount . E.select $ do
                      (c E.:& a) <- E.from $ E.table `E.leftJoin` E.table
                          `E.on` \(c E.:& a) ->
                                  E.just (c E.^. CustomerId) E.==. a E.?. AddressCustomerId
                                  E.&&. E.just (E.val True) E.==. a E.?. AddressIsActive
                      E.where_ $ whereQuery c a query
                      return $ E.countDistinct $ c E.^. CustomerId
          customerResult <- E.select $ do
              (c E.:& a) <- E.from $ E.table `E.leftJoin` E.table `E.on`
                  \(c E.:& a) ->
                      let activeAddressFilter =
                              if T.null query then
                                  E.just (E.val True) E.==. a E.?. AddressIsDefault
                              else
                                  E.val True
                      in E.just (c E.^. CustomerId) E.==. a E.?. AddressCustomerId
                          E.&&. E.just (E.val True) E.==. a E.?. AddressIsActive
                          E.&&. activeAddressFilter
              E.distinctOnOrderBy [E.asc $ c E.^. CustomerEmail] $ do
  
                  E.limit $ fromIntegral perPage
                  E.offset $ fromIntegral offset
                  E.where_ $ whereQuery c a query
                  return (c, a)
          customers <- mapM getAddressIfMissing customerResult
          return (customers, customerCount)
      return $ CustomerListData customers customerCount
    where
      -- | Search the Email, Name, & Street Line 1.
      whereQuery
          :: E.SqlExpr (Entity Customer)
          -> E.SqlExpr (Maybe (Entity Address))
          -> T.Text
          -> E.SqlExpr (E.Value Bool)
      whereQuery c a =
          buildWhereQuery $ \term ->
              let wildQuery = E.just $ E.concat_ [(E.%), E.val term, (E.%)]
              in  [ E.just (c E.^. CustomerEmail) `E.ilike` wildQuery
                  , a E.?. AddressFirstName `E.ilike` wildQuery
                  , a E.?. AddressLastName `E.ilike` wildQuery
                  , a E.?. AddressAddressOne `E.ilike` wildQuery
                  ]
      -- | Try fetching any of the Customer's Addresses if one does not
      -- exist. Then make the 'ListCustomer'.
      getAddressIfMissing :: (Entity Customer, Maybe (Entity Address)) -> AppSQL ListCustomer
      getAddressIfMissing (c@(Entity customerId _), maybeAddr) =
          case maybeAddr of
              Just _ ->
                  return $ makeCustomer c maybeAddr
              Nothing ->
                  makeCustomer c <$> selectFirst
                      [ AddressCustomerId ==. customerId
                      , AddressIsActive ==. True
                      ] []
      -- | Make a 'ListCustomer', using empty Text values if an Address was
      -- not found.
      makeCustomer :: Entity Customer -> Maybe (Entity Address) -> ListCustomer
      makeCustomer (Entity customerId customer) maybeAddress =
          let
              name =
                  case maybeAddress of
                      Just (Entity _ address) ->
                          addressFirstName address <> " " <> addressLastName address
                      Nothing ->
                          ""
          in ListCustomer
              { lcId = customerId
              , lcEmail = customerEmail customer
              , lcName = name
              }
  
  
  -- EDIT
  
  
  type CustomerEditDataRoute =
         AuthProtect "cookie-auth"
      :> Capture "id" CustomerId
      :> Get '[JSON] (Cookied CustomerEditData)
  
  data CustomerEditData =
      CustomerEditData
          { cedId :: CustomerId
          , cedEmail :: T.Text
          , cedStoreCredit :: Cents
          , cedIsAdmin :: Bool
          , cedVerified :: Bool
          , cedStripeId :: Maybe StripeCustomerId
          , cedHelcimCustomerId :: Maybe Helcim.CustomerId
          , cedAvalaraCode :: Maybe AvalaraCustomerCode
          , cedOrders :: [OrderData]
          } deriving (Show)
  
  instance ToJSON CustomerEditData where
      toJSON CustomerEditData {..} =
          object
              [ "id" .= cedId
              , "email" .= cedEmail
              , "storeCredit" .= cedStoreCredit
              , "isAdmin" .= cedIsAdmin
              , "verified" .= cedVerified
              , "stripeId" .= cedStripeId
              , "helcimCustomerId" .= cedHelcimCustomerId
              , "avalaraCode" .= cedAvalaraCode
              , "orders" .= cedOrders
              ]
  
  data OrderData =
      OrderData
          { odId :: OrderId
          , odDate :: UTCTime
          , odStatus :: OrderStatus
          , odShipping :: AddressData
          , odTotal :: Cents
          } deriving (Show)
  
  instance ToJSON OrderData where
      toJSON OrderData {..} =
          object
              [ "id" .= odId
              , "date" .= odDate
              , "status" .= odStatus
              , "shipping" .= odShipping
              , "total" .= odTotal
  
              ]
  
  customerEditDataRoute :: WrappedAuthToken -> CustomerId -> App (Cookied CustomerEditData)
  customerEditDataRoute t customerId = withAdminCookie t $ \_ ->
      runDB (get customerId) >>= \case
          Nothing ->
              serverError err404
          Just customer -> do
              orders <- getOrders
              return CustomerEditData
                  { cedId = customerId
                  , cedEmail = customerEmail customer
                  , cedStoreCredit = customerStoreCredit customer
                  , cedIsAdmin = customerIsAdmin customer
                  , cedVerified = customerVerified customer
                  , cedStripeId = customerStripeId customer
                  , cedHelcimCustomerId = customerHelcimCustomerId customer
                  , cedAvalaraCode = customerAvalaraCode customer
                  , cedOrders = orders
                  }
    where
      getOrders :: App [OrderData]
      getOrders = runDB $ do
          os <- E.select $ do
              (o E.:& sa) <- E.from $ E.table `E.innerJoin` E.table
                  `E.on` \(o E.:& sa) -> sa E.^. AddressId E.==. o E.^. OrderShippingAddressId
              E.where_ $ o E.^. OrderCustomerId E.==. E.val customerId
              E.orderBy [E.desc $ o E.^. OrderCreatedAt]
              return (o, sa)
          forM os $ \(Entity oId order, sa) -> do
              total <-
                  getOrderTotal
                      <$> (map entityVal <$> selectList [OrderLineItemOrderId ==. oId] [])
                      <*> (map entityVal <$> selectList [OrderProductOrderId ==. oId] [])
              return OrderData
                  { odId = oId
                  , odDate = orderCreatedAt order
                  , odStatus = orderStatus order
                  , odShipping = toAddressData sa
                  , odTotal = total
                  }
  
  
  type CustomerEditRoute =
         AuthProtect "cookie-auth"
      :> ReqBody '[JSON] CustomerEditParameters
      :> Patch '[JSON] (Cookied CustomerId)
  
  data CustomerEditParameters =
      CustomerEditParameters
          { cepId :: CustomerId
          , cepEmail :: Maybe T.Text
          , cepStoreCredit :: Maybe Cents
          , cepIsAdmin :: Maybe Bool
          , cepPassword :: Maybe T.Text
          , cepPasswordConfirm :: Maybe T.Text
          } deriving (Show)
  
  instance FromJSON CustomerEditParameters where
      parseJSON = withObject "CustomerEditParameters" $ \v -> do
          cepId <- v .: "id"
          cepEmail <- v .: "email"
          cepStoreCredit <- v .: "storeCredit"
          cepIsAdmin <- v .: "isAdmin"
          cepPassword <- v .: "password"
          cepPasswordConfirm <- v .: "passwordConfirm"
          return CustomerEditParameters {..}
  
  
  instance Validation CustomerEditParameters where
      validators CustomerEditParameters {..} = do
          customerExists <- V.exists cepId
          uniqueEmail <- case cepEmail of
              Nothing -> return []
              Just email -> do
                  -- TODO: Don't make this case insensitive?
                  doesntExist <- V.uniqueCustomer email
                  return
                      [ ( "email"
                        , [ V.required email
                          , ( "A Customer with this Email already exists."
                            , doesntExist
                            )
                          ]
                        )
                      ]
  
          return $ catMaybes
              [ V.mapCheck ((,) <$> cepPassword <*> cepPasswordConfirm) $ \(pass, confirm) ->
                  ( "password"
                  , [ V.required pass
                    , ( "Passwords do not match.", pass /= confirm )
                    ]
                  )
              ]
              ++ uniqueEmail
              ++
              [ ( ""
                , [ ( "Could not find this Customer in the database."
                    , customerExists
                    )
                  ]
                )
              ]
  
  customerEditRoute :: WrappedAuthToken -> CustomerEditParameters -> App (Cookied CustomerId)
  customerEditRoute = validateAdminAndParameters $ \_ parameters -> do
      passwordUpdate <- case (,) <$> cepPassword parameters <*> cepPasswordConfirm parameters of
          Nothing ->
              return []
          Just (password, confirm) ->
              if password == confirm then do
                  passwordHash <- hashPassword password
                  newToken <- runDB $ generateUniqueToken UniqueToken
                  return
                      [ CustomerEncryptedPassword =. Just passwordHash
                      , CustomerAuthToken =. newToken
                      ]
              else
                  return []
      let updates = makeUpdates parameters ++ passwordUpdate
      unless (null updates) $ runDB $ update (cepId parameters) updates
      return $ cepId parameters
    where
      makeUpdates :: CustomerEditParameters -> [Update Customer]
      makeUpdates CustomerEditParameters {..} =
          catMaybes
              [ mapUpdate CustomerEmail cepEmail
              , mapUpdate CustomerStoreCredit cepStoreCredit
              , mapUpdate CustomerIsAdmin cepIsAdmin
              ]
  
  
  -- DELETE
  
  
  type CustomerDeleteRoute =
         AuthProtect "cookie-auth"
      :> Capture "customer" CustomerId
      :> Delete '[JSON] (Cookied ())
  
  -- | Delete a customer by moving their Orders & related
  -- anonymized-addresses to the `gardens+deleted@southernexposure.com`
  -- account, then delete the customer's account & all remaining related
  -- models.
  customerDeleteRoute :: WrappedAuthToken -> CustomerId -> App (Cookied ())
  customerDeleteRoute t customerId = withAdminCookie t $ \_ -> runDB $ do
      newCustomerId <- getBy (UniqueEmail deletedEmail) >>= \case
          Nothing -> do
              hashedPassword <- generateRandomPassword
              token <- generateUniqueToken UniqueToken
              insert Customer
                  { customerEmail = deletedEmail
                  , customerStoreCredit = mkCents 0
                  , customerMemberNumber = ""
                  , customerEncryptedPassword = Just hashedPassword
                  , customerAuthToken = token
                  , customerStripeId = Nothing
                  , customerHelcimCustomerId = Nothing
                  , customerAvalaraCode = Nothing
                  , customerIsAdmin = False
                  , customerVerified = False
                  }
          Just (Entity cId _) ->
              return cId
      unless (newCustomerId == customerId) $ do
          orders <- selectList [OrderCustomerId ==. customerId] []
          forM_ orders $ \(Entity oId order) -> do
              update oId [OrderCustomerId =. newCustomerId]
              moveAddress newCustomerId (orderShippingAddressId order)
              mapM_ (moveAddress newCustomerId) $ orderBillingAddressId order
          updateWhere [ReviewCustomerId ==. customerId] [ReviewCustomerId =. newCustomerId]
          deleteCascade customerId
    where
      generateRandomPassword :: MonadIO m => m T.Text
      generateRandomPassword = liftIO $ do
          password <- UUID.toText <$> UUID4.nextRandom
          mHashed <- BCrypt.hashPasswordUsingPolicy BCrypt.slowerBcryptHashingPolicy
              $ encodeUtf8 password
          case mHashed of
              Just hashed ->
                  return $ decodeUtf8 hashed
              Nothing ->
                  return password
      moveAddress :: CustomerId -> AddressId -> AppSQL ()
      moveAddress newCustomerId addressId =
          update addressId
              [ AddressFirstName =. "DELETED"
              , AddressLastName =. "DELETED"
              , AddressAddressOne =. "DELETED"
              , AddressAddressTwo =. "DELETED"
              , AddressCustomerId =. newCustomerId
              , AddressIsDefault =. False
              ]
  