{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Articles.CreateArticle where

import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), SqlKey(..), mapDBResult)
import Conduit.DB.Utils (dbTimeNow)
import Conduit.Features.Account.Common.FindProfileByID (AcquireProfile)
import Conduit.Features.Account.DB (UserId)
import Conduit.Features.Account.Types (UserID)
import Conduit.Features.Articles.Articles.GetArticle (AquireArticle, getArticle)
import Conduit.Features.Articles.DB (Article(..))
import Conduit.Features.Articles.Errors (ArticleError)
import Conduit.Features.Articles.Slugs (mkNoIDSlug, mkSlug)
import Conduit.Features.Articles.Types (ArticleID, NoIDSlug(..), OneArticle, inArticleObj)
import Conduit.Identity.Auth (authedUserID, withAuth)
import Conduit.Validation (NotBlank(..), (<!<), parseJsonBody)
import Data.Aeson (FromJSON(..), withObject, (.:))
import Database.Esqueleto.Experimental (insert)
import Network.HTTP.Types (status201)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, json, post, status)

data CreateArticleAction = CreateArticleAction
  { CreateArticleAction -> Text
title       :: Text
  , CreateArticleAction -> Text
description :: Text
  , CreateArticleAction -> Text
body        :: Text
  , CreateArticleAction -> Maybe [Text]
tagList     :: Maybe [Text]
  }

instance FromJSON CreateArticleAction where
  parseJSON :: Value -> Parser CreateArticleAction
parseJSON = String
-> (Object -> Parser CreateArticleAction)
-> Value
-> Parser CreateArticleAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateArticleAction" ((Object -> Parser CreateArticleAction)
 -> Value -> Parser CreateArticleAction)
-> (Object -> Parser CreateArticleAction)
-> Value
-> Parser CreateArticleAction
forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> Text -> Text -> Maybe [Text] -> CreateArticleAction
CreateArticleAction
    (Text -> Text -> Text -> Maybe [Text] -> CreateArticleAction)
-> Parser Text
-> Parser (Text -> Text -> Maybe [Text] -> CreateArticleAction)
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
"title"       Parser (Assurance NotBlank Text) -> NotBlank -> Parser Text
forall prop on. Parser (Assurance prop on) -> prop -> Parser on
<!< NotBlank
NotBlank
    Parser (Text -> Text -> Maybe [Text] -> CreateArticleAction)
