{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Articles.UpdateArticle where

import Prelude hiding (put)
import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB (..), expectDBNonZero)
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 (Article, assumingUserIsOwner)
import Conduit.Features.Articles.Errors (ArticleError (..))
import Conduit.Features.Articles.Slugs (extractIDFromSlug, mkNoIDSlug, mkSlug)
import Conduit.Features.Articles.Types (ArticleID(..), OneArticle, Slug(..), inArticleObj)
import Conduit.Identity.Auth (authedUserID, withAuth)
import Conduit.Validation (NotBlank(..), parseJsonBody, (<?!<))
import Data.Aeson (FromJSON(..), (.:?), withObject)
import Database.Esqueleto.Experimental (set, updateCount, val, valkey, where_, (=.), (==.))
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, json, put)

data UpdateArticleAction = UpdateArticleAction
  { UpdateArticleAction -> Maybe Text
title       :: Maybe Text
  , UpdateArticleAction -> Maybe Text
description :: Maybe Text
  , UpdateArticleAction -> Maybe Text
body        :: Maybe Text
  }

instance FromJSON UpdateArticleAction where
  parseJSON :: Value -> Parser UpdateArticleAction
parseJSON = String
-> (Object -> Parser UpdateArticleAction)
-> Value
-> Parser UpdateArticleAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UpdateArticleAction" ((Object -> Parser UpdateArticleAction)
 -> Value -> Parser UpdateArticleAction)
-> (Object -> Parser UpdateArticleAction)
-> Value
-> Parser UpdateArticleAction
forall a b. (a -> b) -> a -> b
$ \Object
v -> Maybe Text -> Maybe Text -> Maybe Text -> UpdateArticleAction
UpdateArticleAction
    (Maybe Text -> Maybe Text -> Maybe Text -> UpdateArticleAction)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> UpdateArticleAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe (Assurance NotBlank Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title"       Parser (Maybe (Assurance NotBlank Text))
-> NotBlank -> Parser (Maybe Text)
forall prop on.
Parser (Maybe (Assurance prop on)) -> prop -> Parser (Maybe on)
<?!< NotBlank
NotBlank
    Parser (Maybe Text -> Maybe Text -> UpdateArticleAction)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> UpdateArticleAction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Assurance NotBlank Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" Parser (Maybe (Assurance NotBlank Text))
-> NotBlank -> Parser (Maybe Text)
forall prop on.
Parser (Maybe (Assurance prop on)) -> prop -> Parser (Maybe on)
<?!< NotBlank
NotBlank
    Parser (Maybe Text -> UpdateArticleAction)
-> Parser (Maybe Text) -> Parser UpdateArticleAction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Assurance NotBlank Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body"        Parser (Maybe (Assurance NotBlank Text))
-> NotBlank -> Parser (Maybe Text)
forall prop on.
Parser (Maybe (Assurance prop on)) -> prop -> Parser (Maybe on)
<?!< NotBlank
NotBlank

handleArticleUpdate :: ScottyT AppM ()
handleArticleUpdate :: ScottyT AppM ()
handleArticleUpdate = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
put 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
  UpdateArticleAction
action <- ActionT AppM UpdateArticleAction
forall a (m :: * -> *).
(MonadUnliftIO m, FromJSON a) =>
ActionT m a
parseJsonBody
  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
$ UpdateArticleAction
-> Slug -> UserID -> AppM (Either ArticleError OneArticle)
forall (m :: * -> *).
(UpdateArticle m, AquireArticle m, AcquireProfile m) =>
UpdateArticleAction
-> Slug -> UserID -> m (Either ArticleError OneArticle)
updateArticle UpdateArticleAction
action 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

updateArticle :: (UpdateArticle m, AquireArticle m, AcquireProfile m) => UpdateArticleAction -> Slug -> UserID -> m (Either ArticleError OneArticle)
updateArticle :: forall (m :: * -> *).
(UpdateArticle m, AquireArticle m, AcquireProfile m) =>
UpdateArticleAction
-> Slug -> UserID -> m (Either ArticleError OneArticle)
updateArticle UpdateArticleAction {Maybe Text
$sel:title:UpdateArticleAction :: UpdateArticleAction -> Maybe Text
$sel:description:UpdateArticleAction :: UpdateArticleAction -> Maybe Text
$sel:body:UpdateArticleAction :: UpdateArticleAction -> Maybe Text
title :: Maybe Text
description :: Maybe Text
body :: Maybe Text
..} 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

  let maybeNewSlug :: Maybe Slug
maybeNewSlug = Maybe Text
title Maybe Text -> (Text -> Slug) -> Maybe Slug
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ArticleID -> NoIDSlug -> Slug
mkSlug ArticleID
articleID (NoIDSlug -> Slug) -> (Text -> NoIDSlug) -> Text -> Slug
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NoIDSlug
mkNoIDSlug
      toUpdate :: ToUpdate
toUpdate = Maybe Text -> Maybe Text -> Maybe Text -> Maybe Slug -> ToUpdate
ToUpdate Maybe Text
title Maybe Text
description Maybe Text
body Maybe Slug
maybeNewSlug

  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 -> ToUpdate -> m (Either ArticleError ())
forall (m :: * -> *).
UpdateArticle m =>
ArticleID -> UserID -> ToUpdate -> m (Either ArticleError ())
updateArticleByID ArticleID
articleID UserID
userID ToUpdate
toUpdate
  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 (Maybe Slug
maybeNewSlug Maybe Slug -> Slug -> Slug
forall a. Maybe a -> a -> a
?: Slug
slug) (UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
userID)

class (Monad m) => UpdateArticle m where
  updateArticleByID :: ArticleID -> UserID -> ToUpdate -> m (Either ArticleError ())

data ToUpdate = ToUpdate
  { ToUpdate -> Maybe Text
title :: Maybe Text
  , ToUpdate -> Maybe Text
desc  :: Maybe Text
  , ToUpdate -> Maybe Text
body  :: Maybe Text
  , ToUpdate -> Maybe Slug
slug  :: Maybe Slug
  }

instance (Monad m, MonadDB m, MonadUnliftIO m) => UpdateArticle m where
  updateArticleByID :: ArticleID -> UserID -> ToUpdate -> m (Either ArticleError ())
  updateArticleByID :: ArticleID -> UserID -> ToUpdate -> m (Either ArticleError ())
updateArticleByID ArticleID
articleID UserID
userID ToUpdate {Maybe Text
Maybe Slug
$sel:title:ToUpdate :: ToUpdate -> Maybe Text
$sel:desc:ToUpdate :: ToUpdate -> Maybe Text
$sel:body:ToUpdate :: ToUpdate -> Maybe Text
$sel:slug:ToUpdate :: ToUpdate -> Maybe Slug
title :: Maybe Text
desc :: Maybe Text
body :: Maybe Text
slug :: Maybe Slug
..} = 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
    Text
-> 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 (Text
"todo" :: Text) UserID
userID ArticleID
articleID do
      forall (m :: * -> *) val backend.
(MonadIO m, PersistEntity val,
 BackendCompatible SqlBackend (PersistEntityBackend val),
 SqlBackendCanWrite backend) =>
(SqlExpr (Entity val) -> SqlQuery ()) -> ReaderT backend m Int64
updateCount @_ @Article ((SqlExpr (Entity Article) -> SqlQuery ()) -> SqlPersistT m Int64)
-> (SqlExpr (Entity Article) -> SqlQuery ()) -> SqlPersistT m Int64
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity Article)
a -> do
        Maybe Text -> (Text -> SqlQuery ()) -> SqlQuery ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe Text
