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