Support POST /accept-invitation
Allow users to accept invitations that we email to them. TL;DR: - I learned how to write FromHttpApiData instances, which allows me to parse/validate data at the edges of my application; this substantially cleans up my Handler code.
This commit is contained in:
parent
25334080b9
commit
e9e84f6a08
4 changed files with 77 additions and 19 deletions
39
src/Types.hs
39
src/Types.hs
|
|
@ -401,7 +401,13 @@ instance FromHttpApiData SessionCookie where
|
|||
x |> TE.encodeUtf8 |> parseCookies |> SessionCookie |> pure
|
||||
|
||||
newtype RegistrationSecret = RegistrationSecret UUID.UUID
|
||||
deriving (Eq, Show)
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromHttpApiData RegistrationSecret where
|
||||
parseQueryParam x =
|
||||
case UUID.fromText x of
|
||||
Nothing -> Left x
|
||||
Just uuid -> Right (RegistrationSecret uuid)
|
||||
|
||||
instance FromField RegistrationSecret where
|
||||
fromField field =
|
||||
|
|
@ -482,7 +488,10 @@ instance FromJSON InviteUserRequest where
|
|||
pure InviteUserRequest{..}
|
||||
|
||||
newtype InvitationSecret = InvitationSecret UUID.UUID
|
||||
deriving (Eq, Show)
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON InvitationSecret
|
||||
instance FromJSON InvitationSecret
|
||||
|
||||
instance ToField InvitationSecret where
|
||||
toField (InvitationSecret secretUUID) =
|
||||
|
|
@ -496,3 +505,29 @@ instance FromField InvitationSecret where
|
|||
Nothing -> returnError ConversionFailed field ("Could not convert text to UUID: " ++ show x)
|
||||
Just x -> Ok $ InvitationSecret x
|
||||
_ -> returnError ConversionFailed field "Field data is not SQLText, which is what we expect"
|
||||
|
||||
data Invitation = Invitation
|
||||
{ invitationEmail :: Email
|
||||
, invitationRole :: Role
|
||||
, invitationSecret :: InvitationSecret
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromRow Invitation where
|
||||
fromRow = Invitation <$> field
|
||||
<*> field
|
||||
<*> field
|
||||
|
||||
data AcceptInvitationRequest = AcceptInvitationRequest
|
||||
{ acceptInvitationRequestUsername :: Username
|
||||
, acceptInvitationRequestPassword :: ClearTextPassword
|
||||
, acceptInvitationRequestEmail :: Email
|
||||
, acceptInvitationRequestSecret :: InvitationSecret
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON AcceptInvitationRequest where
|
||||
parseJSON = withObject "AcceptInvitationRequest" $ \x -> do
|
||||
acceptInvitationRequestUsername <- x .: "username"
|
||||
acceptInvitationRequestPassword <- x .: "password"
|
||||
acceptInvitationRequestEmail <- x .: "email"
|
||||
acceptInvitationRequestSecret <- x .: "secret"
|
||||
pure AcceptInvitationRequest{..}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue