{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Comments.AddComment where

import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB, SqlKey(..), mapDBResult, runDB)
import Conduit.DB.Utils (dbTimeNow)
import Conduit.Features.Account.Types (UserID)
import Conduit.Features.Articles.Comments.GetComments (AquireComment, getComments)
import Conduit.Features.Articles.DB (Comment(..))
import Conduit.Features.Articles.Errors (ArticleError(..))
import Conduit.Features.Articles.Slugs (extractIDFromSlug)
import Conduit.Features.Articles.Types (ArticleID, CommentID, ManyComments(..), OneComment(..), Slug(..), inCommentObj)
import Conduit.Identity.Auth (authedUserID, withAuth)
import Conduit.Validation (NotBlank(..), (<!<), parseJsonBody)
import Data.Aeson (FromJSON(..), (.:), withObject)
import Database.Esqueleto.Experimental (insert)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, json, post)

newtype CreateCommentAction = CreateCommentAction
  { CreateCommentAction -> Text
body :: Text
  }

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

handleCommentCreation :: ScottyT AppM ()
handleCommentCreation :: ScottyT AppM ()
handleCommentCreation = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
post RoutePattern
"/api/articles/:slug/comments" (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
  CreateCommentAction
body <- ActionT AppM CreateCommentAction
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
  OneComment
comment <- AppM (Either ArticleError OneComment) -> ActionT AppM OneComment
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either ArticleError OneComment) -> ActionT AppM OneComment)
-> AppM (Either ArticleError OneComment) -> ActionT AppM OneComment
forall a b. (a -> b) -> a -> b
$ CreateCommentAction
-> Slug -> UserID -> AppM (Either ArticleError OneComment)
forall (m :: * -> *).
(AquireComment m, CreateComment m) =>
CreateCommentAction
-> Slug -> UserID -> m (Either ArticleError OneComment)
createComment CreateCommentAction
body Slug
slug AuthedUser
user.authedUserID
  InObj OneComment -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (InObj OneComment -> ActionT AppM ())
-> InObj OneComment -> ActionT AppM ()
forall a b. (a -> b) -> a -> b
$ OneComment -> InObj OneComment
forall obj. obj -> InObj obj
inCommentObj OneComment
comment

createComment :: (AquireComment m, CreateComment m) => CreateCommentAction -> Slug -> UserID -> m (Either ArticleError OneComment)
createComment :: forall (m :: * -> *).
(AquireComment m, CreateComment m) =>
CreateCommentAction
-> Slug -> UserID -> m (Either ArticleError OneComment)
createComment CreateCommentAction {Text
$sel:body:CreateCommentAction :: CreateCommentAction -> Text
body :: Text
..} Slug
slug UserID
authorID = ExceptT ArticleError m OneComment
-> m (Either ArticleError OneComment)
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
  CommentID
commentID <- m (Either ArticleError CommentID)
-> ExceptT ArticleError m CommentID
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError CommentID)
 -> ExceptT ArticleError m CommentID)
-> m (Either ArticleError CommentID)
-> ExceptT ArticleError m CommentID
forall a b. (a -> b) -> a -> b
$ CommentInfo -> m (Either ArticleError CommentID)
forall (m :: * -> *).
CreateComment m =>
CommentInfo -> m (Either ArticleError CommentID)
insertComment CommentInfo
    { $sel:authorID:CommentInfo :: UserID
authorID  = UserID
authorID
    , $sel:articleID:CommentInfo :: ArticleID
articleID = ArticleID
articleID
    , $sel:body:CommentInfo :: Text
body      = Text
body
    }
  ManyComments [OneComment]
comments <- m (Either ArticleError ManyComments)
-> ExceptT ArticleError m ManyComments
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError ManyComments)
 -> ExceptT ArticleError m ManyComments)
