Skip to content

Commit

Permalink
remove singleUser json API endpoint
Browse files Browse the repository at this point in the history
  • Loading branch information
sigrdrifa committed Jul 2, 2024
1 parent 6af18d3 commit c80fee7
Show file tree
Hide file tree
Showing 3 changed files with 28 additions and 22 deletions.
21 changes: 20 additions & 1 deletion lib/Api/Templates/User/User.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,26 @@ import Api.Templates.Helpers.Htmx (hxExt_, hxPost_, hxSwap_, hxTarget_)
import Data.Text qualified as T
import Database.Persist (Entity (entityKey, entityVal))
import Database.Persist.Postgresql (fromSqlKey)
import Lucid
import Lucid (
Html,
ToHtml (toHtml),
alt_,
button_,
class_,
div_,
form_,
h3_,
id_,
img_,
input_,
li_,
name_,
p_,
placeholder_,
src_,
type_,
ul_,
)
import Models (User (userName))

renderAddUserForm :: Html ()
Expand Down
20 changes: 1 addition & 19 deletions lib/Api/User.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,20 +10,16 @@ import Database.Persist.Postgresql (
Entity (..),
getEntity,
insert,
selectFirst,
selectList,
(==.),
)
import Servant (
Capture,
Get,
HasServer (ServerT),
JSON,
Post,
Proxy (..),
ReqBody,
ServerError (errBody, errHTTPCode, errHeaders),
err404,
err500,
throwError,
type (:<|>) (..),
Expand All @@ -38,7 +34,6 @@ import Data.Time (getCurrentTime)
import GHC.Generics (Generic)
import Lucid (Html, ToHtml (toHtml), class_, div_, id_, renderBS)
import Models (User (User), runDb, tryRunDb)
import Models qualified as Md
import Servant.API.ContentTypes.Lucid (HTML)

data CreateUserPayload = CreateUserPayload
Expand All @@ -51,15 +46,14 @@ instance FromJSON CreateUserPayload

type UserAPI =
"users" :> Get '[HTML] (Html ())
:<|> "users" :> Capture "name" Data.Text.Text :> Get '[JSON] (Entity User)
:<|> "users" :> ReqBody '[JSON] CreateUserPayload :> Post '[HTML] (Html ())

userApi :: Proxy UserAPI
userApi = Proxy

-- | The server that runs the UserAPI
userServer :: (MonadIO m) => ServerT UserAPI (AppT m)
userServer = allUsers :<|> singleUser :<|> createUser
userServer = allUsers :<|> createUser

-- | Returns all users in the database.
allUsers :: (MonadIO m) => AppT m (Html ())
Expand All @@ -68,18 +62,6 @@ allUsers = do
users :: [Entity User] <- runDb (selectList [] [])
return $ renderUsersComponent users

-- | Returns a user by name or throws a 404 error.
singleUser :: (MonadIO m) => Data.Text.Text -> AppT m (Entity User)
singleUser str = do
logDebugNS "web" "singleUser"
maybeUser <- runDb (selectFirst [Md.UserName ==. str] [])
case maybeUser of
Nothing -> do
logDebugNS "web" "failed to find user"
throwError err404
Just person ->
return person

-- | Creates a user in the database.
createUser :: (MonadIO m) => CreateUserPayload -> AppT m (Html ())
createUser u = do
Expand Down
9 changes: 7 additions & 2 deletions test/Api/UserSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,12 @@ spec = before
context "when rendering a user" $ do
it "renders a user" $
( \currentTime -> do
let user = User{userName = "user", userEmail = "[email protected]", userCreatedAt = currentTime}
let entity = Entity (Key user) user
let user =
User
{ userName = "user"
, userEmail = "[email protected]"
, userCreatedAt = currentTime
}
-- let entity = Entity (Key user) user
userName user `shouldBe` "user"
)

0 comments on commit c80fee7

Please sign in to comment.