Add client-side token validation

Signed-off-by: Sascha Grunert <mail@saschagrunert.de>

nix/default.nix

@@ -7,8 +7,8 @@
 , persistent, persistent-sqlite, persistent-template, safe
 , shakespeare, stdenv, tasty, tasty-hspec, tasty-quickcheck
 , template-haskell, temporary, text, time, unordered-containers
-, vector, wai, wai-extra, wai-logger, warp, yaml, yesod, yesod-auth
-, yesod-core, yesod-form, yesod-static, yesod-test
+, uuid, vector, wai, wai-extra, wai-logger, warp, yaml, yesod
+, yesod-auth, yesod-core, yesod-form, yesod-static, yesod-test
 }:
 mkDerivation {
   pname = "performabot";
@@ -23,8 +23,8 @@ mkDerivation {
     hslogger http-client http-client-tls http-conduit lens megaparsec
     monad-control monad-logger persistent persistent-sqlite
     persistent-template safe shakespeare template-haskell temporary
-    text time unordered-containers vector wai wai-extra wai-logger warp
-    yaml yesod yesod-auth yesod-core yesod-form yesod-static
+    text time unordered-containers uuid vector wai wai-extra wai-logger
+    warp yaml yesod yesod-auth yesod-core yesod-form yesod-static
   ];
   libraryToolDepends = [ hpack ];
   executableHaskellDepends = [

package.yaml

@@ -115,6 +115,7 @@ library:
     - text
     - time
     - unordered-containers
+    - uuid
     - vector
     - wai
     - wai-extra

performabot.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a6884df1b62f16200c9854fc4e7e101fbfd650b64ba7248a900764727b5ed43e
+-- hash: 29443bc3901d58a1f3b9da668d25f551b3bf28ce23c282fc30300335359371ab
 
 name:           performabot
 version:        0.1.0
@@ -91,6 +91,7 @@ library
     , text
     , time
     , unordered-containers
+    , uuid
     , vector
     , wai
     , wai-extra

src/Environment.hs

@@ -10,13 +10,15 @@ module Environment
     ) where
 
 import           Control.Lens       ( (.~), (^.) )
-import           Control.Monad      ( mapM, msum )
+import           Control.Monad      ( mapM, msum, unless )
 
 import           Data.List          ( intercalate )
+import           Data.Maybe         ( isNothing )
 import           Data.Text          ( Text, pack )
 import qualified Data.Text          as T ( null )
+import           Data.UUID          ( fromText )
 
-import           Log                ( err )
+import           Log                ( debug, err )
 
 import           Model
                  ( Environment, environmentBranch, environmentCommit
@@ -33,6 +35,15 @@ fillEnvironment e d = do
     c <- getEnv (e ^. environmentCommit) "commit" commitEnvVars
     p <- getEnv (e ^. environmentPullRequest) "pull request" pullRequestEnvVars
     t <- getEnv (e ^. environmentToken) "token" tokenEnvVars
+
+    -- Validate the token
+    unless (T.null t) $ if isNothing (fromText t)
+                        then do
+                            err $ printf "Invalid token '%s' provided" t
+                            exitFailure
+                        else debug $ printf "Token '%s' seems to be valid" t
+
+    -- Validate the other environment variables
     if not d && any T.null [ b, c, p, t ]
         then exitFailure
         else return $ environmentToken .~ t $ environmentPullRequest .~ p $