{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Account.User.GetProfile where

import Prelude hiding (get, on)
import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), mapMaybeDBResult, sqlKey2ID)
import Conduit.DB.Utils (suchThat)
import Conduit.Features.Account.Common.QueryUserFollows (queryIfUserFollows)
import Conduit.Features.Account.DB (mkProfile)
import Conduit.Features.Account.Errors (AccountError(..))
import Conduit.Features.Account.Types (UserID(..), UserProfile(..), inProfileObj)
import Conduit.Identity.Auth (AuthedUser(..), maybeWithAuth)
import Database.Esqueleto.Experimental (Entity(..), from, selectOne, table, val, (==.))
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, get, json)

handleGetProfile :: ScottyT AppM ()
handleGetProfile :: ScottyT AppM ()
handleGetProfile = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
get RoutePattern
"/api/profiles/:username" (ActionT AppM () -> ScottyT AppM ())
-> ActionT AppM () -> ScottyT AppM ()
forall a b. (a -> b) -> a -> b
$ (Maybe AuthedUser -> ActionT AppM ()) -> ActionT AppM ()
forall (m :: * -> *) c.
(MonadIO m, Has JWTInfo c m) =>
(Maybe AuthedUser -> ActionT m ()) -> ActionT m ()
maybeWithAuth \Maybe AuthedUser
user -> do
  Text
userName <- 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
$ Text -> Maybe AuthedUser -> AppM (Either AccountError UserProfile)
forall (m :: * -> *).
AcquireProfile m =>
Text -> Maybe AuthedUser -> m (Either AccountError UserProfile)
getUserProfile Text
userName Maybe AuthedUser
user
  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

getUserProfile :: (AcquireProfile m) => Text -> Maybe AuthedUser -> m (Either AccountError UserProfile)
getUserProfile :: forall (m :: * -> *).
AcquireProfile m =>
Text -> Maybe AuthedUser -> m (Either AccountError UserProfile)
getUserProfile Text
userName Maybe AuthedUser
currUser =
  let userID :: Maybe UserID
userID = Maybe AuthedUser
currUser Maybe AuthedUser -> (AuthedUser -> UserID) -> Maybe UserID
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> AuthedUser -> UserID
authedUserID
   in ((UserID, UserProfile) -> UserProfile)
-> Either AccountError (UserID, UserProfile)
-> Either AccountError UserProfile
forall a b.
(a -> b) -> Either AccountError a -> Either AccountError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UserID, UserProfile) -> UserProfile
forall a b. (a, b) -> b
snd (Either AccountError (UserID, UserProfile)
 -> Either AccountError UserProfile)
-> m (Either AccountError (UserID, UserProfile))
-> m (Either AccountError UserProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Maybe UserID -> m (Either AccountError (UserID, UserProfile))
forall (m :: * -> *).
AcquireProfile m =>
Text
-> Maybe UserID -> m (Either AccountError (UserID, UserProfile))
findUserByName Text
userName Maybe UserID
userID

class (Monad m) => AcquireProfile m where
  findUserByName :: Text -> Maybe UserID -> m (Either AccountError (UserID, UserProfile))

instance (Monad m, MonadUnliftIO m, MonadIO m, MonadDB m) => AcquireProfile m where
  findUserByName :: Text -> Maybe UserID -> m (Either AccountError (UserID, UserProfile))
  findUserByName :: Text
-> Maybe UserID -> m (Either AccountError (UserID, UserProfile))
findUserByName Text
name Maybe UserID
userID = AccountError
-> ((Entity User, Value Bool) -> (UserID, UserProfile))
-> Either DBError (Maybe (Entity User, Value Bool))
-> Either AccountError (UserID, UserProfile)
forall e a b.
FeatureError e =>
e -> (a -> b) -> Either DBError (Maybe a) -> Either e b
mapMaybeDBResult AccountError
UserNotFoundEx (Entity User, Value Bool) -> (UserID, UserProfile)
processUser (Either DBError (Maybe (Entity User, Value Bool))
 -> Either AccountError (UserID, UserProfile))
-> m (Either DBError (Maybe (Entity User, Value Bool)))
-> m (Either AccountError (UserID, UserProfile))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m (Maybe (Entity User, Value Bool))
-> m (Either DBError (Maybe (Entity User, Value Bool)))
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
runDB do
    SqlQuery (SqlExpr (Entity User), SqlExpr (Value Bool))
-> SqlPersistT m (Maybe (Entity User, Value Bool))
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m (Maybe r)
selectOne (SqlQuery (SqlExpr (Entity User), SqlExpr (Value Bool))
 -> SqlPersistT m (Maybe (Entity User, Value Bool)))
-> SqlQuery (SqlExpr (Entity User), SqlExpr (Value Bool))
-> SqlPersistT m (Maybe (Entity User, Value Bool))
forall a b. (a -> b) -> a -> b
$ do
      SqlExpr (Entity User)
u <- From (SqlExpr (Entity User)) -> SqlQuery (SqlExpr (Entity User))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from From (SqlExpr (Entity User))
forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table SqlQuery (SqlExpr (Entity User))
-> (SqlExpr (Entity User) -> SqlExpr (Value Bool))
-> SqlQuery (SqlExpr (Entity User))
forall a. SqlQuery a -> (a -> SqlExpr (Value Bool)) -> SqlQuery a
`suchThat` \SqlExpr (Entity User)
u -> SqlExpr (Entity User)
u.username SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
name

      let follows :: SqlExpr (Value Bool)
follows = SqlExpr (Entity User) -> Maybe UserID -> SqlExpr (Value Bool)
forall a.
ComparableUserEntity a =>
SqlExpr a -> Maybe UserID -> SqlExpr (Value Bool)
queryIfUserFollows SqlExpr (Entity User)
u Maybe UserID
userID

      (SqlExpr (Entity User), SqlExpr (Value Bool))
-> SqlQuery (SqlExpr (Entity User), SqlExpr (Value Bool))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity User)
u, SqlExpr (Value Bool)
follows)
    where
      processUser :: (Entity User, Value Bool) -> (UserID, UserProfile)
processUser = (Entity User -> Value Bool -> (UserID, UserProfile))
-> (Entity User, Value Bool) -> (UserID, UserProfile)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry \e :: Entity User
e@(Entity Key User
key User
_) Value Bool
follows -> (Key User -> UserID
forall t id. SqlKey t id => Key t -> id
sqlKey2ID Key User
key, Entity User -> Value Bool -> UserProfile
mkProfile Entity User
e Value Bool
follows)