{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Account.Follows.UnfollowUser where

import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), mapDBError)
import Conduit.Features.Account.DB (Follow(..))
import Conduit.Features.Account.Errors (AccountError)
import Conduit.Features.Account.Types (UserID(..), UserProfile(..), inProfileObj)
import Conduit.Features.Account.User.GetProfile (AcquireProfile(..))
import Conduit.Identity.Auth (AuthedUser(..), withAuth)
import Database.Esqueleto.Experimental (delete, from, table, valkey, where_, (&&.), (==.))
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, json)
import Web.Scotty.Trans qualified as Scotty

handleUserUnfollow :: ScottyT AppM ()
handleUserUnfollow :: ScottyT AppM ()
handleUserUnfollow = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Scotty.delete RoutePattern
"/api/profiles/:username/follow" (ActionT AppM () -> ScottyT AppM ())
-> ActionT AppM () -> ScottyT AppM ()
forall a b. (a -> b) -> a -> b
$ (AuthedUser -> ActionT AppM ()) -> ActionT AppM ()
forall (m :: * -> *) c.
(MonadIO m, MonadReader c m, Has JWTInfo c m) =>
(AuthedUser -> ActionT m ()) -> ActionT m ()
withAuth \AuthedUser
follower -> do
  Text
followed <- Text -> ActionT AppM Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
captureParam Text
"username"
  UserProfile
profile <- AppM (Either AccountError UserProfile) -> ActionT AppM UserProfile
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either AccountError UserProfile)
 -> ActionT AppM UserProfile)
-> AppM (Either AccountError UserProfile)
-> ActionT AppM UserProfile
forall a b. (a -> b) -> a -> b
$ UserID -> Text -> AppM (Either AccountError UserProfile)
forall (m :: * -> *).
(AcquireProfile m, DeleteFollow m) =>
UserID -> Text -> m (Either AccountError UserProfile)
unfollowUser AuthedUser
follower.authedUserID Text
followed
  InObj UserProfile -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (InObj UserProfile -> ActionT AppM ())
-> InObj UserProfile -> ActionT AppM ()
forall a b. (a -> b) -> a -> b
$ UserProfile -> InObj UserProfile
forall obj. obj -> InObj obj
inProfileObj UserProfile
profile

unfollowUser :: (AcquireProfile m, DeleteFollow m) => UserID -> Text -> m (Either AccountError UserProfile)
unfollowUser :: forall (m :: * -> *).
(AcquireProfile m, DeleteFollow m) =>
UserID -> Text -> m (Either AccountError UserProfile)
unfollowUser UserID
followerID Text
followedName = ExceptT AccountError m UserProfile
-> m (Either AccountError UserProfile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  (UserID
followedID, UserProfile
followedProfile) <- m (Either AccountError (UserID, UserProfile))
-> ExceptT AccountError m (UserID, UserProfile)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either AccountError (UserID, UserProfile))
 -> ExceptT AccountError m (UserID, UserProfile))
-> m (Either AccountError (UserID, UserProfile))
-> ExceptT AccountError m (UserID, UserProfile)
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe UserID -> m (Either AccountError (UserID, UserProfile))
forall (m :: * -> *).
AcquireProfile m =>
Text
-> Maybe UserID -> m (Either AccountError (UserID, UserProfile))
findUserByName Text
followedName (UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
followerID)

  m (Either AccountError ()) -> ExceptT AccountError m ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either AccountError ()) -> ExceptT AccountError m ())
-> m (Either AccountError ()) -> ExceptT AccountError m ()
forall a b. (a -> b) -> a -> b
$ UserID -> UserID -> m (Either AccountError ())
forall (m :: * -> *).
DeleteFollow m =>
UserID -> UserID -> m (Either AccountError ())
deleteFollow UserID
followerID UserID
followedID

  UserProfile -> ExceptT AccountError m UserProfile
forall a. a -> ExceptT AccountError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserProfile
followedProfile
    { $sel:followed:UserProfile :: Bool
followed = Bool
False
    }

class (Monad m) => DeleteFollow m where
  deleteFollow :: UserID -> UserID -> m (Either AccountError ())

instance (Monad m, MonadDB m, MonadUnliftIO m) => DeleteFollow m where
  deleteFollow :: UserID -> UserID -> m (Either AccountError ())
  deleteFollow :: UserID -> UserID -> m (Either AccountError ())
deleteFollow UserID
followed UserID
follower = Either DBError () -> Either AccountError ()
forall e a. FeatureError e => Either DBError a -> Either e a
mapDBError (Either DBError () -> Either AccountError ())
-> m (Either DBError ()) -> m (Either AccountError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m () -> m (Either DBError ())
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
runDB do
    SqlQuery () -> SqlPersistT m ()
forall (m :: * -> *) backend.
(MonadIO m, SqlBackendCanWrite backend) =>
SqlQuery () -> ReaderT backend m ()
delete (SqlQuery () -> SqlPersistT m ())
-> SqlQuery () -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity Follow)
f <- From (SqlExpr (Entity Follow))
-> SqlQuery (SqlExpr (Entity Follow))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (From (SqlExpr (Entity Follow))
 -> SqlQuery (SqlExpr (Entity Follow)))
-> From (SqlExpr (Entity Follow))
-> SqlQuery (SqlExpr (Entity Follow))
forall a b. (a -> b) -> a -> b
$ forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Follow
      SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ (SqlExpr (Entity Follow)
f.followerID SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Int64 -> SqlExpr (Value (Key User))
forall entity.
(ToBackendKey SqlBackend entity, PersistField (Key entity)) =>
Int64 -> SqlExpr (Value (Key entity))
valkey UserID
follower.unID) SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&. (SqlExpr (Entity Follow)
f.followedID SqlExpr (Value (Key User))
-> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Int64 -> SqlExpr (Value (Key User))
forall entity.
(ToBackendKey SqlBackend entity, PersistField (Key entity)) =>
Int64 -> SqlExpr (Value (Key entity))
valkey UserID
followed.unID)