{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Favorites.FavoriteArticle where

import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), id2sqlKey, mapDBError)
import Conduit.Features.Account.Common.FindProfileByID (AcquireProfile)
import Conduit.Features.Account.Types (UserID)
import Conduit.Features.Articles.Articles.GetArticle (AquireArticle, getArticle)
import Conduit.Features.Articles.DB (Favorite(Favorite))
import Conduit.Features.Articles.Errors (ArticleError)
import Conduit.Features.Articles.Slugs (extractIDFromSlug)
import Conduit.Features.Articles.Types (ArticleID, OneArticle, Slug(..), inArticleObj)
import Conduit.Identity.Auth (AuthedUser(..), withAuth)
import Database.Esqueleto.Experimental (insert_)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, json, post)

handleArticleFavorite :: ScottyT AppM ()
handleArticleFavorite :: ScottyT AppM ()
handleArticleFavorite = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
post RoutePattern
"/api/articles/:slug/favorite" (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
  Slug
slug <- Text -> ActionT AppM Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
captureParam Text
"slug" ActionT AppM Text -> (Text -> Slug) -> ActionT AppM Slug
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Slug
Slug
  OneArticle
article <- AppM (Either ArticleError OneArticle) -> ActionT AppM OneArticle
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either ArticleError OneArticle) -> ActionT AppM OneArticle)
-> AppM (Either ArticleError OneArticle) -> ActionT AppM OneArticle
forall a b. (a -> b) -> a -> b
$ Slug -> UserID -> AppM (Either ArticleError OneArticle)
forall (m :: * -> *).
(CreateFavorite m, AquireArticle m, AcquireProfile m) =>
Slug -> UserID -> m (Either ArticleError OneArticle)
favoriteArticle Slug
slug AuthedUser
user.authedUserID
  InObj OneArticle -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (InObj OneArticle -> ActionT AppM ())
-> InObj OneArticle -> ActionT AppM ()
forall a b. (a -> b) -> a -> b
$ OneArticle -> InObj OneArticle
forall obj. obj -> InObj obj
inArticleObj OneArticle
article

favoriteArticle :: (CreateFavorite m, AquireArticle m, AcquireProfile m) => Slug -> UserID -> m (Either ArticleError OneArticle)
favoriteArticle :: forall (m :: * -> *).
(CreateFavorite m, AquireArticle m, AcquireProfile m) =>
Slug -> UserID -> m (Either ArticleError OneArticle)
favoriteArticle Slug
slug UserID
userID = ExceptT ArticleError m OneArticle
-> m (Either ArticleError OneArticle)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  ArticleID
articleID <- m (Either ArticleError ArticleID)
-> ExceptT ArticleError m ArticleID
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError ArticleID)
 -> ExceptT ArticleError m ArticleID)
-> (Either ArticleError ArticleID
    -> m (Either ArticleError ArticleID))
-> Either ArticleError ArticleID
-> ExceptT ArticleError m ArticleID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ArticleError ArticleID -> m (Either ArticleError ArticleID)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ArticleError ArticleID -> ExceptT ArticleError m ArticleID)
-> Either ArticleError ArticleID
-> ExceptT ArticleError m ArticleID
forall a b. (a -> b) -> a -> b
$ Slug -> Either ArticleError ArticleID
extractIDFromSlug Slug
slug
  m (Either ArticleError ()) -> ExceptT ArticleError m ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError ()) -> ExceptT ArticleError m ())
-> m (Either ArticleError ()) -> ExceptT ArticleError m ()
forall a b. (a -> b) -> a -> b
$ ArticleID -> UserID -> m (Either ArticleError ())
forall (m :: * -> *).
CreateFavorite m =>
ArticleID -> UserID -> m (Either ArticleError ())
addFavorite ArticleID
articleID UserID
userID
  m (Either ArticleError OneArticle)
-> ExceptT ArticleError m OneArticle
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError OneArticle)
 -> ExceptT ArticleError m OneArticle)
-> m (Either ArticleError OneArticle)
-> ExceptT ArticleError m OneArticle
forall a b. (a -> b) -> a -> b
$ Slug -> Maybe UserID -> m (Either ArticleError OneArticle)
forall (m :: * -> *).
(AquireArticle m, AcquireProfile m) =>
Slug -> Maybe UserID -> m (Either ArticleError OneArticle)
getArticle Slug
slug (UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
userID)

class (Monad m) => CreateFavorite m where
  addFavorite :: ArticleID -> UserID -> m (Either ArticleError ())

instance (Monad m, MonadDB m, MonadUnliftIO m) => CreateFavorite m where
  addFavorite :: ArticleID -> UserID -> m (Either ArticleError ())
  addFavorite :: ArticleID -> UserID -> m (Either ArticleError ())
addFavorite ArticleID
articleID UserID
userID = Either DBError () -> Either ArticleError ()
forall e a. FeatureError e => Either DBError a -> Either e a
mapDBError (Either DBError () -> Either ArticleError ())
-> m (Either DBError ()) -> m (Either ArticleError ())
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
    Favorite -> 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_ (Favorite -> SqlPersistT m ()) -> Favorite -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$ UserId -> ArticleId -> Favorite
Favorite (UserID -> UserId
forall t id. SqlKey t id => id -> Key t
id2sqlKey UserID
userID) (ArticleID -> ArticleId
forall t id. SqlKey t id => id -> Key t
id2sqlKey ArticleID
articleID)