improve documentation

master
Michele Guerini Rocco 2019-11-06 15:09:02 +01:00
parent fc3b5ba642
commit 5108b035a4
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
6 changed files with 122 additions and 46 deletions

View File

@ -5,6 +5,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-|
This module contains the web application
and API implementation of Breve.
-}
module Application where
-- Breve modules
@ -36,7 +40,7 @@ import GHC.TypeNats (Nat)
-- * Types
-- | API successful reply
-- This is the reply returned by the API
-- This is the reply returned by the JSON API
-- handler when the url has been shortned
-- successfully.
data ApiReply = ApiReply
@ -55,13 +59,25 @@ instance FromForm Url where
-- | API spec
--
-- Breve has three main components:
-- Breve has two main components:
--
-- 1. the web app
-- 2. the JSON API
-- 3. the static files server
-- 2. the JSON API itself
type Breve = API :<|> App
-- | Web app spec
--
-- +----------+------+----------------------+
-- | path | type | description |
-- +==========+======+======================+
-- | / | GET | homepage |
-- +----------+------+----------------------+
-- | / | POST | upload a new url |
-- +----------+------+----------------------+
-- | /static | GET | static assets |
-- +----------+------+----------------------+
-- | /:name | GET | resolves a short url |
-- +----------+------+----------------------+
type App =
Get '[HTML] Html
:<|> "static" :> Raw
@ -69,18 +85,15 @@ type App =
:<|> ReqBody '[FormUrlEncoded] Url :> Post '[HTML] Html
-- | JSON API spec
--
-- +----------+------+----------------------+
-- | path | type | description |
-- +==========+======+======================+
-- | / | POST | upload a new url |
-- +----------+------+----------------------+
type API =
"api" :> ReqBody '[FormUrlEncoded] Url :> Post '[JSON] ApiReply
-- | Verb that encodes an HTTP 302 redirection
type Redirect =
Verb 'GET 302 '[PlainText] Redirection
-- | Reply with Location redirect header
type Redirection =
Headers '[Header "Location" Text] NoContent
-- | Breve application
--
-- Breve takes as parameters the bind url and the urls table
@ -126,7 +139,7 @@ uploader bindUrl table url = do
logStr ("Registered " <> url <> " -> " <> name)
pure (done $ bindUrl <> name)
-- Takes a 'Url' via POST and returns
-- | Takes a 'Url' via POST and returns
-- the shortned one in an 'ApiReply' as JSON.
api :: Url -> UrlTable -> Url -> Handler ApiReply
api bindUrl table url = do
@ -141,4 +154,12 @@ api bindUrl table url = do
-- | Handy function to log to stdout
logStr :: Text -> Handler ()
logStr = liftIO . T.putStrLn
logStr = liftIO . T.putStrLn . ("[breve] " <>)
-- | Verb that encodes an HTTP 302 redirection
type Redirect =
Verb 'GET 302 '[PlainText] Redirection
-- | Reply with Location redirect header
type Redirection =
Headers '[Header "Location" Text] NoContent

View File