-> Parser Text
-> Parser (Text -> Maybe [Text] -> CreateArticleAction)
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 (Assurance NotBlank Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description" Parser (Assurance NotBlank Text) -> NotBlank -> Parser Text
forall prop on. Parser (Assurance prop on) -> prop -> Parser on
<!< NotBlank
NotBlank
    Parser (Text -> Maybe [Text] -> CreateArticleAction)
-> Parser Text -> Parser (Maybe [Text] -> CreateArticleAction)
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 (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
    Parser (Maybe [Text] -> CreateArticleAction)
-> Parser (Maybe [Text]) -> Parser CreateArticleAction
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 [Text])
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tagList"

handleArticleCreation :: ScottyT AppM ()
handleArticleCreation :: ScottyT AppM ()
handleArticleCreation = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
post RoutePattern
"/api/articles" (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
  CreateArticleAction
action <- ActionT AppM CreateArticleAction
forall a (m :: * -> *).
(MonadUnliftIO m, FromJSON a) =>
ActionT m a
parseJsonBody
  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
$ CreateArticleAction
-> UserID -> AppM (Either ArticleError OneArticle)
forall (m :: * -> *).
(CreateArticle m, AquireArticle m, AcquireProfile m) =>
CreateArticleAction -> UserID -> m (Either ArticleError OneArticle)
createArticle CreateArticleAction
action AuthedUser
user.authedUserID
  Status -> ActionT AppM ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status201
  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

createArticle :: (CreateArticle m, AquireArticle m, AcquireProfile m) => CreateArticleAction -> UserID -> m (Either ArticleError OneArticle)
createArticle :: forall (m :: * -> *).
(CreateArticle m, AquireArticle m, AcquireProfile m) =>
CreateArticleAction -> UserID -> m (Either ArticleError OneArticle)
createArticle CreateArticleAction {Maybe [Text]
Text
$sel:title:CreateArticleAction :: CreateArticleAction -> Text
$sel:description:CreateArticleAction :: CreateArticleAction -> Text
$sel:body:CreateArticleAction :: CreateArticleAction -> Text
$sel:tagList:CreateArticleAction :: CreateArticleAction -> Maybe [Text]
title :: Text
description :: Text
body :: Text
tagList :: Maybe [Text]
..} UserID
author = ExceptT ArticleError m OneArticle
-> m (Either ArticleError OneArticle)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  let slug :: NoIDSlug
slug = Text -> NoIDSlug
mkNoIDSlug Text
title
      article :: ArticleInfo
article = UserID
-> NoIDSlug -> Text -> Text -> Text -> Maybe [Text] -> ArticleInfo
ArticleInfo UserID
author NoIDSlug
slug Text
title Text
description Text
body Maybe [Text]
tagList

  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)
-> m (Either ArticleError ArticleID)
-> ExceptT ArticleError m ArticleID
forall a b. (a -> b) -> a -> b
$ ArticleInfo -> m (Either ArticleError ArticleID)
forall (m :: * -> *).
CreateArticle m =>
ArticleInfo -> m (Either ArticleError ArticleID)
insertArticle ArticleInfo
article
  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 (ArticleID -> NoIDSlug -> Slug
mkSlug ArticleID
articleID NoIDSlug
slug) (UserID -> Maybe UserID
forall a. a -> Maybe a
Just UserID
author)

class (Monad m) => CreateArticle m where
  insertArticle :: ArticleInfo -> m (Either ArticleError ArticleID)

data ArticleInfo = ArticleInfo
  { ArticleInfo -> UserID
author :: UserID
  , ArticleInfo -> NoIDSlug
slug   :: NoIDSlug
  , ArticleInfo -> Text
title  :: Text
  , ArticleInfo -> Text
desc   :: Text
  , ArticleInfo -> Text
body   :: Text
  , ArticleInfo -> Maybe [Text]
tags   :: Maybe [Text]
  }

instance (Monad m, Conduit.DB.Core.MonadDB m, MonadUnliftIO m) => CreateArticle m where
  insertArticle :: ArticleInfo -> m (Either ArticleError ArticleID)
  insertArticle :: ArticleInfo -> m (Either ArticleError ArticleID)
insertArticle ArticleInfo {Maybe [Text]
Text
UserID
NoIDSlug
$sel:author:ArticleInfo :: ArticleInfo -> UserID
$sel:slug:ArticleInfo :: ArticleInfo -> NoIDSlug
$sel:title:ArticleInfo :: ArticleInfo -> Text
$sel:desc:ArticleInfo :: ArticleInfo -> Text
$sel:body:ArticleInfo :: ArticleInfo -> Text
$sel:tags:ArticleInfo :: ArticleInfo -> Maybe [Text]
author :: UserID
slug :: NoIDSlug
title :: Text
desc :: Text
body :: Text
tags :: Maybe [Text]
..} = (Key Article -> ArticleID)
-> Either DBError (Key Article) -> Either ArticleError ArticleID
forall e a b.
FeatureError e =>
(a -> b) -> Either DBError a -> Either e b
Conduit.DB.Core.mapDBResult Key Article -> ArticleID
forall t id. SqlKey t id => Key t -> id
Conduit.DB.Core.sqlKey2ID (Either DBError (Key Article) -> Either ArticleError ArticleID)
-> m (Either DBError (Key Article))
-> m (Either ArticleError ArticleID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m (Key Article) -> m (Either DBError (Key Article))
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
Conduit.DB.Core.runDB do
    Article -> SqlPersistT m (Key Article)
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 (UserId -> Text -> Text -> Text -> Text -> [Text] -> Article
mkArticle (UserID -> UserId
forall t id. SqlKey t id => id -> Key t
Conduit.DB.Core.id2sqlKey UserID
author) NoIDSlug
slug.unSlug Text
title Text
desc Text
body (Maybe [Text]
tags Maybe [Text] -> [Text] -> [Text]
forall a. Maybe a -> a -> a
?: []))

mkArticle :: UserId -> Text -> Text -> Text -> Text -> [Text] -> Article
mkArticle :: UserId -> Text -> Text -> Text -> Text -> [Text] -> Article
mkArticle UserId
author Text
slug Text
title Text
desc Text
body [Text]
tags = UserId
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> UTCTime
-> UTCTime
-> Article
Article UserId
author Text
slug Text
title Text
desc Text
body [Text]
tags UTCTime
dbTimeNow UTCTime
dbTimeNow