title \Text
new -> SqlExpr (Entity Article)
-> [SqlExpr (Entity Article) -> SqlExpr Update] -> SqlQuery ()
forall val.
PersistEntity val =>
SqlExpr (Entity val)
-> [SqlExpr (Entity val) -> SqlExpr Update] -> SqlQuery ()
set SqlExpr (Entity Article)
a [ EntityField Article Text
#title EntityField Article Text
-> SqlExpr (Value Text)
-> SqlExpr (Entity Article)
-> SqlExpr Update
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update
=. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
new        ]
        Maybe Text -> (Text -> SqlQuery ()) -> SqlQuery ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe Text
desc  \Text
new -> SqlExpr (Entity Article)
-> [SqlExpr (Entity Article) -> SqlExpr Update] -> SqlQuery ()
forall val.
PersistEntity val =>
SqlExpr (Entity val)
-> [SqlExpr (Entity val) -> SqlExpr Update] -> SqlQuery ()
set SqlExpr (Entity Article)
a [ EntityField Article Text
#desc  EntityField Article Text
-> SqlExpr (Value Text)
-> SqlExpr (Entity Article)
-> SqlExpr Update
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update
=. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
new        ]
        Maybe Text -> (Text -> SqlQuery ()) -> SqlQuery ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe Text
body  \Text
new -> SqlExpr (Entity Article)
-> [SqlExpr (Entity Article) -> SqlExpr Update] -> SqlQuery ()
forall val.
PersistEntity val =>
SqlExpr (Entity val)
-> [SqlExpr (Entity val) -> SqlExpr Update] -> SqlQuery ()
set SqlExpr (Entity Article)
a [ EntityField Article Text
#body  EntityField Article Text
-> SqlExpr (Value Text)
-> SqlExpr (Entity Article)
-> SqlExpr Update
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update
=. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
new        ]
        Maybe Slug -> (Slug -> SqlQuery ()) -> SqlQuery ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe Slug
slug  \Slug
new -> SqlExpr (Entity Article)
-> [SqlExpr (Entity Article) -> SqlExpr Update] -> SqlQuery ()
forall val.
PersistEntity val =>
SqlExpr (Entity val)
-> [SqlExpr (Entity val) -> SqlExpr Update] -> SqlQuery ()
set SqlExpr (Entity Article)
a [ EntityField Article Text
#slug  EntityField Article Text
-> SqlExpr (Value Text)
-> SqlExpr (Entity Article)
-> SqlExpr Update
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update
=. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Slug
new.unSlug ]
        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)