{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Account.Follows.FollowUser where

import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB (..), id2sqlKey, 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 (insert_)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, json, post)

handleUserFollow :: ScottyT AppM ()
handleUserFollow :: ScottyT AppM ()
handleUserFollow = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
post 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, CreateFollow m) =>
UserID -> Text -> m (Either AccountError UserProfile)
followUser 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

followUser :: (AcquireProfile m, CreateFollow m) => UserID -> Text -> m (Either AccountError UserProfile)
followUser :: forall (m :: * -> *).
(AcquireProfile m, CreateFollow m) =>
UserID -> Text -> m (Either AccountError UserProfile)
followUser 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 :: * -> *).
CreateFollow m =>
UserID -> UserID -> m (Either AccountError ())
addFollow 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
True
    }

class (Monad m) => CreateFollow m where
  addFollow :: UserID -> UserID -> m (Either AccountError ())

instance (Monad m, MonadDB m, MonadUnliftIO m) => CreateFollow m where
  addFollow :: UserID -> UserID -> m (Either AccountError ())
  addFollow :: UserID -> UserID -> m (Either AccountError ())
addFollow (UserID -> Key User
forall t id. SqlKey t id => id -> Key t
id2sqlKey -> Key User
follower) (UserID -> Key User
forall t id. SqlKey t id => id -> Key t
id2sqlKey -> Key User
followed) = 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
    Follow -> SqlPersistT m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m ()
insert_ (Follow -> SqlPersistT m ()) -> Follow -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$ Key User -> Key User -> Follow
Follow Key User
follower Key User
followed