Commit 60e8186f authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

finished post and deleteUserFollowCoach.

parent c8343191
......@@ -30,7 +30,10 @@ type UserProfileAPI =
:> DeleteNoContent '[ JSON] NoContent
userProfileApi :: MonadIO m => AuthResult User -> ServerT UserProfileAPI (CoachT m)
userProfileApi authres = getUserProfileCoach authres :<|> panic ""
userProfileApi authres =
getUserProfileCoach authres
:<|> postUserFollowCoach authres
:<|> deleteUserFollowCoach authres
userProfileProxy :: Proxy UserProfileAPI
userProfileProxy = Proxy
......
......@@ -5,6 +5,7 @@ module Coach.Profile where
import Lib.Prelude
import Database.Esqueleto hiding (isNothing)
import Servant
import Servant.Auth.Server
import Servant.Server
......@@ -39,4 +40,23 @@ getUserProfileCoach authres profilename = do
follow
where
authresToMaybe (Authenticated x) = Just x
authresToMaybe _ = Nothing
authresToMaybe _ = Nothing
postUserFollowCoach ::
MonadIO m => AuthResult User -> Text -> CoachT m NoContent
postUserFollowCoach (Authenticated user) profilename = do
follows <- runDb $ selectFollows (userUsername user) profilename
unless (null follows) $
throwError err409 {errBody = "Already followed that profile"}
runDb $ insertFollows (userUsername user) profilename
return NoContent
postUserFollowCoach _ _ = throwError err401
deleteUserFollowCoach :: MonadIO m => AuthResult User -> Text -> CoachT m NoContent
deleteUserFollowCoach (Authenticated user) profilename = do
follows <- runDb $ selectFollows (userUsername user) profilename
when (null follows) $
throwError err404 {errBody = "You are not following that profile"}
runDb $ deleteFollows (userUsername user) profilename
return NoContent
deleteUserFollowCoach _ _ = throwError err401
......@@ -46,6 +46,59 @@ selectFollowsByUsernameAndProfilename Nothing profilename = do
where_ (profile ^. UserUsername ==. val profilename)
return (profile, val False)
selectFollows ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Text
-> Text
-> ReaderT backend m [Entity Follow]
selectFollows username profilename = do
select $
from $ \(user `InnerJoin` follow `InnerJoin` profile) -> do
on (follow ^. FollowAuthorId ==. profile ^. UserId)
on (follow ^. FollowFollowerId ==. user ^. UserId)
where_ (user ^. UserUsername ==. val username)
where_ (profile ^. UserUsername ==. val profilename)
return follow
insertFollows ::
( PersistUniqueWrite backend
, PersistQueryWrite backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Text
-> Text
-> ReaderT backend m ()
insertFollows username profilename = do
insertSelect $
from $ \(user, profile) -> do
where_ (user ^. UserUsername ==. val username)
where_ (profile ^. UserUsername ==. val profilename)
return $ Follow <# (user ^. UserId) <&> (profile ^. UserId)
deleteFollows ::
( PersistUniqueWrite backend
, PersistQueryWrite backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Text
-> Text
-> ReaderT backend m ()
deleteFollows username profilename = do
delete $
from $ \follows -> do
where_ $
exists $
from $ \(user, profile) -> do
where_ (follows ^. FollowAuthorId ==. profile ^. UserId)
where_ (follows ^. FollowFollowerId ==. user ^. UserId)
where_ (user ^. UserUsername ==. val username)
where_ (profile ^. UserUsername ==. val profilename)
selectUserByUsernameEmail ::
( PersistUniqueRead backend
......
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