diff options
author | William Carroll <wpcarro@gmail.com> | 2020-08-02T15·30+0100 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2020-08-02T15·30+0100 |
commit | e9e84f6a08c0711c498c7f1f0c9aefc39520c7a7 (patch) | |
tree | bde2d3e291d59d134d230e9ff446a47a0f65dc37 /src/Types.hs | |
parent | 25334080b9bcdf238f75069feb92fba65896da5e (diff) |
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.
Diffstat (limited to 'src/Types.hs')
-rw-r--r-- | src/Types.hs | 39 |
1 files changed, 37 insertions, 2 deletions
diff --git a/src/Types.hs b/src/Types.hs index 7fe3f2b15d39..235e8a6d06df 100644 --- a/src/Types.hs +++ b/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{..} |