Initial commit

.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

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

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)

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"

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

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

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;
+}

layouts/main.html

@@ -0,0 +1,17 @@
+<!DOCTYPE html>
+<html>
+    <head>
+        <title>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>URL SHORTENER</h1>
+        <div id="container">
+            <div id="center"> $yield$ </div>
+        </div>
+    </body>
+</html>

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, 
+

views/done.html

@@ -0,0 +1 @@
+here's your new link: <a href="$link$">$link$</a>

views/index.html

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