diff --git a/website/sandbox/learnpianochords/shell.nix b/website/sandbox/learnpianochords/shell.nix index bf7a640fd..ea5a404b3 100644 --- a/website/sandbox/learnpianochords/shell.nix +++ b/website/sandbox/learnpianochords/shell.nix @@ -5,8 +5,12 @@ in pkgs.mkShell { elmPackages.elm elmPackages.elm-format elmPackages.elm-live - (haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [ - hspec + (haskellPackages.ghcWithPackages (hpkgs: [ + hpkgs.hspec + hpkgs.servant-server + hpkgs.aeson + hpkgs.wai-cors + hpkgs.warp ])) ]; } diff --git a/website/sandbox/learnpianochords/src/server/API.hs b/website/sandbox/learnpianochords/src/server/API.hs new file mode 100644 index 000000000..039252e76 --- /dev/null +++ b/website/sandbox/learnpianochords/src/server/API.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +-------------------------------------------------------------------------------- +module API where +-------------------------------------------------------------------------------- +import Data.Text +import Servant.API +import Web.Cookie + +import qualified Types as T +-------------------------------------------------------------------------------- + +type API = "verify" + :> ReqBody '[JSON] T.VerifyGoogleSignInRequest + :> Post '[JSON] NoContent diff --git a/website/sandbox/learnpianochords/src/server/Main.hs b/website/sandbox/learnpianochords/src/server/Main.hs index 5fca22a45..2d7120bd6 100644 --- a/website/sandbox/learnpianochords/src/server/Main.hs +++ b/website/sandbox/learnpianochords/src/server/Main.hs @@ -1,6 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- module Main where -------------------------------------------------------------------------------- +import Servant +import API +import Control.Monad.IO.Class (liftIO) + +import qualified Network.Wai.Handler.Warp as Warp +import qualified Network.Wai.Middleware.Cors as Cors +import qualified Types as T +-------------------------------------------------------------------------------- + +server :: Server API +server = verifyGoogleSignIn + where + verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> Handler NoContent + verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do + liftIO $ putStrLn $ "Received: " ++ idToken + pure NoContent main :: IO () -main = putStrLn "Working!" +main = do + Warp.run 3000 (enforceCors $ serve (Proxy @ API) $ server) + where + enforceCors = Cors.cors (const $ Just corsPolicy) + corsPolicy :: Cors.CorsResourcePolicy + corsPolicy = + Cors.simpleCorsResourcePolicy + { Cors.corsOrigins = Just (["http://localhost:8000"], True) + , Cors.corsMethods = Cors.simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"] + , Cors.corsRequestHeaders = Cors.simpleHeaders ++ ["Content-Type", "Authorization"] + } diff --git a/website/sandbox/learnpianochords/src/server/Types.hs b/website/sandbox/learnpianochords/src/server/Types.hs new file mode 100644 index 000000000..66a5573f6 --- /dev/null +++ b/website/sandbox/learnpianochords/src/server/Types.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +module Types where +-------------------------------------------------------------------------------- +import Data.Aeson +-------------------------------------------------------------------------------- + +data VerifyGoogleSignInRequest = VerifyGoogleSignInRequest + { idToken :: String + } deriving (Eq, Show) + +instance FromJSON VerifyGoogleSignInRequest where + parseJSON = withObject "" $ \x -> do + idToken <- x .: "idToken" + pure VerifyGoogleSignInRequest{..} diff --git a/website/sandbox/learnpianochords/src/server/index.html b/website/sandbox/learnpianochords/src/server/index.html index ce80faf0d..459a5c8c8 100644 --- a/website/sandbox/learnpianochords/src/server/index.html +++ b/website/sandbox/learnpianochords/src/server/index.html @@ -11,11 +11,18 @@ Sign out