{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Articles.DeleteArticle where

import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), expectDBNonZero)
import Conduit.Features.Account.Types (UserID(..))
import Conduit.Features.Articles.DB (Article, assumingUserIsOwner)
import Conduit.Features.Articles.Errors (ArticleError (..))
import Conduit.Features.Articles.Slugs (extractIDFromSlug)
import Conduit.Features.Articles.Types (ArticleID(..), Slug(..))
import Conduit.Identity.Auth (authedUserID, withAuth)
import Database.Esqueleto.Experimental (deleteCount, from, table, valkey, where_, (==.))
import Network.HTTP.Types (status204)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, status)
import Web.Scotty.Trans qualified as Scotty

handleArticleDelete :: ScottyT AppM ()
handleArticleDelete :: ScottyT AppM ()
handleArticleDelete = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
Scotty.delete RoutePattern
"/api/articles/:slug" (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
  AppM (Either ArticleError ()) -> ActionT AppM ()
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either ArticleError ()) -> ActionT AppM ())
-> AppM (Either ArticleError ()) -> ActionT AppM ()
forall a b. (a -> b) -> a -> b
$ Slug -> UserID -> AppM (Either ArticleError ())
forall (m :: * -> *).
DeleteArticle m =>
Slug -> UserID -> m (Either ArticleError ())
deleteArticle Slug
slug AuthedUser
user.authedUserID
  Status -> ActionT AppM ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status204

deleteArticle :: (DeleteArticle m) => Slug -> UserID -> m (Either ArticleError ())
deleteArticle :: forall (m :: * -> *).
DeleteArticle m =>
Slug -> UserID -> m (Either ArticleError ())
deleteArticle Slug
slug UserID
userID = ExceptT ArticleError m () -> m (Either ArticleError ())
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 :: * -> *).
DeleteArticle m =>
ArticleID -> UserID -> m (Either ArticleError ())
deleteArticleByID ArticleID
articleID UserID
userID

class (Monad m) => DeleteArticle m where
  deleteArticleByID :: ArticleID -> UserID -> m (Either ArticleError ())

instance (Monad m, MonadDB m, MonadUnliftIO m) => DeleteArticle m where
  deleteArticleByID :: ArticleID -> UserID -> m (Either ArticleError ())
  deleteArticleByID :: ArticleID -> UserID -> m (Either ArticleError ())
deleteArticleByID ArticleID
articleID UserID
userID = ArticleError -> Either DBError Int64 -> Either ArticleError ()
forall e cnt.
(FeatureError e, Num cnt, Ord cnt) =>
e -> Either DBError cnt -> Either e ()
expectDBNonZero ArticleError
ResourceNotFoundEx (Either DBError Int64 -> Either ArticleError ())
-> m (Either DBError Int64) -> m (Either ArticleError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m Int64 -> m (Either DBError Int64)
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
runDB do
    ArticleError
-> UserID
-> ArticleID
-> SqlPersistT m Int64
-> SqlPersistT m Int64
forall table id (m :: * -> *) a e.
(OwnableEntity table, SqlKey table id, MonadIO m, Show e) =>
e -> UserID -> id -> SqlPersistT m a -> SqlPersistT m a
assumingUserIsOwner ArticleError
IllegalArticleDelEx UserID
userID ArticleID
articleID do
      SqlQuery () -> SqlPersistT m Int64
forall (m :: * -> *) backend.
(MonadIO m, SqlBackendCanWrite backend) =>
SqlQuery () -> ReaderT backend m Int64
deleteCount (SqlQuery () -> SqlPersistT m Int64)
-> SqlQuery () -> SqlPersistT m Int64
forall a b. (a -> b) -> a -> b
$ do
        SqlExpr (Entity Article)
a <- From (SqlExpr (Entity Article))
-> SqlQuery (SqlExpr (Entity Article))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Article)
        SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Article)
a.id SqlExpr (Value (Key Article))
-> SqlExpr (Value (Key Article)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Int64 -> SqlExpr (Value (Key Article))
forall entity.
(ToBackendKey SqlBackend entity, PersistField (Key entity)) =>
Int64 -> SqlExpr (Value (Key entity))
valkey ArticleID
articleID.unID)