@ -1,8 +1,12 @@
{-|
This module implements the algorithm
by which a URL is converted into a word.
-}
module Breve.Generator
( nameHash
, intHash
, Name
( Name
, Url
, nameHash
, intHash
) where
import Control.Monad.State
@ -13,7 +17,10 @@ import Data.ByteString.Lazy (fromStrict)
import Data.Text (Text, pack)
import Data.Text.Encoding (encodeUtf8)
-- | A phonetic word associated to a URL
type Name = Text
-- | Any kind of URL
type Url = Text
-- | Takes a random element of a list
@ -32,6 +39,10 @@ word = pack <$> replicateM 10 letter where
intHash :: Url -> Int
intHash = decode . fromStrict . hash . encodeUtf8
-- | Assigns a unique name to the url
-- | Assigns a unique name to the given URL
--
-- The result is a computation based on a RNG
-- seeded by URL itself and is therefore
-- deterministic.
nameHash :: Url -> Name
nameHash = evalState word . mkStdGen . intHash

View File

@ -1,32 +1,42 @@
module Breve.Settings where
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (when)
import System.Environment (lookupEnv)
import System.Environment.XDG.BaseDir
import System.Directory (doesFileExist)
import Data.Text (Text, pack)
{-|
This module defines the Breve configuration
parser and application settings.
-}
module Breve.Settings
( AppSettings(..)
, createEmptyIfMissing
, settings
) where
import Control.Monad (when)
import System.Environment (lookupEnv)
import System.Directory (doesFileExist, getXdgDirectory, XdgDirectory(..))
import Data.Text (Text, pack)
import Data.Configurator
import Data.Monoid
import Network.Wai.Handler.WarpTLS (TLSSettings (..), tlsSettingsChain)
import Network.TLS (Version (..))
import Network.TLS.Extra (ciphersuite_strong)
import Network.Wai.Handler.WarpTLS (TLSSettings (..), tlsSettingsChain)
import Network.TLS (Version (..))
import Network.TLS.Extra (ciphersuite_strong)
-- | Breve settings
data AppSettings = AppSettings
{ bindHost :: Text
, bindPort :: Int
, bindUrl :: Text
, urlTable :: FilePath
, tlsSettings :: TLSSettings
{ bindHost :: Text -- ^ the host to bind to
, bindPort :: Int -- ^ the port to bind to
, bindUrl :: Text -- ^ the url used to reach breve
, urlTable :: FilePath -- ^ path where to save the url table
, tlsSettings :: TLSSettings -- ^ warp TLS settings
}
-- | Initialises a file if it doesn't exist
createEmptyIfMissing :: FilePath -> IO ()
createEmptyIfMissing file = do
exists <- doesFileExist file
when (not exists) (writeFile file "")
-- | Configuration file parser
settings :: Maybe FilePath -> IO AppSettings
settings path = do
configPath <- case path of

View File

@ -1,3 +1,7 @@
{-|
This modules defines the data structure used
to store the URLs in memory and on disk.
-}
module Breve.UrlTable
( UrlTable
, load
@ -12,16 +16,23 @@ import Control.Concurrent (forkIO, threadDelay)
import Text.Read (readMaybe)
import qualified Data.HashTable.IO as H
-- | The hash table that stores URLs
type UrlTable = H.CuckooHashTable Name Url
-- | Periodically write a url table to a file
-- | Periodically writes a 'UrlTable' to a file
--
-- The table is stored in a text file
-- as Haskell code for semplicity.
sync :: UrlTable -> FilePath -> IO ()
sync table file = forever $ do
threadDelay (round 3.0e8)
content <- show <$> H.toList table
writeFile file content
-- | Load a url table from a file
-- | Loads a URL table from a file
--
-- The format should be the same one used
-- by the 'sync' function.
load :: FilePath -> IO UrlTable
load file = do
content <- readFile file
@ -31,11 +42,11 @@ load file = do
forkIO (sync table file)
return table
-- | Insert the url in a table and return the name
-- | 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 = nameHash url
-- | Lookup a table for the associated url
-- | Lookup a table for the associated URL
extract :: UrlTable -> Name -> IO (Maybe Url)
extract = H.lookup

View File

@ -1,6 +1,12 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-|
This is the main module, which actually
run the Breve webserver.
-}
module Main where
-- Breve modules
import Application
import Breve.Settings
@ -39,8 +45,8 @@ run (AppSettings{..}) =
-- | Main
--
-- Reads the config (given as the unique argument)
-- and runs the breve web app
-- Reads the configuration (given as the unique cli argument),
-- sets things accordingly and runs the webserver.
main :: IO ()
main = do
configPath <- fmap listToMaybe getArgs
@ -48,6 +54,9 @@ main = do
table <- load urlTable
static <- getDataFileName "static/"
-- Middlewares are just functions of type
-- (Application -> Application). We use a couple here
-- to add requests logging and HTTPS redirection.
let
middlewares =
logStdout .

View File

@ -1,16 +1,17 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
This module contains the HTML pages used by the
web application. These are all obtained by filling
a single template with the page structure.
-}
module Views where
import Data.Text (Text)
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
done :: Text -> Html
done url = template $ do
"here's your new link: "
a ! href (toValue url) $ (toHtml url)
-- | The homepage
index :: Html
index = template $ do
H.form ! method "POST" $ do
@ -18,9 +19,22 @@ index = template $ do
input ! type_ "text" ! name "url"
input ! type_ "submit" ! value "go"
-- | The page shown when a new url has been
-- submitted successfully. Takes the resulting
-- url as an argument.
done :: Text -> Html
done url = template $ do
"here's your new link: "
a ! href (toValue url) $ (toHtml url)
-- | Displays a text message in the page center
message :: Text -> Html
message = template . toHtml
-- | The main Breve template
--
-- Takes HTML code and embeds it in the
-- inner page container.
template :: Html -> Html
template fill =
docTypeHtml $ do