From 55f3f2692d9482ce5fb803d594c9a906ab07250c Mon Sep 17 00:00:00 2001 From: rnhmjoj Date: Wed, 8 Apr 2015 12:47:56 +0200 Subject: [PATCH] Initial commit --- .gitignore | 16 ++++++++++ Application.hs | 44 +++++++++++++++++++++++++++ Main.hs | 9 ++++++ Shortener/Common.hs | 16 ++++++++++ Shortener/Generator.hs | 37 +++++++++++++++++++++++ Shortener/UrlTable.hs | 28 ++++++++++++++++++ layouts/main.css | 67 ++++++++++++++++++++++++++++++++++++++++++ layouts/main.html | 17 +++++++++++ shortener.cabal | 18 ++++++++++++ views/done.html | 1 + views/index.html | 4 +++ 11 files changed, 257 insertions(+) create mode 100644 .gitignore create mode 100644 Application.hs create mode 100644 Main.hs create mode 100644 Shortener/Common.hs create mode 100644 Shortener/Generator.hs create mode 100644 Shortener/UrlTable.hs create mode 100644 layouts/main.css create mode 100644 layouts/main.html create mode 100644 shortener.cabal create mode 100644 views/done.html create mode 100644 views/index.html diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4218a66 --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.virtualenv +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp \ No newline at end of file diff --git a/Application.hs b/Application.hs new file mode 100644 index 0000000..7100616 --- /dev/null +++ b/Application.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +module Application where + +import Shortener.Common +import Shortener.UrlTable + +import Web.Simple +import Web.Simple.Static +import Web.Simple.Templates +import Web.Frank + +import Control.Applicative +import Control.Monad.IO.Class +import Data.Maybe +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.ByteString.Char8 as BS + + +app :: (Application -> IO ()) -> IO () +app runner = do + settings <- newAppSettings + table <- records + + runner $ controllerApp settings $ do + get "/" $ render "index.html" () + + get "/main.css" $ serveStatic "layouts/main.css" + + get "/:word" $ do + word <- queryParam' "word" + url <- liftIO (extract table word) + respond $ case url of + Just url -> redirectTo (BS.pack url) + Nothing -> notFound + + post "/short" $ do + (form, _) <- parseForm + case lookup "url" form of + Just url -> do + address <- return "http://localhost:3000/" + word <- liftIO (insert table (BS.unpack url)) + render "done.html" $ object ["link" .= (address ++ word)] + Nothing -> respond badRequest diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..e581356 --- /dev/null +++ b/Main.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Application +import Network.Wai.Handler.Warp +import Network.Wai.Middleware.RequestLogger + +main :: IO () +main = app (run 3000 . logStdout) diff --git a/Shortener/Common.hs b/Shortener/Common.hs new file mode 100644 index 0000000..8c554a8 --- /dev/null +++ b/Shortener/Common.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +module Shortener.Common where + +import Control.Applicative +import Web.Simple +import Web.Simple.Templates + +data AppSettings = AppSettings { } + +newAppSettings :: IO AppSettings +newAppSettings = do + + return $ AppSettings + +instance HasTemplates IO AppSettings where + defaultLayout = Just <$> getTemplate "layouts/main.html" \ No newline at end of file diff --git a/Shortener/Generator.hs b/Shortener/Generator.hs new file mode 100644 index 0000000..6e27275 --- /dev/null +++ b/Shortener/Generator.hs @@ -0,0 +1,37 @@ +module Shortener.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 diff --git a/Shortener/UrlTable.hs b/Shortener/UrlTable.hs new file mode 100644 index 0000000..591f425 --- /dev/null +++ b/Shortener/UrlTable.hs @@ -0,0 +1,28 @@ +module Shortener.UrlTable +( UrlTable +, records +, insert +, extract +) where + +import Shortener.Generator + +import Control.Applicative +import Control.Monad +import Data.Maybe +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 diff --git a/layouts/main.css b/layouts/main.css new file mode 100644 index 0000000..9333c83 --- /dev/null +++ b/layouts/main.css @@ -0,0 +1,67 @@ +@import url(http://fonts.googleapis.com/css?family=Inconsolata:400,700); + +html, body {overflow: auto} +body, input {font-size: 1.1em;} + +body { + background-color: rgb(24,27,32); + color: rgb(155,144,129); + font-family: Inconsolata; + width: 100%; + height: 100%; + margin: 0; +} + +#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; +} + +h1 { + margin: 1em; + font-size: 1.8em; + font-weight: 700; + color: rgb(81,94,102); +} + +input[type="text"] { + border: none; + border-bottom: 2px dashed rgb(43,44,46); + outline: none; + background: transparent; + color: rgb(119,96,73); + padding: 0 2px; +} + +input[type="submit"] { + border: 1px solid rgb(43,44,46); + padding: .4em; + background: transparent; + color: rgb(119,87,80); + cursor: pointer; +} + +a:link, a:visited { + color: rgb(119,96,73); + text-decoration: none; +} + +a:hover { + color: rgb(119,87,80); + text-decoration: underline; + transition: color .5s ease; +} \ No newline at end of file diff --git a/layouts/main.html b/layouts/main.html new file mode 100644 index 0000000..614f6fb --- /dev/null +++ b/layouts/main.html @@ -0,0 +1,17 @@ + + + + url shortener + + + + + + + +

URL SHORTENER

+
+
$yield$
+
+ + \ No newline at end of file diff --git a/shortener.cabal b/shortener.cabal new file mode 100644 index 0000000..0745b97 --- /dev/null +++ b/shortener.cabal @@ -0,0 +1,18 @@ +name: shortener +version: 0.0.1.0 +author: Rnhmjoj +maintainer: micheleguerinirocco@me.com +category: Web +build-type: Simple +cabal-version: >=1.8 + +executable shortener + main-is: Main.hs + ghc-options: -threaded -O2 + build-depends: base, simple >= 0.8.0, + wai, wai-extra, + warp, aeson, + transformers, mtl, + hashtables, cryptohash, + bytestring, binary, random, + diff --git a/views/done.html b/views/done.html new file mode 100644 index 0000000..04f273d --- /dev/null +++ b/views/done.html @@ -0,0 +1 @@ +here's your new link: $link$ \ No newline at end of file diff --git a/views/index.html b/views/index.html new file mode 100644 index 0000000..4fd36db --- /dev/null +++ b/views/index.html @@ -0,0 +1,4 @@ +
+ your url: + +
\ No newline at end of file