rnhmjoj/breve
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add a new JSON interface

Browse Source
This commit is contained in:
rnhmjoj 2015-04-25 14:36:28 +02:00
parent 3430a78f61
commit 9904ad9e0c
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Application.hs
View File

@ -44,12 +44,25 @@ app runner = do
respond $ redirectTo (BS.pack url) respond $ redirectTo (BS.pack url)
Nothing -> respond notFound Nothing -> respond notFound
post "/short" $ do post "/" $ do
form <- fmap fst parseForm form <- fst <$> parseForm
case lookup "url" form of case lookup "url" form of
Nothing -> respond badRequest
Just url' -> do Just url' -> do
let url = BS.unpack url' let url = BS.unpack url'
name <- liftIO (insert table url) name <- liftIO (insert table url)
logStr (printf "Registered %s -> %s " url name) logStr (printf "Registered %s -> %s " url name)
render done $ object ["link" .= (bindUrl ++ name)] render done $ object ["link" .= (bindUrl ++ name)]
post "/api" $ do
form <- fst <$> parseForm
case lookup "url" form of
Nothing -> respond badRequest Nothing -> respond badRequest
Just url' -> do
let url = BS.unpack url'
name <- liftIO (insert table url)
logStr (printf "Registered %s -> %s " url name)
let json = object [ "link" .= (bindUrl ++ name)
, "name" .= name
, "original" .= url ]
respond $ okHtml (encode json)

2
views/index.html
View File

@ -1,4 +1,4 @@
<form action="/short" method="POST"> <form method="POST">
your url: <input type="text" name="url"> your url: <input type="text" name="url">
<input type="submit" value="go"> <input type="submit" value="go">
</form> </form>