11f9306b9a
Use nixos-unstable-small which fixes CVE-2018-25032
(out of bounds write while compressing).
* //users/grfn/xanthous:
- Supporting random-fu 0.3 requires considerable changes and patching
random-extras (https://github.com/aristidb/random-extras/pull/5).
For now we downgrade random-fu and its dependency rvar to 0.2.*,
forcing us to build xanthous with GHC 8.10.7, due to random-fu 0.2.*
not supporting that version.
Nix expressions for the downgraded packages are checked in to avoid
the potential need to compile Haskell at pipeline eval time.
- generic-arbitrary exposes a GenericArbitrary newtype now.
This means we no longer have to implement it in xanthous
downstream and patch generic-arbitrary to expose the
GArbitrary type class.
- Minor adjustments for lens 5.0:
Xanthous.Game.Memo: clear needs to use ASetter' instead of Lens'
Xanthous.Data.EntityMap: TraversableWithIndex no longer has an
itraversed function.
- Xanthous.Orphans: adjust for aeson's KeyMap, use KM.size explicitly
instead of relying on MonoTraversable's length
* //nix/buildLisp: the CCL issue has resurfaced, disabling the
implementation once again.
* //3p/arion: remove, as depot uses the nixpkgs package of it anyways.
* //users/wpcarro: accomodate GHC 9.0.1's stricter parsing of operators.
* //users/tazjin: disable rustfmt as it stopped respecting settings
* //3p/overlays: upgrade home-manager until fix for serivce generation
has landed upstream
* //users/grfn/system: remove rr override, as the pinned commit is part
of the 5.5.0 release shipped by nixpkgs.
Change-Id: If229e7317ba48498f85170b57ee9053f6997ff8a
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5428
Tested-by: BuildkiteCI
Autosubmit: sterni <sternenseemann@systemli.org>
Reviewed-by: grfn <grfn@gws.fyi>
Reviewed-by: tazjin <tazjin@tvl.su>
Reviewed-by: wpcarro <wpcarro@gmail.com>
57 lines
2 KiB
Haskell
57 lines
2 KiB
Haskell
--------------------------------------------------------------------------------
|
|
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 Stripe
|
|
import qualified Types as T
|
|
--------------------------------------------------------------------------------
|
|
|
|
server :: T.Context -> Server API
|
|
server ctx@T.Context{..} = verifyGoogleSignIn
|
|
:<|> createPaymentIntent
|
|
where
|
|
verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> Handler NoContent
|
|
verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do
|
|
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
|
|
throwError err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
|
|
|
|
createPaymentIntent :: T.PaymentIntent -> Handler T.CreatePaymentIntentResponse
|
|
createPaymentIntent pmt = do
|
|
clientSecret <- liftIO $ Stripe.createPaymentIntent ctx pmt
|
|
pure T.CreatePaymentIntentResponse{..}
|
|
|
|
run :: T.App
|
|
run = do
|
|
ctx@T.Context{..} <- ask
|
|
ctx
|
|
|> server
|
|
|> serve (Proxy @API)
|
|
|> cors (const $ Just corsPolicy)
|
|
|> Warp.run contextServerPort
|
|
|> liftIO
|
|
pure $ Right ()
|
|
where
|
|
corsPolicy :: CorsResourcePolicy
|
|
corsPolicy = simpleCorsResourcePolicy
|
|
{ corsOrigins = Just (["http://localhost:8000"], True)
|
|
, corsMethods = simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"]
|
|
, corsRequestHeaders = simpleHeaders ++ ["Content-Type", "Authorization"]
|
|
}
|