@@ -43,7 +43,7 @@ import qualified GHC.Generics as GHC
4343import Data.Aeson
4444import qualified Data.Aeson as A
4545import Data.Binary.Builder (toLazyByteString)
46−import Servant.Docs (ToSample, samples, toSamples)
46+import Servant.Docs (ToSample, samples, toSamples, singleSample)
4747import qualified Data.Text as T
4848import qualified Data.Text.Encoding as T
4949import Text.Regex
@@ -66,7 +66,13 @@ instance ToSample Int where
6666 toSamples _ = samples [382934, 103845, 294905]
6767
6868instance ToSample UserCreation where
69− toSamples _ = samples $ [UserCreation "Seva" "Algebrovich" "Leonidov" "cs.hse.ru/dse" "vchernyshev@hse.ru"]
69+ toSamples _ = samples $ [UserCreation "Seva" "Algebrovich" "Leonidov" "cs.hse.ru/dse/" "vchernyshev@hse.ru"]
70+
71+instance ToSample TokenActivationData where
72+ toSamples _ = singleSample $ TokenActivationData 69 "ABCDE"
73+
74+instance ToSample TokenActivationResult where
75+ toSamples _ = samples [TokenActivationResultYou, TokenActivationResultNotYou]
7076
7177type LoginDescription = Description "Try to log in with the given email\n\nResponse fields:\n\n- `registered` -- User is registered and the cookie has been set. You now need to get a verification code from the user and pass it to `/verify`.\n- `canRegister` -- the email is valid, but the user needs to register. Prompt him for information and pass it to `/register`.\n- `invalid` -- the email is invalid."
7278
@@ -95,7 +101,14 @@ type AuthenticationHandler =
95101 Header "User-Agent" String :>
96102 PostNoContent '[JSON, PlainText, FormUrlEncoded] (Headers '[Header "Set-Cookie" String] NoContent) :<|>
97103 "checkCookie" :> CheckCookieDescription :>
98− Header "cookie" String :> GetNoContent '[JSON, PlainText, FormUrlEncoded] NoContent
104+ Header "cookie" String :> GetNoContent '[JSON, PlainText, FormUrlEncoded] NoContent :<|>
105+ "activate"
106+ :> Header "cookie" String
107+ :> ReqBody '[JSON] TokenActivationData
108+ :> Post '[JSON] TokenActivationResult :<|>
109+ "deactivate"
110+ :> ReqBody '[JSON] TokenActivationData
111+ :> PostNoContent '[JSON] NoContent
99112
100113data UserResponseStatus = UserIsRegistered | UserCanRegister | InvalidUser
101114 deriving (Show)
@@ -114,6 +127,27 @@ data AuthenticationCookieData = AuthenticationCookieData {
114127 cookieUserToken :: BS.ByteString
115128} deriving (Show, GHC.Generic, ToJSON, FromJSON)
116129
130+data TokenActivationData = TokenActivationData {
131+ tokenVerificationUserId :: UserId,
132+ tokenVerificationData :: BS.ByteString
133+} deriving (Show)
134+
135+instance ToJSON TokenActivationData where
136+ toJSON (TokenActivationData uId vData) = object [
137+ "id" .= uId,
138+ "data" .= vData
139+ ]
140+
141+instance FromJSON TokenActivationData where
142+ parseJSON = withObject "token verification data" $ \ e ->
143+ TokenActivationData <$> e .: "id" <*> e .: "data"
144+
145+data TokenActivationResult = TokenActivationResultYou | TokenActivationResultNotYou
146+
147+instance ToJSON TokenActivationResult where
148+ toJSON TokenActivationResultYou = object ["you" .= True]
149+ toJSON TokenActivationResultNotYou = object ["you" .= False]
150+
117151instance ToJSON BS.ByteString where
118152 toJSON = A.String . T.decodeUtf8 . BS.encode
119153
@@ -127,7 +161,7 @@ newtype AuthenticationCredits = AuthenticationCredits {authenticationEmail :: Us
127161 deriving (GHC.Generic, ToJSON, FromJSON)
128162
129163authenticationAPI :: ServerT AuthenticationHandler App
130−authenticationAPI = logIn :<|> logOut :<|> verifyToken :<|> register :<|> checkCookie
164+authenticationAPI = logIn :<|> logOut :<|> verifyToken :<|> register :<|> checkCookie :<|> validateTokenApi :<|> deactivateTokenApi
131165
132166logIn :: AuthenticationCredits -> Maybe String -> App (Headers '[Header "Set-Cookie" String] UserLoginResponse)
133167logIn (AuthenticationCredits email') ua' = do
@@ -189,6 +223,26 @@ logOut cookie = do
189223 setCookiePath = Just "/" }
190224 return $ addHeader (L.unpack . toLazyByteString . renderSetCookie $ newCookie) NoContent
191225
226+validateTokenApi :: Maybe String -> TokenActivationData -> App TokenActivationResult
227+validateTokenApi cookie' (TokenActivationData uId aData) = do
228+ tokenData' <- runQerror $ tryActivateToken uId aData
229+ case tokenData' of
230+ Nothing -> throwError err401
231+ Just tokenData -> do
232+ case cookie' >>= getCookie of
233+ Nothing -> return TokenActivationResultNotYou
234+ Just (AuthenticationCookieData uId' cData) ->
235+ if hash cData == tokenData && uId' == uId
236+ then return TokenActivationResultYou
237+ else return TokenActivationResultNotYou
238+
239+deactivateTokenApi :: TokenActivationData -> App NoContent
240+deactivateTokenApi (TokenActivationData uId dData) = do
241+ res <- runQerror $ deactivateToken uId dData
242+ if res
243+ then return NoContent
244+ else throwError err401
245+
192246checkToken :: DBConnection -> AuthenticationCookieData -> Handler UserId
193247checkToken conn (AuthenticationCookieData uId tokenData) = do
194248 token <- runQ' conn err500 $ getVerifiedToken uId tokenData