disallow non http/https schemes for bookmark urls
This commit is contained in:
parent
9e53a09304
commit
2d3b3c3831
|
@ -44,9 +44,9 @@ markRead bid = do
|
|||
let path = "bm/" <> show bid <> "/read"
|
||||
fetchUrlEnc POST path Nothing AXRes.ignore
|
||||
|
||||
editBookmark :: Bookmark -> Aff (Either Error (Response Unit))
|
||||
editBookmark :: Bookmark -> Aff (Either Error (Response String))
|
||||
editBookmark bm = do
|
||||
fetchJson POST "api/add" (Just (Bookmark' bm)) AXRes.ignore
|
||||
fetchJson POST "api/add" (Just (Bookmark' bm)) AXRes.string
|
||||
|
||||
editNote :: Note -> Aff (Either Error (Response Json))
|
||||
editNote bm = do
|
||||
|
|
|
@ -2,7 +2,10 @@ module Component.Add where
|
|||
|
||||
import Prelude hiding (div)
|
||||
|
||||
import Affjax (printError)
|
||||
import Affjax.StatusCode (StatusCode(..))
|
||||
import App (destroy, editBookmark, lookupTitle)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Lens (Lens', lens, use, (%=), (.=))
|
||||
import Data.Maybe (Maybe(..), maybe, isJust)
|
||||
import Data.Monoid (guard)
|
||||
|
@ -10,6 +13,7 @@ import Data.String (Pattern(..), null, stripPrefix)
|
|||
import Data.Tuple (fst, snd)
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Console (log)
|
||||
import Globals (app', closeWindow, mmoment8601)
|
||||
import Halogen as H
|
||||
import Halogen.HTML (button, div, form, input, label, p, span, table, tbody_, td, td_, text, textarea, tr_)
|
||||
|
@ -180,19 +184,24 @@ addbmark b' =
|
|||
Etoread e -> _ { toread = e }
|
||||
|
||||
handleAction (BEditSubmit e) = do
|
||||
H.liftEffect (preventDefault e)
|
||||
liftEffect (preventDefault e)
|
||||
edit_bm <- use _edit_bm
|
||||
void $ H.liftAff (editBookmark edit_bm)
|
||||
_bm .= edit_bm
|
||||
qs <- liftEffect $ _curQuerystring
|
||||
doc <- liftEffect $ _doc
|
||||
ref <- liftEffect $ referrer doc
|
||||
loc <- liftEffect $ _loc
|
||||
org <- liftEffect $ origin loc
|
||||
case _lookupQueryStringValue qs "next" of
|
||||
Just "closeWindow" -> liftEffect $ closeWindow =<< window
|
||||
Just "back" -> liftEffect $
|
||||
if isJust (stripPrefix (Pattern org) ref)
|
||||
then setHref ref loc
|
||||
else setHref org loc
|
||||
_ -> liftEffect $ closeWindow =<< window
|
||||
H.liftAff (editBookmark edit_bm) >>= case _ of
|
||||
Left affErr -> do
|
||||
liftEffect $ log (printError affErr)
|
||||
Right { status: StatusCode s } | s >= 200 && s < 300 -> do
|
||||
_bm .= edit_bm
|
||||
qs <- liftEffect $ _curQuerystring
|
||||
doc <- liftEffect $ _doc
|
||||
ref <- liftEffect $ referrer doc
|
||||
loc <- liftEffect $ _loc
|
||||
org <- liftEffect $ origin loc
|
||||
case _lookupQueryStringValue qs "next" of
|
||||
Just "closeWindow" -> liftEffect $ closeWindow =<< window
|
||||
Just "back" -> liftEffect $
|
||||
case stripPrefix (Pattern org) ref of
|
||||
Just _ -> setHref ref loc
|
||||
Nothing -> setHref org loc
|
||||
_ -> liftEffect $ closeWindow =<< window
|
||||
Right res -> do
|
||||
liftEffect $ log (res.body)
|
||||
|
|
|
@ -57,24 +57,28 @@ bookmarkFormUrl = do
|
|||
|
||||
-- API
|
||||
|
||||
postAddR :: Handler ()
|
||||
postAddR :: Handler Text
|
||||
postAddR = do
|
||||
bookmarkForm <- requireCheckJsonBody
|
||||
_handleFormSuccess bookmarkForm >>= \case
|
||||
(Created, bid) -> sendStatusJSON created201 bid
|
||||
(Updated, _) -> sendResponseStatus noContent204 ()
|
||||
Created bid -> sendStatusJSON created201 bid
|
||||
Updated _ -> sendResponseStatus noContent204 ()
|
||||
Failed s -> sendResponseStatus status400 s
|
||||
|
||||
_handleFormSuccess :: BookmarkForm -> Handler (UpsertResult, Key Bookmark)
|
||||
_handleFormSuccess :: BookmarkForm -> Handler (UpsertResult (Key Bookmark))
|
||||
_handleFormSuccess bookmarkForm = do
|
||||
(userId, user) <- requireAuthPair
|
||||
bm <- liftIO $ _toBookmark userId bookmarkForm
|
||||
(res, kbid) <- runDB (upsertBookmark userId mkbid bm tags)
|
||||
whenM (shouldArchiveBookmark user kbid) $
|
||||
void $ async (archiveBookmarkUrl kbid (unpack (bookmarkHref bm)))
|
||||
pure (res, kbid)
|
||||
where
|
||||
mkbid = BookmarkKey <$> _bid bookmarkForm
|
||||
tags = maybe [] (nub . words . T.replace "," " ") (_tags bookmarkForm)
|
||||
case (parseRequest . unpack . _url) bookmarkForm of
|
||||
Nothing -> pure $ Failed "Invalid URL"
|
||||
Just _ -> do
|
||||
let mkbid = BookmarkKey <$> _bid bookmarkForm
|
||||
tags = maybe [] (nub . words . T.replace "," " ") (_tags bookmarkForm)
|
||||
bm <- liftIO $ _toBookmark userId bookmarkForm
|
||||
res <- runDB (upsertBookmark userId mkbid bm tags)
|
||||
forM_ (maybeUpsertResult res) $ \kbid ->
|
||||
whenM (shouldArchiveBookmark user kbid) $
|
||||
void $ async (archiveBookmarkUrl kbid (unpack (bookmarkHref bm)))
|
||||
pure res
|
||||
|
||||
postLookupTitleR :: Handler ()
|
||||
postLookupTitleR = do
|
||||
|
|
|
@ -97,12 +97,13 @@ deleteDeleteNoteR nid = do
|
|||
delete k_nid
|
||||
return ""
|
||||
|
||||
postAddNoteR :: Handler ()
|
||||
postAddNoteR :: Handler Text
|
||||
postAddNoteR = do
|
||||
noteForm <- requireCheckJsonBody
|
||||
_handleFormSuccess noteForm >>= \case
|
||||
(Created, nid) -> sendStatusJSON created201 nid
|
||||
(Updated, _) -> sendResponseStatus noContent204 ()
|
||||
Created nid -> sendStatusJSON created201 nid
|
||||
Updated _ -> sendResponseStatus noContent204 ()
|
||||
Failed s -> sendResponseStatus status400 s
|
||||
|
||||
requireResource :: UserId -> Key Note -> DBM Handler Note
|
||||
requireResource userId k_nid = do
|
||||
|
@ -111,7 +112,7 @@ requireResource userId k_nid = do
|
|||
then return nnote
|
||||
else notFound
|
||||
|
||||
_handleFormSuccess :: NoteForm -> Handler (UpsertResult, Key Note)
|
||||
_handleFormSuccess :: NoteForm -> Handler (UpsertResult (Key Note))
|
||||
_handleFormSuccess noteForm = do
|
||||
userId <- requireAuthId
|
||||
note <- liftIO $ _toNote userId noteForm
|
||||
|
|
34
src/Model.hs
34
src/Model.hs
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||
|
||||
module Model where
|
||||
|
@ -693,23 +694,28 @@ fetchBookmarkByUrl userId murl = runMaybeT do
|
|||
btags <- lift $ withTags (entityKey bmark)
|
||||
pure (bmark, btags)
|
||||
|
||||
data UpsertResult = Created | Updated
|
||||
data UpsertResult a = Created a | Updated a | Failed String
|
||||
deriving (Show, Eq, Functor)
|
||||
|
||||
upsertBookmark :: Key User -> Maybe (Key Bookmark) -> Bookmark -> [Text] -> DB (UpsertResult, Key Bookmark)
|
||||
maybeUpsertResult :: UpsertResult a -> Maybe a
|
||||
maybeUpsertResult (Created a) = Just a
|
||||
maybeUpsertResult (Updated a) = Just a
|
||||
maybeUpsertResult _ = Nothing
|
||||
|
||||
upsertBookmark :: Key User -> Maybe (Key Bookmark) -> Bookmark -> [Text] -> DB (UpsertResult (Key Bookmark))
|
||||
upsertBookmark userId mbid bm tags = do
|
||||
res <- case mbid of
|
||||
Just bid ->
|
||||
get bid >>= \case
|
||||
Just prev_bm -> do
|
||||
when (userId /= bookmarkUserId prev_bm)
|
||||
(throwString "unauthorized")
|
||||
replaceBookmark bid prev_bm
|
||||
_ -> throwString "not found"
|
||||
Just prev_bm | userId == bookmarkUserId prev_bm ->
|
||||
replaceBookmark bid prev_bm
|
||||
Just _ -> pure (Failed "unauthorized")
|
||||
_ -> pure (Failed "not found")
|
||||
Nothing ->
|
||||
getBy (UniqueUserHref (bookmarkUserId bm) (bookmarkHref bm)) >>= \case
|
||||
Just (Entity bid prev_bm) -> replaceBookmark bid prev_bm
|
||||
_ -> (Created,) <$> insert bm
|
||||
insertTags (bookmarkUserId bm) (snd res)
|
||||
Just (Entity bid prev_bm) -> replaceBookmark bid prev_bm
|
||||
_ -> Created <$> insert bm
|
||||
forM_ (maybeUpsertResult res) (insertTags (bookmarkUserId bm))
|
||||
pure res
|
||||
where
|
||||
prepareReplace prev_bm =
|
||||
|
@ -719,7 +725,7 @@ upsertBookmark userId mbid bm tags = do
|
|||
replaceBookmark bid prev_bm = do
|
||||
replace bid (prepareReplace prev_bm)
|
||||
deleteTags bid
|
||||
pure (Updated, bid)
|
||||
pure (Updated bid)
|
||||
deleteTags bid =
|
||||
deleteWhere [BookmarkTagBookmarkId CP.==. bid]
|
||||
insertTags userId' bid' =
|
||||
|
@ -732,7 +738,7 @@ updateBookmarkArchiveUrl userId bid marchiveUrl =
|
|||
[BookmarkUserId CP.==. userId, BookmarkId CP.==. bid]
|
||||
[BookmarkArchiveHref CP.=. marchiveUrl]
|
||||
|
||||
upsertNote :: Key User -> Maybe (Key Note) -> Note -> DB (UpsertResult, Key Note)
|
||||
upsertNote :: Key User -> Maybe (Key Note) -> Note -> DB (UpsertResult (Key Note))
|
||||
upsertNote userId mnid note =
|
||||
case mnid of
|
||||
Just nid -> do
|
||||
|
@ -741,10 +747,10 @@ upsertNote userId mnid note =
|
|||
when (userId /= noteUserId note')
|
||||
(throwString "unauthorized")
|
||||
replace nid note
|
||||
pure (Updated, nid)
|
||||
pure (Updated nid)
|
||||
_ -> throwString "not found"
|
||||
Nothing -> do
|
||||
(Created,) <$> insert note
|
||||
Created <$> insert note
|
||||
|
||||
-- * FileBookmarks
|
||||
|
||||
|
|
2
static/js/app.min.js
vendored
2
static/js/app.min.js
vendored
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
Loading…
Reference in a new issue