X-Git-Url: https://git.lukelau.me/?p=blog.git;a=blobdiff_plain;f=Main.hs;h=24e201726f653d994b9ea53c63f69419b358bdd3;hp=f3a7472085479ec5555524fd133ac0146fb210eb;hb=a2fb53d788ced698c13a0ecf5a2f0f8cbc884f8a;hpb=203a4ba8a08faf4c6640c7d60e729459de56d865 diff --git a/Main.hs b/Main.hs index f3a7472..24e2017 100644 --- a/Main.hs +++ b/Main.hs @@ -11,6 +11,7 @@ import qualified Data.Map.Lazy as Map import Data.Maybe import Data.Ord import Data.IORef +import Control.Exception import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class @@ -24,11 +25,13 @@ import Lucid.Base import System.Directory import System.FilePath import System.Random +import System.IO.Error import Network.HTTP.Types type Sessions = Map.Map T.Text T.Text type ActionM = ActionT T.Text (S.StateT Sessions IO) +-- | Checks if the user is logged in loggedIn :: ActionM Bool loggedIn = do mCookie <- getCookie "session" @@ -36,6 +39,7 @@ loggedIn = do Nothing -> return False Just cookie -> Map.member (T.fromStrict cookie) <$> lift S.get +-- | Returns the current username currentUser :: ActionM (Maybe T.Text) currentUser = do mCookie <- getCookie "session" @@ -66,6 +70,7 @@ logins = Map.fromList main :: IO () main = do preserve <- mkPreserve mempty + createDirectory "posts" `catch` (\e -> unless (isAlreadyExistsError e) (throw e)) scottyT 3000 preserve $ do get "/style.css" $ file "style.css" @@ -80,19 +85,23 @@ main = do textarea_ [name_ "body", placeholder_ "# Your markdown here"] "" br_ [] input_ [type_ "submit", value_ "Post"] - else status unauthorized401 + else do + text "You're not logged in" + status unauthorized401 post "/create" $ do t <- param "title" b <- param "body" - p <- createPost b t + p <- createPost t b redirect (linkToPost p) post "/login" $ do username <- param "username" password <- param "password" if Map.lookup username logins /= Just password - then status unauthorized401 + then do + text "Invalid username and/or password" + status unauthorized401 else do session <- T.pack . show <$> liftIO (randomIO :: IO Int) lift $ S.modify (Map.insert session username) @@ -172,8 +181,14 @@ linkToPost p = T.pack $ "/posts" kebab (T.unpack (title p)) pathToPost :: Post -> FilePath pathToPost p = "posts" kebab (T.unpack (title p)) -createPost :: T.Text -> T.Text -> ActionM Post -createPost md title = do +-- | Creates and saves a new post +createPost :: T.Text + -- ^ The title of the post + -> T.Text + -- ^ The markdown body + -> ActionM Post + -- ^ The freshly created post +createPost title md = do author <- do ma <- currentUser case ma of