{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Account.User.GetUser where

import Prelude hiding (get)
import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), mapMaybeDBResult)
import Conduit.Features.Account.DB (User(..))
import Conduit.Features.Account.Errors (AccountError(..))
import Conduit.Features.Account.Types (UserAuth(..), UserID(..), inUserObj)
import Conduit.Identity.Auth (AuthedUser(..), withAuth)
import Data.Aeson (ToJSON)
import Database.Esqueleto.Experimental (Entity(..), from, selectOne, table, valkey, where_, (==.))
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, get, json)

handleGetUser :: ScottyT AppM ()
handleGetUser :: ScottyT AppM ()
handleGetUser = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
get RoutePattern
"/api/user" (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
user -> do
  UserAuth
userAuth <- AppM (Either AccountError UserAuth) -> ActionT AppM UserAuth
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either AccountError UserAuth) -> ActionT AppM UserAuth)
-> AppM (Either AccountError UserAuth) -> ActionT AppM UserAuth
forall a b. (a -> b) -> a -> b
$ AuthedUser -> AppM (Either AccountError UserAuth)
forall (m :: * -> *).
AcquireUser m =>
AuthedUser -> m (Either AccountError UserAuth)
getUser AuthedUser
user
  InObj UserAuth -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (InObj UserAuth -> ActionT AppM ())
-> InObj UserAuth -> ActionT AppM ()
forall a b. (a -> b) -> a -> b
$ UserAuth -> InObj UserAuth
forall obj. obj -> InObj obj
inUserObj UserAuth
userAuth

getUser :: (AcquireUser m) => AuthedUser -> m (Either AccountError UserAuth)
getUser :: forall (m :: * -> *).
AcquireUser m =>
AuthedUser -> m (Either AccountError UserAuth)
getUser AuthedUser {Text
UserID
authedToken :: Text
authedUserID :: UserID
$sel:authedToken:AuthedUser :: AuthedUser -> Text
$sel:authedUserID:AuthedUser :: AuthedUser -> UserID
..} = do
  Either AccountError UserInfo
maybeUserInfo <- UserID -> m (Either AccountError UserInfo)
forall (m :: * -> *).
AcquireUser m =>
UserID -> m (Either AccountError UserInfo)
findUserById UserID
authedUserID
  Either AccountError UserAuth -> m (Either AccountError UserAuth)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AccountError UserAuth -> m (Either AccountError UserAuth))
-> Either AccountError UserAuth -> m (Either AccountError UserAuth)
forall a b. (a -> b) -> a -> b
$ Text -> UserInfo -> UserAuth
mkUser Text
authedToken (UserInfo -> UserAuth)
-> Either AccountError UserInfo -> Either AccountError UserAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either AccountError UserInfo
maybeUserInfo

mkUser :: Text -> UserInfo -> UserAuth
mkUser :: Text -> UserInfo -> UserAuth
mkUser Text
token UserInfo
user = UserAuth
  { $sel:token:UserAuth :: Text
token = Text
token
  , $sel:name:UserAuth :: Text
name  = UserInfo
user.name
  , $sel:email:UserAuth :: Text
email = UserInfo
user.email
  , $sel:bio:UserAuth :: Maybe Text
bio   = UserInfo
user.bio
  , $sel:image:UserAuth :: Text
image = UserInfo
user.image
  }

class (Monad m) => AcquireUser m where
  findUserById :: UserID -> m (Either AccountError UserInfo)

data UserInfo = UserInfo
  { UserInfo -> Text
name  :: Text
  , UserInfo -> Text
email :: Text
  , UserInfo -> Maybe Text
bio   :: Maybe Text
  , UserInfo -> Text
image :: Text
  } deriving ((forall x. UserInfo -> Rep UserInfo x)
-> (forall x. Rep UserInfo x -> UserInfo) -> Generic UserInfo
forall x. Rep UserInfo x -> UserInfo
forall x. UserInfo -> Rep UserInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserInfo -> Rep UserInfo x
from :: forall x. UserInfo -> Rep UserInfo x
$cto :: forall x. Rep UserInfo x -> UserInfo
to :: forall x. Rep UserInfo x -> UserInfo
Generic, [UserInfo] -> Value
[UserInfo] -> Encoding
UserInfo -> Bool
UserInfo -> Value
UserInfo -> Encoding
(UserInfo -> Value)
-> (UserInfo -> Encoding)
-> ([UserInfo] -> Value)
-> ([UserInfo] -> Encoding)
-> (UserInfo -> Bool)
-> ToJSON UserInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UserInfo -> Value
toJSON :: UserInfo -> Value
$ctoEncoding :: UserInfo -> Encoding
toEncoding :: UserInfo -> Encoding
$ctoJSONList :: [UserInfo] -> Value
toJSONList :: [UserInfo] -> Value
$ctoEncodingList :: [UserInfo] -> Encoding
toEncodingList :: [UserInfo] -> Encoding
$comitField :: UserInfo -> Bool
omitField :: UserInfo -> Bool
ToJSON)

instance (Monad m, MonadUnliftIO m, MonadDB m) => AcquireUser m where
  findUserById :: UserID -> m (Either AccountError UserInfo)
  findUserById :: UserID -> m (Either AccountError UserInfo)
findUserById UserID
userID = AccountError
-> (Entity User -> UserInfo)
-> Either DBError (Maybe (Entity User))
-> Either AccountError UserInfo
forall e a b.
FeatureError e =>
e -> (a -> b) -> Either DBError (Maybe a) -> Either e b
mapMaybeDBResult AccountError
UserNotFoundEx Entity User -> UserInfo
mkUserInfo (Either DBError (Maybe (Entity User))
 -> Either AccountError UserInfo)
-> m (Either DBError (Maybe (Entity User)))
-> m (Either AccountError UserInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m (Maybe (Entity User))
-> m (Either DBError (Maybe (Entity User)))
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))
-> SqlPersistT m (Maybe (Entity User))
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m (Maybe r)
selectOne (SqlQuery (SqlExpr (Entity User))
 -> SqlPersistT m (Maybe (Entity User)))
-> SqlQuery (SqlExpr (Entity User))
-> SqlPersistT m (Maybe (Entity User))
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
      SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity User)
u.id 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
userID.unID)
      SqlExpr (Entity User) -> SqlQuery (SqlExpr (Entity User))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Entity User)
u

mkUserInfo :: Entity User -> UserInfo
mkUserInfo :: Entity User -> UserInfo
mkUserInfo (Entity Key User
_ User
user) = UserInfo
  { $sel:name:UserInfo :: Text
name  = User
user.userUsername
  , $sel:email:UserInfo :: Text
email = User
user.userEmail
  , $sel:bio:UserInfo :: Maybe Text
bio   = User
user.userBio
  , $sel:image:UserInfo :: Text
image = User
user.userImage
  }