From e9e84f6a08c0711c498c7f1f0c9aefc39520c7a7 Mon Sep 17 00:00:00 2001
From: William Carroll <wpcarro@gmail.com>
Date: Sun, 2 Aug 2020 16:30:28 +0100
Subject: 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.
---
 src/Types.hs | 39 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 37 insertions(+), 2 deletions(-)

(limited to 'src/Types.hs')

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{..}
-- 
cgit 1.4.1