blob: 095e6169b8eb607e3ed1e9b4a5051010c827313a (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
--------------------------------------------------------------------------------
module App where
--------------------------------------------------------------------------------
import RIO hiding (Handler)
import Servant
import API
import Data.String.Conversions (cs)
import Control.Monad.IO.Class (liftIO)
import Network.Wai.Middleware.Cors
import GoogleSignIn (EncodedJWT(..), ValidationResult(..))
import Utils
import qualified Network.Wai.Handler.Warp as Warp
import qualified GoogleSignIn
import qualified Types as T
--------------------------------------------------------------------------------
server :: ServerT API T.App
server = verifyGoogleSignIn
where
verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> T.App NoContent
verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do
T.Context{..} <- ask
validationResult <- liftIO $ GoogleSignIn.validateJWT False (EncodedJWT idToken)
case validationResult of
Valid _ -> do
-- If GoogleLinkedAccounts has email from JWT:
-- create a new session for email
-- Else:
-- Redirect the SPA to the sign-up / payment page
pure NoContent
err -> do
-- TODO: I would prefer to use `throwError` here, but after changing
-- to ServerT, I couldn't get the code to compile.
throwIO err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
run :: T.App ()
run = do
ctx@T.Context{..} <- ask
server
|> hoistServer (Proxy @ API) (runRIO ctx)
|> serve (Proxy @ API)
|> cors (const $ Just corsPolicy)
|> Warp.run contextServerPort
|> liftIO
where
corsPolicy :: CorsResourcePolicy
corsPolicy = simpleCorsResourcePolicy
{ corsOrigins = Just (["http://localhost:8000"], True)
, corsMethods = simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"]
, corsRequestHeaders = simpleHeaders ++ ["Content-Type", "Authorization"]
}
|
