Servant server + Halo client
The Haskell-realworld-example Haskell example (Servant based server) and the Real World PureScript React Purescript example (client) combined into Conduit (gothinkster/realworld) — what's described as "The mother of all demo apps" (fullstack Medium.com clone)
Introduction
Haskell-realworld-example has a very nice implementation for JWT authentication, which combines nicely with the Real World PureScript React example (although there are some implementation differences to iron out).
Implementation differences
JWT
Changes to the client
In Conduit.Data.Jwt change username to sub.
1type Jwt =
2{ sub :: Username
3, exp :: Number
4}
5...
6CAR.object "Jwt"
7 { sub: usernameCodec -- username: usernameCodec -- TODO fix
8 , exp: CA.number
9 }
In Conduit.Data.Auth change username to sub.
1{ exp, username } <- hush $ Jwt.decode token
2pure { token, username, expirationTime: fromMilliseconds $ Milliseconds $ exp * 1000.0, user }
Changes to the server
In Conduit.JWT you'll problably want to change mkClaims to use your own names for iss and aud.
1mkClaims :: Username -> IO ClaimsSet
2mkClaims name = do
3 currentTime <- getCurrentTime
4 let expiredAt = addUTCTime nominalDay currentTime
5 pure $ emptyClaimsSet
6 & claimIss ?~ "conduit-server"
7 & claimAud ?~ Audience ["conduit-client"]
8 & claimIat ?~ NumericDate currentTime
9 & claimExp ?~ NumericDate expiredAt
10 & claimSub ?~ (fromString . T.unpack . getUsername) name
Empty image field in login response
The server returns apparently valid JSON — hence weird problem — with an empty image field, but the client reports a decoding error. If the image field is set to a value (by changing it directly in the users table in the database as a workaround) then it functions correctly; even though the bio field is also empty — even weirder.
This may be because an empty field should not be sent by the server (when it's an optional field).
Then again, if the server wants to send an optional empty field then that should be optional?
1{
2 "user" : {
3 "bio" : "",
4 "email" : "arya@winterfell.com",
5 "image" : "",
6 "token" : "eyJhbGciOiJIUzI1NiJ9.eyJhdWQiOiJiYWxkci1jbGllbnQiLCJleHAiOjEuNjY3MjA1NjIxMDE1MzQ5MzE5ZTksImlhdCI6MS42NjcxMTkyMjEwMTUzNDkzMTllOSwiaXNzIjoiYmFsZHItc2VydmVyIiwic3ViIjoiQXJ5YSAxIn0.TzhDvT9Mkmj9nalh_q7vGol-IbnRRoxoiGPQwlasaGQ",
7 "username" : "Arya 1"
8 }
9}
Console error logging:
1(DecodeError { body: "{\"user\":{\"email\":\"arya@winterfell.com\",\"password\":\"valar_morghulis\"}}", headers: [(ContentType (MediaType "application/json"))], method: POST, url: "/api/users/login" } { body: "{\"user\":{\"bio\":\"\",\"email\":\"arya@winterfell.com\",\"image\":\"\",\"token\":\"eyJhbGciOiJIUzI1NiJ9.eyJhdWQiOiJiYWxkci1jbGllbnQiLCJleHAiOjEuNjY3MjA1NjIxMDE1MzQ5MzE5ZTksImlhdCI6MS42NjcxMTkyMjEwMTUzNDkzMTllOSwiaXNzIjoiYmFsZHItc2VydmVyIiwic3ViIjoiQXJ5YSAxIn0.TzhDvT9Mkmj9nalh_q7vGol-IbnRRoxoiGPQwlasaGQ\",\"username\":\"Arya 1\"}}", headers: [(ResponseHeader "connection" "keep-alive"),(ResponseHeader "content-type" "application/json;charset=utf-8"),(ResponseHeader "date" "Sun, 30 Oct 2022 08:40:21 GMT"),(ResponseHeader "server" "nginx/1.21.6"),(ResponseHeader "transfer-encoding" "chunked")], status: (StatusCode 200) } An error occurred while decoding a JSON value:
2 Under 'Response':
3 At object key user:
4 Under 'User':
5 At object key image:
6 Under 'Maybe':
7 Under 'Avatar':
8 Unexpected value "".)
The client code has different codecs for image and bio
Conduit.Data.Profile
1-- | Codecs
2mkProfileRepCodec :: forall rest. CA.JPropCodec (Record rest) -> CA.JPropCodec { | ProfileRep rest }
3mkProfileRepCodec =
4 CA.recordProp (Proxy :: Proxy "username") usernameCodec
5 <<< CA.recordProp (Proxy :: Proxy "bio") (CAC.maybe CA.string)
6 <<< CA.recordProp (Proxy :: Proxy "image") (CAC.maybe avatarCodec)
but avatarCodec is also a string in the end
Conduit.Data.Avatar
1-- | Codecs
2avatarCodec :: JsonCodec Avatar
3avatarCodec = CA.prismaticCodec "Avatar" fromString toString CA.string
hence weird.
WORKAROUND
In Conduit.Data.Avatar change fromString to the following1:
1fromString :: String -> Maybe Avatar
2fromString str
3 | String.null str = Just (Avatar "")
4 | otherwise = Just (Avatar str)
Beware: now there's no longer no avatar (which might be bad, but still better than the alternative).
1 One could even use fromString str = Just (Avatar str) but that would probably be even more confusing.
Token in User update response
The server doesn't return a token field, but the client expects it. The update user section in the Realworld spec also mentions it (hence issue in server).
Also the password is changed to something you no longer know, hence logging in is impossible after a user update (it's probably a bug).
1(DecodeError { body: "null", headers: [(ContentType (MediaType "application/json")),(RequestHeader "Authorization" "Token eyJhbGciOiJIUzI1NiJ9.eyJhdWQiOiJiYWxkci1jbGllbnQiLCJleHAiOjEuNjY3MjA1NjM3MjcwMTAyMzcyZTksImlhdCI6MS42NjcxMTkyMzcyNzAxMDIzNzJlOSwiaXNzIjoiYmFsZHItc2VydmVyIiwic3ViIjoiQXJ5YSAxIn0.tQ4JqPXoBu7RDSjF0gJeBi8NDJFGp7w7D8cxjUXMUno")], method: GET, url: "/api/user" } { body: "{\"user\":{\"bio\":\"\",\"email\":\"arya@winterfell.com\",\"image\":\"smiley-cyrus.09f77aa9.jpg\",\"username\":\"Arya 1\"}}", headers: [(ResponseHeader "connection" "keep-alive"),(ResponseHeader "content-type" "application/json;charset=utf-8"),(ResponseHeader "date" "Sun, 30 Oct 2022 10:42:00 GMT"),(ResponseHeader "server" "nginx/1.21.6"),(ResponseHeader "transfer-encoding" "chunked")], status: (StatusCode 200) } An error occurred while decoding a JSON value:
2 Under 'UserResponse':
3 At object key user:
4 Under 'User':
5 At object key token:
6 No value was found.) index.b98cbc1b.js:1:50285
Forbidden characters in slugs
The server doesn't check if the characters in the title (which are used to create the slug) are valid. This can be fixed by e.g. using the slugger library.
stack.yaml
1resolver: lts-19.31
2...
3extra-deps:
4 - slugger-0.1.0.1@sha256:b6c37b0d4c2d35a49ad20e9978bf0ce308a8c4455fc61d0b446db1f3971bdc28,2035
5
6nix:
7 pure: true
8 enable: true
9 packages: [ postgresql zlib icu]
(trying out resolver: lts-19.31 — the nix section is for use with NixOS)
package.yaml
1...
2 dependencies:
3...
4 - slugger
5...
(Add slugger to depencies)
Conduit.Core.Article
1...
2import Data.Text.Slugger (toSlug)
3...
4mkSlug :: MonadIO m => Text -> m Slug
5mkSlug title = do
6 rnd <- liftIO $ getRandomBytes 32
7 let hash = T.pack $ show $ hashWith SHA256 (rnd :: ByteString)
8 let title' = toSlug title
9 let slugText = T.intercalate "-" $ (T.words . T.toLower $ title') ++ [T.take 8 hash]
10 return $ Slug slugText
11...
Comments don't work
Completely breaks the client; reload of page and re-login needed.