breve 0.0.1.0 → 0.0.2.0
raw patch · 12 files changed
+287/−20 lines, 12 files
Files
- Main.hs +0/−14
- README.md +6/−4
- breve.cabal +7/−2
- layouts/main.css +88/−0
- layouts/main.html +22/−0
- src/Application.hs +52/−0
- src/Breve/Common.hs +32/−0
- src/Breve/Generator.hs +37/−0
- src/Breve/UrlTable.hs +24/−0
- src/Main.hs +14/−0
- views/done.html +1/−0
- views/index.html +4/−0
− Main.hs
@@ -1,14 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Application-import Breve.Common--import Control.Applicative-import Network.Wai.Handler.Warp-import Network.Wai.Middleware.RequestLogger--main :: IO ()-main = do- (url, settings) <- serverSettings- putStrLn ("Serving on " ++ url)- app (runSettings settings . logStdout)
README.md view
@@ -2,13 +2,15 @@ ### a url shortener Breve is a web application that provides a simple interface to-shortening long urls creating smaller and easy to remember links.+shortening long urls creating links smaller and easier to remember. -It creates links like "/emeaoinqua" that easier to remember than+It creates links in the form of "/emeaoinqua": easier to remember than alphanumeric strings like "/1Cqw8lHw" used by several services. +It was inspired by [hastebin](http://hastebin.com).+ ## Running the app- + git clone https://github.com/rnhmjoj/breve cd breve cabal install --only-dependencies@@ -17,7 +19,7 @@ This will start the app on `http://127.0.0.1:3000` You can set the bind hostname/port via the `PORT` and `ADDRESS`-environment variables+environment variables. ## License
breve.cabal view
@@ -1,5 +1,5 @@ name: breve-version: 0.0.1.0+version: 0.0.2.0 synopsis: a url shortener description: @@ -15,6 +15,7 @@ category: Web build-type: Simple extra-source-files: README.md, LICENSE+data-files: layouts/*.css, layouts/*.html, views/*.html cabal-version: >=1.10 source-repository head@@ -23,8 +24,12 @@ executable breve main-is: Main.hs+ hs-source-dirs: src default-language: Haskell2010- build-depends: base ==4.*, simple >= 0.8.0, + other-modules: Application, Breve.Common,+ Breve.Generator, Breve.UrlTable+ other-extensions: OverloadedStrings+ build-depends: base ==4.*, simple >= 0.8.0, wai ==2.*, wai-extra ==2.*, warp ==2.1.*, aeson ==0.8.*, bytestring ==0.10.*, transformers ==0.3.*, mtl ==2.1.*,
+ layouts/main.css view
@@ -0,0 +1,88 @@+@import url(http://fonts.googleapis.com/css?family=Inconsolata:400,700);+@import url(http://reset5.googlecode.com/hg/reset.min.css);++html, body { overflow: hidden }+body, input { font-size: 1.1em }++body {+ background-color: rgb(24,27,32);+ color: rgb(155,144,129);+ font-family: Inconsolata;+}++#container {+ text-align:center;+ position: absolute;+ height: 100%;+ width: 100%;+}++#container:before {+ content: '';+ display: inline-block;+ height: 100%; + vertical-align: middle;+}++#center {+ display: inline-block;+ text-align:left;+ margin-top: -2em;+}++footer {+ position: absolute;+ width: 100%;+ bottom: 0;+ left: 0;+ padding: 1em;+ font-size: .9em;+ color: rgb(89,84,80)+}++footer span { + float: right;+ margin-right: 2em;+}++h1 {+ margin: 1em 0 0 1em;+ font-size: 1.8em;+ font-weight: 700;+ color: rgb(81,94,102);+}++h1 a { color: rgb(81,94,102) !important}++h2 {+ font-size: 1.2em;+ margin: .5em 0 0 1.5em;+}++input[type="text"] {+ border: none;+ border-bottom: .15em dashed rgb(43,44,46);+ outline: none;+ background: transparent;+ color: rgb(119,96,73);+ padding: 0 2px;+}++input[type="submit"] {+ border: .12em solid rgb(43,44,46);+ padding: .2em .4em !important;+ background: transparent;+ color: rgb(119,87,80);+ cursor: pointer;+}++a:link, a:visited {+ color: rgb(119,96,73);+ text-decoration: none;+}++a:hover {+ text-decoration: underline;+ transition: color .5s ease;+ color: rgb(119,87,80);+}
+ layouts/main.html view
@@ -0,0 +1,22 @@+<!DOCTYPE html>+<html>+ <head>+ <title>breve: url shortener</title>+ <meta name="description" content="url shortener">+ <meta name="keywords" content="url, shortener">+ <meta name="author" content="Michele Guerini Rocco">+ <meta charset="utf-8">+ <link rel=stylesheet href="main.css" type="text/css">+ </head>+ <body>+ <h1><a href="/">BREVE</a></h1>+ <h2>a url shortener</h2>+ <div id="container">+ <div id="center">$yield$</div>+ </div>+ <footer>+ breve is open <a href="https://github.com/rnhmjoj/breve">source</a>+ <span>© Rnhmjoj</span>+ </footer>+ </body>+</html>
+ src/Application.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+module Application where++import Breve.Common+import Breve.UrlTable+import Paths_breve (getDataFileName)++import Web.Frank+import Web.Simple+import Web.Simple.Static (serveStatic)+import Web.Simple.Templates (render)++import Control.Applicative+import Control.Monad.IO.Class (liftIO)+import Text.Printf (printf)+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.ByteString.Char8 as BS++logStr = liftIO . putStrLn ++app :: (Application -> IO ()) -> IO ()+app runner = do+ settings <- newAppSettings+ (baseUrl,_) <- serverSettings+ table <- records++ cssPath <- getDataFileName "layouts/main.css"+ indexPath <- getDataFileName "views/index.html"+ donePath <- getDataFileName "views/done.html"++ runner $ controllerApp settings $ do+ get "/" (render indexPath ())+ get "/main.css" (serveStatic cssPath)++ get "/:word" $ do+ word <- queryParam' "word"+ url <- liftIO (extract table word)+ case url of+ Just url -> do+ logStr (printf "Resolved %s -> %s" word url)+ respond $ redirectTo (BS.pack url)+ Nothing -> respond notFound++ post "/short" $ do+ (form, _) <- parseForm+ case BS.unpack <$> lookup "url" form of+ Just url -> do+ word <- liftIO (insert table url)+ logStr (printf "Registered %s -> %s " url word)+ render donePath $ object ["link" .= (baseUrl ++ word)]+ Nothing -> respond badRequest
+ src/Breve/Common.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Breve.Common where++import Paths_breve (getDataFileName)++import Control.Applicative+import Control.Monad.IO.Class (liftIO)+import Text.Printf (printf)+import System.Environment (lookupEnv)++import Web.Simple.Templates+import Network.Wai.Handler.Warp++data AppSettings = AppSettings { }++serverSettings :: IO (String, Settings)+serverSettings = do+ port <- maybe 3000 read <$> lookupEnv "PORT"+ host <- maybe "localhost" id <$> lookupEnv "HOSTNAME"+ let opts = setPort port defaultSettings+ url = if port == 80+ then printf "http://%s/" host+ else printf "http://%s:%d/" host port+ return (url, opts)++newAppSettings :: IO AppSettings+newAppSettings = return AppSettings++instance HasTemplates IO AppSettings where+ defaultLayout = do+ main <- liftIO (getDataFileName "layouts/main.html")+ Just <$> getTemplate main
+ src/Breve/Generator.hs view
@@ -0,0 +1,37 @@+module Breve.Generator +( wordID+, hashID+, Word+, Url+) where++import Control.Applicative+import Control.Monad.State+import System.Random+import Crypto.Hash.SHA256 (hash)+import Data.Binary (decode)+import Data.ByteString.Char8 (pack)+import Data.ByteString.Lazy (fromStrict)++type Word = String+type Url = String++-- Choose a random element of a list+choice :: [a] -> State StdGen a+choice xs = (xs !!) <$> randomSt (0, length xs - 1)+ where randomSt = state . randomR++-- Generate a random phonetic string+word :: State StdGen Word+word = replicateM 10 letter where+ vowels = "aeiou"+ consonants = "bcdfghjklmnpqrstvwxyz"+ letter = choice [vowels, consonants] >>= choice++-- SHA256 hash to seed a generator+hashID :: Url -> Int+hashID = decode . fromStrict . hash . pack++-- Assing a unique word to the url+wordID :: Url -> Word+wordID = evalState word . mkStdGen . hashID
+ src/Breve/UrlTable.hs view
@@ -0,0 +1,24 @@+module Breve.UrlTable+( UrlTable+, records+, insert+, extract+) where++import Breve.Generator+import qualified Data.HashTable.IO as H++type UrlTable = H.CuckooHashTable Word Url++--Empty url hash table+records :: IO UrlTable+records = H.new++-- Insert the url in the table and return the word+insert :: UrlTable -> Url -> IO Word+insert table url = H.insert table new url >> return new+ where new = wordID url++-- Lookup the table for the associated url+extract :: UrlTable -> Word -> IO (Maybe Url)+extract = H.lookup
+ src/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++import Application+import Breve.Common++import Control.Applicative+import Network.Wai.Handler.Warp+import Network.Wai.Middleware.RequestLogger++main :: IO ()+main = do+ (url, settings) <- serverSettings+ putStrLn ("Serving on " ++ url)+ app (runSettings settings . logStdout)
+ views/done.html view
@@ -0,0 +1,1 @@+here's your new link: <a href="$link$">$link$</a>
+ views/index.html view
@@ -0,0 +1,4 @@+<form action="/short" method="POST">+ your url: <input type="text" name="url">+ <input type="submit" value="go">+</form>