Implemented basic auth, refactor

1 files changed, 41 insertions, 0 deletions

diff --git a/cli/Main.hs b/cli/Main.hs
new file mode 100644
index 0000000..40c3da2
--- /dev/null
+++ b/cli/Main.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main(main) where
+
+import System.Environment (getArgs)
+import Database (runDb, runMigrations)
+import Data.User
+import Database.Persist
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Crypto.BCrypt (hashPasswordUsingPolicy, fastBcryptHashingPolicy)
+import qualified Data.ByteString.Base16 as Base16
+
+----------------------------------------------------------------------------------------------------
+main :: IO ()
+main = do
+  args <- getArgs
+
+  case args of
+    ["migrate"] -> do
+      _ <- runMigrations
+      putStrLn "Migrated"
+    [name, pass] -> do
+      hashed_password <- hashPassword (T.pack pass)
+
+      _ <- runDb $ insert $ User (T.pack name) hashed_password Nothing Nothing
+      putStrLn $ "User " ++ name ++ " created"
+    [name, pass, display_name] -> do
+      hashed_password <- hashPassword (T.pack pass)
+
+      _ <- runDb $ insert $ User (T.pack name) hashed_password (Just $ T.pack display_name) Nothing
+      putStrLn $ "User " ++ name ++ " created with display name '" ++ display_name ++ "'"
+    _ -> putStrLn "Usage: add-user <username> <password> [display_name]"
+  where
+    hashPassword :: T.Text -> IO T.Text
+    hashPassword pass = do
+      maybe_hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy (T.encodeUtf8 pass)
+
+      case maybe_hashed of
+        Just hashed -> return $ T.decodeUtf8 $ Base16.encode hashed
+        Nothing -> error "Password hashing failed"