Begin work for supporting GoogleSignIn server-side

I'm attempting to be an obedient boy and implement this and future features
using TDD.

TL;DR:
- Defined a few tests
- Defined an empty GoogleSignIn module
- Defined a Fixtures module to quickly create JWTs to test

4 files changed, 92 insertions, 5 deletions

diff --git a/website/sandbox/learnpianochords/shell.nix b/website/sandbox/learnpianochords/shell.nix
index ea5a404b33a0..9402ad5674d2 100644
--- a/website/sandbox/learnpianochords/shell.nix
+++ b/website/sandbox/learnpianochords/shell.nix
@@ -11,6 +11,10 @@ in pkgs.mkShell {
       hpkgs.aeson
       hpkgs.wai-cors
       hpkgs.warp
+      hpkgs.jwt
+      hpkgs.unordered-containers
+      hpkgs.base64
+      hpkgs.http-conduit
     ]))
   ];
 }
diff --git a/website/sandbox/learnpianochords/src/server/Fixtures.hs b/website/sandbox/learnpianochords/src/server/Fixtures.hs
new file mode 100644
index 000000000000..93599c3e884e
--- /dev/null
+++ b/website/sandbox/learnpianochords/src/server/Fixtures.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
+module Fixtures where
+--------------------------------------------------------------------------------
+import Web.JWT
+import Utils
+
+import qualified Data.Map as Map
+--------------------------------------------------------------------------------
+
+-- | These are the JWT fields that I'd like to overwrite in the `googleJWT`
+-- function.
+data JWTFields = JWTFields
+  { overwriteSigner :: Signer
+  , overwriteAud :: Maybe StringOrURI
+  }
+
+defaultJWTFields :: JWTFields
+defaultJWTFields = JWTFields
+  { overwriteSigner = hmacSecret "secret"
+  , overwriteAud = stringOrURI "771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"
+  }
+
+googleJWT :: JWTFields -> Maybe (JWT UnverifiedJWT)
+googleJWT JWTFields{..} =
+  encodeSigned signer jwtHeader claimSet
+  |> decode
+  where
+    signer :: Signer
+    signer = overwriteSigner
+
+    jwtHeader :: JOSEHeader
+    jwtHeader = JOSEHeader
+      { typ = Just "JWT"
+      , cty = Nothing
+      , alg = Just RS256
+      , kid = Just "f05415b13acb9590f70df862765c655f5a7a019e"
+      }
+
+    claimSet :: JWTClaimsSet
+    claimSet = JWTClaimsSet
+      { iss = stringOrURI "accounts.google.com"
+      , sub = stringOrURI "114079822315085727057"
+      , aud = overwriteAud |> fmap Left
+      -- TODO: Replace date creation with a human-readable date constructor.
+      , Web.JWT.exp = numericDate 1596756453
+      , nbf = Nothing
+      -- TODO: Replace date creation with a human-readable date constructor.
+      , iat = numericDate 1596752853
+      , unregisteredClaims = ClaimsMap (Map.fromList [])
+      , jti = stringOrURI "0d3d7fa1fe05bedec0a91c88294936b2b4d1b13c"
+      }
diff --git a/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs b/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
new file mode 100644
index 000000000000..43fd79fbd619
--- /dev/null
+++ b/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
@@ -0,0 +1,14 @@
+--------------------------------------------------------------------------------
+module GoogleSignIn where
+--------------------------------------------------------------------------------
+import Web.JWT
+--------------------------------------------------------------------------------
+
+-- | Returns True when the supplied `jwt` meets the following criteria:
+-- * The token has been signed by Google
+-- * The value of `aud` matches my Google client's ID
+-- * The value of `iss` matches is "accounts.google.com" or
+--   "https://accounts.google.com"
+-- * The `exp` time has not passed
+jwtIsValid :: JWT UnverifiedJWT -> Bool
+jwtIsValid jwt = False
diff --git a/website/sandbox/learnpianochords/src/server/Spec.hs b/website/sandbox/learnpianochords/src/server/Spec.hs
index dfdd3ddebb05..69add5261836 100644
--- a/website/sandbox/learnpianochords/src/server/Spec.hs
+++ b/website/sandbox/learnpianochords/src/server/Spec.hs
@@ -1,13 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 module Spec where
 --------------------------------------------------------------------------------
 import Test.Hspec
-import Test.QuickCheck
-import Control.Exception (evaluate)
+import Web.JWT
+import Utils
+
+import qualified GoogleSignIn
+import qualified Fixtures as F
 --------------------------------------------------------------------------------
 
 main :: IO ()
 main = hspec $ do
-  describe "Testing" $ do
-    it "is setup" $ do
-      True == True
+  describe "GoogleSignIn" $ do
+    describe "jwtIsValid" $ do
+      it "returns false when the signature is invalid" $ do
+        let mJWT = F.defaultJWTFields { F.overwriteSigner = hmacSecret "wrong" }
+                   |> F.googleJWT
+        case mJWT of
+          Nothing -> True == False
+          Just jwt -> GoogleSignIn.jwtIsValid jwt == False
+
+      it "returns false when the aud field doesn't match my client ID" $ do
+        let mJWT = F.defaultJWTFields { F.overwriteAud = stringOrURI "wrong" }
+                  |> F.googleJWT
+        case mJWT of
+          Nothing -> True == False
+          Just jwt -> GoogleSignIn.jwtIsValid jwt == False