breve 0.0.3.0 → 0.0.4.0
raw patch · 5 files changed
+30/−32 lines, 5 filesdep ~aesondep ~basedep ~binary
Dependency ranges changed: aeson, base, binary, bytestring, cryptohash, directory, hashtables, mtl, random, simple, tconfig, transformers, wai, wai-extra, warp, xdg-basedir
Files
- breve.cabal +7/−6
- src/Application.hs +7/−8
- src/Breve/Common.hs +0/−1
- src/Breve/Generator.hs +10/−11
- src/Breve/UrlTable.hs +6/−6
breve.cabal view
@@ -1,5 +1,5 @@ name: breve-version: 0.0.3.0+version: 0.0.4.0 synopsis: a url shortener description: @@ -29,9 +29,10 @@ 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.*, hashtables ==1.2.*,- cryptohash ==0.11.*, binary ==0.7.*, random ==1.1.*,- xdg-basedir ==0.2.*, tconfig ==0.5.*, directory ==1.2.*+ build-depends: base >=4.8 && <5.0,+ simple, wai, wai-extra, warp,+ aeson, bytestring, binary,+ transformers, mtl,+ hashtables, cryptohash, random,+ xdg-basedir, tconfig, directory ghc-options: -threaded -O2
src/Application.hs view
@@ -10,7 +10,6 @@ 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@@ -33,12 +32,12 @@ get "/" (render index ()) get "/main.css" (serveStatic css) - get "/:word" $ do- word <- queryParam' "word"- url <- liftIO (extract table word)+ get "/:name" $ do+ name <- queryParam' "name"+ url <- liftIO (extract table name) case url of Just url -> do- logStr (printf "Resolved %s -> %s" word url)+ logStr (printf "Resolved %s -> %s" name url) respond $ redirectTo (BS.pack url) Nothing -> respond notFound @@ -46,7 +45,7 @@ (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 done $ object ["link" .= (bindUrl ++ word)]+ name <- liftIO (insert table url)+ logStr (printf "Registered %s -> %s " url name)+ render done $ object ["link" .= (bindUrl ++ name)] Nothing -> respond badRequest
src/Breve/Common.hs view
@@ -3,7 +3,6 @@ import Paths_breve (getDataFileName) -import Control.Applicative import Control.Monad.IO.Class (liftIO) import Text.Printf (printf) import System.Environment (lookupEnv)
src/Breve/Generator.hs view
@@ -1,11 +1,10 @@ module Breve.Generator -( wordID-, hashID-, Word+( nameHash+, intHash+, Name , Url ) where -import Control.Applicative import Control.Monad.State import System.Random import Crypto.Hash.SHA256 (hash)@@ -13,7 +12,7 @@ import Data.ByteString.Char8 (pack) import Data.ByteString.Lazy (fromStrict) -type Word = String+type Name = String type Url = String -- Choose a random element of a list@@ -22,16 +21,16 @@ where randomSt = state . randomR -- Generate a random phonetic string-word :: State StdGen Word+word :: State StdGen Name 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+intHash :: Url -> Int+intHash = decode . fromStrict . hash . pack --- Assing a unique word to the url-wordID :: Url -> Word-wordID = evalState word . mkStdGen . hashID+-- Assing a unique name to the url+nameHash :: Url -> Name+nameHash = evalState word . mkStdGen . intHash
src/Breve/UrlTable.hs view
@@ -12,13 +12,13 @@ import Text.Read (readMaybe) import qualified Data.HashTable.IO as H -type UrlTable = H.CuckooHashTable Word Url+type UrlTable = H.CuckooHashTable Name Url -- Periodically write a url table to a file sync :: UrlTable -> FilePath -> IO () sync table file = forever $ do threadDelay (round 3.0e8)- content <- fmap show (H.toList table)+ content <- show <$> H.toList table writeFile file content -- Load a url table from a file@@ -31,11 +31,11 @@ forkIO (sync table file) return table --- Insert the url in a table and return the word-insert :: UrlTable -> Url -> IO Word+-- Insert the url in a table and return the name+insert :: UrlTable -> Url -> IO Name insert table url = H.insert table new url >> return new- where new = wordID url+ where new = nameHash url -- Lookup a table for the associated url-extract :: UrlTable -> Word -> IO (Maybe Url)+extract :: UrlTable -> Name -> IO (Maybe Url) extract = H.lookup