(prototype) authentication, route for getting pending bangs

1 files changed, 20 insertions, 0 deletions

diff --git a/src/Auth.hs b/src/Auth.hs
new file mode 100644
index 0000000..397dd75
--- /dev/null
+++ b/src/Auth.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE OverloadedStrings, LambdaCase #-}
+
+module Auth (
+    ensureAuth
+) where
+
+import Control.Monad (unless)
+import Crypto.Hash (hash, Digest, SHA512)
+import Data.ByteArray.Encoding (convertToBase, Base(Base64))
+import Data.ByteString (ByteString)
+import Data.Text.Encoding (encodeUtf8)
+import Yesod
+
+ensureAuth :: MonadHandler m => m ()
+ensureAuth = lookupBasicAuth >>= \case
+    Nothing -> notAuthenticated
+    Just (user, pw) -> unless (hashSha512 pw == hardcodedPw && user == "bleb") notAuthenticated
+  where hashSha512 pw = convertToBase Base64 $ (hash $ encodeUtf8 pw :: Digest SHA512)
+        hardcodedPw :: ByteString
+        hardcodedPw = "l2gTDo5UCimSIQcdK4IrAvJtCIE7KPB7IyS5N7EN4ic78/1mI+8pikPTQTn06+W1XTOk39TgqGEX5KfpAQVm4w=="