projects
/
blog.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Create posts directory if needed
[blog.git]
/
Main.hs
diff --git
a/Main.hs
b/Main.hs
index f3a7472085479ec5555524fd133ac0146fb210eb..24e201726f653d994b9ea53c63f69419b358bdd3 100644
(file)
--- 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 Data.Maybe
import Data.Ord
import Data.IORef
+import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
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.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)
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"
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
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"
currentUser :: ActionM (Maybe T.Text)
currentUser = do
mCookie <- getCookie "session"
@@
-66,6
+70,7
@@
logins = Map.fromList
main :: IO ()
main = do
preserve <- mkPreserve mempty
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"
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"]
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"
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
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)
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))
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
author <- do
ma <- currentUser
case ma of