-> m (Either ArticleError ManyComments)
-> ExceptT ArticleError m ManyComments
forall a b. (a -> b) -> a -> b
$ Slug -> Maybe UserID -> m (Either ArticleError ManyComments)
forall (m :: * -> *).
AquireComment m =>
Slug -> Maybe UserID -> m (Either ArticleError ManyComments)
getComments Slug
slug (UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
authorID)
  m (Either ArticleError OneComment)
-> ExceptT ArticleError m OneComment
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError OneComment)
 -> ExceptT ArticleError m OneComment)
-> (Maybe OneComment -> m (Either ArticleError OneComment))
-> Maybe OneComment
-> ExceptT ArticleError m OneComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ArticleError OneComment
-> m (Either ArticleError OneComment)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ArticleError OneComment
 -> m (Either ArticleError OneComment))
-> (Maybe OneComment -> Either ArticleError OneComment)
-> Maybe OneComment
-> m (Either ArticleError OneComment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArticleError -> Maybe OneComment -> Either ArticleError OneComment
forall l r. l -> Maybe r -> Either l r
maybeToRight ArticleError
ResourceNotFoundEx (Maybe OneComment -> ExceptT ArticleError m OneComment)
-> Maybe OneComment -> ExceptT ArticleError m OneComment
forall a b. (a -> b) -> a -> b
$ (OneComment -> Bool) -> [OneComment] -> Maybe OneComment
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\OneComment
c -> OneComment
c.commentID CommentID -> CommentID -> Bool
forall a. Eq a => a -> a -> Bool
== CommentID
commentID) [OneComment]
comments -- def don't do this in actual code, I'm just lazy :)

class (Monad m) => CreateComment m where
  insertComment :: CommentInfo -> m (Either ArticleError CommentID)

data CommentInfo = CommentInfo
  { CommentInfo -> UserID
authorID  :: UserID
  , CommentInfo -> ArticleID
articleID :: ArticleID
  , CommentInfo -> Text
body      :: Text
  }

instance (Monad m, MonadDB m, MonadUnliftIO m) => CreateComment m where
  insertComment :: CommentInfo -> m (Either ArticleError CommentID)
  insertComment :: CommentInfo -> m (Either ArticleError CommentID)
insertComment CommentInfo {Text
UserID
ArticleID
$sel:authorID:CommentInfo :: CommentInfo -> UserID
$sel:articleID:CommentInfo :: CommentInfo -> ArticleID
$sel:body:CommentInfo :: CommentInfo -> Text
authorID :: UserID
articleID :: ArticleID
body :: Text
..} = (Key Comment -> CommentID)
-> Either DBError (Key Comment) -> Either ArticleError CommentID
forall e a b.
FeatureError e =>
(a -> b) -> Either DBError a -> Either e b
mapDBResult Key Comment -> CommentID
forall t id. SqlKey t id => Key t -> id
sqlKey2ID (Either DBError (Key Comment) -> Either ArticleError CommentID)
-> m (Either DBError (Key Comment))
-> m (Either ArticleError CommentID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m (Key Comment) -> m (Either DBError (Key Comment))
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
runDB do
    Comment -> SqlPersistT m (Key Comment)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert (Comment -> SqlPersistT m (Key Comment))
-> Comment -> SqlPersistT m (Key Comment)
forall a b. (a -> b) -> a -> b
$ UserID -> ArticleID -> Text -> Comment
mkComment UserID
authorID ArticleID
articleID Text
body

mkComment :: UserID -> ArticleID -> Text -> Comment
mkComment :: UserID -> ArticleID -> Text -> Comment
mkComment (UserID -> Key User
forall t id. SqlKey t id => id -> Key t
id2sqlKey -> Key User
authorID) (ArticleID -> Key Article
forall t id. SqlKey t id => id -> Key t
id2sqlKey -> Key Article
articleID) Text
body = Key User -> Key Article -> Text -> UTCTime -> UTCTime -> Comment
Comment Key User
authorID Key Article
articleID Text
body UTCTime
dbTimeNow UTCTime
dbTimeNow