finished getArticlesCoach, getArticlesFeedCoach, and getArticleSlugCoach.

parent ad4f1e1f
......@@ -26,9 +26,11 @@ library
, API.Tags
, Que.Tags
, Que.Users
, Que.Articles
, Coach.Tags
, Coach.Users
, Coach.Profile
, Coach.Articles
, RealWorld
, DevelMain
other-modules: Lib.Prelude
......
......@@ -8,9 +8,11 @@ import Lib.Prelude
import Servant
import Servant.Auth.Server
import Types
import Model
import Conf
import Model
import Types
import Coach.Articles
type ArticlesAPI =
"articles"
......@@ -65,7 +67,11 @@ articlesProxy :: Proxy ArticlesAPI
articlesProxy = Proxy
articlesApi :: MonadIO m => AuthResult User -> ServerT ArticlesAPI (CoachT m)
articlesApi authres = panic ""
articlesApi authres =
getArticlesCoach authres
:<|> getArticlesFeed authres
:<|> getArticleSlugCoach authres
:<|> panic ""
articlesServer :: Configuration -> AuthResult User -> Server ArticlesAPI
articlesServer conf authres =
......
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
module Coach.Articles where
import Lib.Prelude
import Database.Esqueleto hiding (isNothing)
import Servant
import Servant.Auth.Server
import Conf
import Model
import Types
import Util
import Que.Articles
getArticlesCoach ::
MonadIO m
=> AuthResult User
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int64
-> Maybe Int64
-> CoachT m ResponseMultiArticle
getArticlesCoach authres mtag mauthor mfavorited mlimit moffset = do
articles <-
runDb $
selectArticles
(userUsername <$> authresToMaybe authres)
False -- is feed?
Nothing -- slug name?
mtag
mauthor
mfavorited
(fromMaybe 20 mlimit)
(fromMaybe 0 moffset)
return $
ResponseMultiArticle
(map resultQueryToResponseArticle articles)
(length articles)
getArticleSlugCoach ::
MonadIO m
=> AuthResult User
-> Text
-> CoachT m ResponseArticle
getArticleSlugCoach authres slug = do
articles <-
runDb $
selectArticles
(userUsername <$> authresToMaybe authres)
False
(Just slug)
Nothing
Nothing
Nothing
1
0
case articles of
[] -> throwError err404 {errBody = "No such article."}
x:_ -> return $ ResponseArticle $ resultQueryToResponseArticle x
getArticlesFeed ::
MonadIO m
=> AuthResult User
-> Maybe Int64
-> Maybe Int64
-> CoachT m ResponseMultiArticle
getArticlesFeed (Authenticated user) mlimit moffset = do
articles <-
runDb $
selectArticles
(Just $ userUsername user)
True
Nothing
Nothing
Nothing
Nothing
(fromMaybe 20 mlimit)
(fromMaybe 0 moffset)
return $
ResponseMultiArticle
(map resultQueryToResponseArticle articles)
(length articles)
getArticlesFeed _ _ _ = throwError err401 {errBody = "Only authenticated user."}
resultQueryToResponseArticle ::
( Entity Article
, Entity User
, Value (Maybe [Text])
, Value Int64
, Value Bool
, Value Bool)
-> ResponseArticleBody
resultQueryToResponseArticle (entarticle, entauthor, vtags, vfavcounts, vfaving, vfoll) =
let Article {..} = entityVal entarticle
User {..} = entityVal entauthor
tagnames = unValue vtags
favcounts = unValue vfavcounts
isfavoriting = unValue vfaving
isfollowing = unValue vfoll
in ResponseArticleBody
articleSlug
articleTitle
articleDescription
articleBody
tagnames
articleCreatedAt
articleUpdatedAt
isfavoriting
favcounts $
ResponseProfileBody userUsername userBio userImage isfollowing
......@@ -11,6 +11,7 @@ import Servant.Auth.Server
import Conf
import Model
import Types
import Util
import Que.Users
......@@ -37,9 +38,6 @@ getUserProfileCoach authres profilename = do
(userBio user)
(userImage user)
follow
where
authresToMaybe (Authenticated x) = Just x
authresToMaybe _ = Nothing
postUserFollowCoach ::
MonadIO m => AuthResult User -> Text -> CoachT m NoContent
......
{-# LANGUAGE FlexibleContexts #-}
module Que.Articles where
import Lib.Prelude hiding (from, get, on,
(<&>))
import Database.Esqueleto
import Database.Esqueleto.Internal.Language
import Database.Esqueleto.PostgreSQL
import Model
selectArticles ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Maybe Text
-> Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int64
-> Int64
-> ReaderT backend m [( Entity Article
, Entity User
, Value (Maybe [Text])
, Value Int64
, Value Bool
, Value Bool)]
selectArticles musername isfeed mslug mtag mauthor mfavoritedby lim off = do
select $
from $ \(article
`InnerJoin` author
`LeftOuterJoin` tagged
`LeftOuterJoin` tags
`LeftOuterJoin` favorited
`LeftOuterJoin` favoriter) -> do
on (favorited ^. FavoritedUserId ==. favoriter ^. UserId)
on (favorited ^. FavoritedArticleId ==. article ^. ArticleId)
on (tags ^. TagId ==. tagged ^. TaggedTagId)
on (article ^. ArticleId ==. tagged ^. TaggedArticleId)
on (author ^. UserId ==. article ^. ArticleAuthorId)
let tagnames =
sub_select $
from $ \(tagged', tags') -> do
where_ (tagged' ^. TaggedArticleId ==. article ^. ArticleId)
where_ (tagged' ^. TaggedTagId ==. tags' ^. TagId)
return $ arrayAgg $ tags' ^. TagName
favoritecounts =
sub_select $
from $ \(favorited', user) -> do
where_ (favorited' ^. FavoritedUserId ==. user ^. UserId)
where_ (favorited' ^. FavoritedArticleId ==. article ^. ArticleId)
return $ count $ user ^. UserId
favoritingArticle Nothing = val False
favoritingArticle (Just username) =
case_
[ when_
(exists $
from $ \(favorited', user) -> do
where_
(favorited' ^. FavoritedArticleId ==. article ^.
ArticleId)
where_ (favorited' ^. FavoritedUserId ==. user ^. UserId)
where_ (user ^. UserUsername ==. val username))
then_ $
val True
]
(else_ $ val False)
followingAuthor Nothing = val False
followingAuthor (Just username) =
case_
[ when_
(exists $
from $ \(follow, user) -> do
where_ (follow ^. FollowAuthorId ==. author ^. UserId)
where_ (follow ^. FollowFollowerId ==. user ^. UserId)
where_ (user ^. UserUsername ==. val username))
then_ $
val True
]
(else_ $ val False)
whereMaybe mslug article ArticleSlug
whereMaybe mtag tags TagName
whereMaybe mauthor author UserUsername
whereMaybe mfavoritedby favoriter UserUsername
whereSublist isfeed musername author UserId subscribedAuthorQuery
limit lim
offset off
return
( article
, author
, tagnames
, favoritecounts
, favoritingArticle musername
, followingAuthor musername)
whereMaybe ::
(PersistField typ, Esqueleto query expr backend, PersistEntity val)
=> Maybe typ
-> expr (Entity val)
-> EntityField val typ
-> query ()
whereMaybe Nothing _ _ = return ()
whereMaybe (Just x) entity accessor = where_ $ entity ^. accessor ==. val x
whereSublist ::
(PersistField typ, Esqueleto query expr backend, PersistEntity val)
=> Bool
-> Maybe t
-> expr (Entity val)
-> EntityField val typ
-> (t -> query (expr (Value typ)))
-> query ()
whereSublist True (Just username) ent acc q = where_ $ ent ^. acc `in_` (subList_select $ q username)
whereSublist True Nothing _ _ _ = return ()
whereSublist False _ _ _ _ = return ()
subscribedAuthorQuery ::
( FromPreprocess query expr backend (expr (Entity Follow))
, FromPreprocess query expr backend (expr (Entity User))
)
=> Text
-> query (expr (Value (Key User)))
subscribedAuthorQuery username = do
from $ \(user `InnerJoin` follow `InnerJoin` author) -> do
on $ follow ^. FollowAuthorId ==. author ^. UserId
on $ follow ^. FollowFollowerId ==. user ^. UserId
where_ $ user ^. UserUsername ==. val username
return $ author ^. UserId
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Que.Tags where
import Lib.Prelude hiding (from, get, on, (<&>))
......
......@@ -5,6 +5,7 @@ import Lib.Prelude
import Crypto.BCrypt
import Data.ByteString.Char8 (pack)
import Data.Text (unpack)
import Servant.Auth.Server
generatePassword :: Text -> IO Text
generatePassword password = do
......@@ -15,3 +16,7 @@ generatePassword password = do
case mpass of
Nothing -> generatePassword password
Just pa -> return (decodeUtf8 pa)
authresToMaybe :: AuthResult a -> Maybe a
authresToMaybe (Authenticated x) = Just x
authresToMaybe _ = Nothing
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment