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
.
type Jwt =
sub :: Username
{ exp :: Number
,
}...
"Jwt"
CAR.object : usernameCodec -- username: usernameCodec -- TODO fix
{ subexp: CA.number
, }
In Conduit.Data.Auth
change username
to sub
.
exp, username } <- hush $ Jwt.decode token
{ pure { 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
.
mkClaims :: Username -> IO ClaimsSet
= do
mkClaims name <- getCurrentTime
currentTime let expiredAt = addUTCTime nominalDay currentTime
pure $ emptyClaimsSet
& claimIss ?~ "conduit-server"
& claimAud ?~ Audience ["conduit-client"]
& claimIat ?~ NumericDate currentTime
& claimExp ?~ NumericDate expiredAt
& 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?
{
"user" : {
"bio" : "",
"email" : "arya@winterfell.com",
"image" : "",
"token" : "eyJhbGciOiJIUzI1NiJ9.eyJhdWQiOiJiYWxkci1jbGllbnQiLCJleHAiOjEuNjY3MjA1NjIxMDE1MzQ5MzE5ZTksImlhdCI6MS42NjcxMTkyMjEwMTUzNDkzMTllOSwiaXNzIjoiYmFsZHItc2VydmVyIiwic3ViIjoiQXJ5YSAxIn0.TzhDvT9Mkmj9nalh_q7vGol-IbnRRoxoiGPQwlasaGQ",
"username" : "Arya 1"
}
}
Console error logging:
(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:
Under 'Response':
At object key user:
Under 'User':
At object key image:
Under 'Maybe':
Under 'Avatar':
Unexpected value "".)
The client code has different codecs for image
and bio
Conduit.Data.Profile
-- | Codecs
mkProfileRepCodec :: forall rest. CA.JPropCodec (Record rest) -> CA.JPropCodec { | ProfileRep rest }
=
mkProfileRepCodec Proxy :: Proxy "username") usernameCodec
CA.recordProp (<<< CA.recordProp (Proxy :: Proxy "bio") (CAC.maybe CA.string)
<<< CA.recordProp (Proxy :: Proxy "image") (CAC.maybe avatarCodec)
but avatarCodec is also a string in the end
Conduit.Data.Avatar
-- | Codecs
avatarCodec :: JsonCodec Avatar
= CA.prismaticCodec "Avatar" fromString toString CA.string avatarCodec
hence weird.
WORKAROUND
In Conduit.Data.Avatar
change fromString to the following1:
fromString :: String -> Maybe Avatar
fromString str| String.null str = Just (Avatar "")
| 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
).
(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:
Under 'UserResponse':
At object key user:
Under 'User':
At object key token:
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
resolver: lts-19.31
...
extra-deps:
- slugger-0.1.0.1@sha256:b6c37b0d4c2d35a49ad20e9978bf0ce308a8c4455fc61d0b446db1f3971bdc28,2035
nix:
pure: true
enable: true
packages: [ postgresql zlib icu]
(trying out resolver: lts-19.31
— the nix section is for use with NixOS
)
package.yaml
...
dependencies:
...
- slugger
...
(Add slugger to depencies)
Conduit.Core.Article
...
import Data.Text.Slugger (toSlug)
...
mkSlug :: MonadIO m => Text -> m Slug
= do
mkSlug title <- liftIO $ getRandomBytes 32
rnd let hash = T.pack $ show $ hashWith SHA256 (rnd :: ByteString)
let title' = toSlug title
let slugText = T.intercalate "-" $ (T.words . T.toLower $ title') ++ [T.take 8 hash]
return $ Slug slugText
...
Comments don’t work
Completely breaks the client; reload of page and re-login needed.