merge(tazblog): Integrate blog into monorepo r/2

17 files changed, 1080 insertions, 0 deletions

diff --git a/services/tazblog/.gitignore b/services/tazblog/.gitignore
new file mode 100644
index 000000000000..a95070c31f1e
--- /dev/null
+++ b/services/tazblog/.gitignore
@@ -0,0 +1,7 @@
+*.o
+*.hi
+BlogState/
+dist/
+.cabal-sandbox/
+*.tar.gz
+.stack-work/
diff --git a/services/tazblog/.stylish.haskell.yaml b/services/tazblog/.stylish.haskell.yaml
new file mode 100644
index 000000000000..cb432ce231ba
--- /dev/null
+++ b/services/tazblog/.stylish.haskell.yaml
@@ -0,0 +1,20 @@
+steps:
+  - imports:
+      align: group
+  - language_pragmas:
+      style: vertical
+      remove_redundant: true
+  - records: {}
+  - trailing_whitespace: {}
+columns: 120
+language_extensions:
+  - DeriveDataTypeable
+  - FlexibleContexts
+  - GeneralizedNewtypeDeriving
+  - MultiParamTypeClasses
+  - OverloadedStrings
+  - RecordWildCards
+  - ScopedTypeVariables
+  - TemplateHaskell
+  - TypeFamilies
+  - QuasiQuotes
diff --git a/services/tazblog/blog/Main.hs b/services/tazblog/blog/Main.hs
new file mode 100644
index 000000000000..cfe068a8d988
--- /dev/null
+++ b/services/tazblog/blog/Main.hs
@@ -0,0 +1,41 @@
+-- | Main module for the blog's web server
+module Main where
+
+import           BlogDB              (initialBlogState)
+import           Control.Applicative (pure, (<$>), (<*>))
+import           Control.Exception   (bracket)
+import           Data.Acid
+import           Data.Acid.Remote
+import           Data.Word           (Word16)
+import           Locales             (version)
+import           Network             (HostName, PortID (..))
+import           Options
+import           Server
+
+data MainOptions = MainOptions {
+  dbHost      :: String,
+  dbPort      :: Word16,
+  blogPort    :: Int,
+  resourceDir :: String
+}
+
+instance Options MainOptions where
+  defineOptions = pure MainOptions
+    <*> simpleOption "dbHost" "localhost"
+        "Remote acid-state database host. Default is localhost"
+    <*> simpleOption "dbPort" 8070
+        "Remote acid-state database port. Default is 8070"
+    <*> simpleOption "blogPort" 8000
+        "Port to serve the blog on. Default is 8000."
+    <*> simpleOption "resourceDir" "/opt/tazblog/static"
+        "Resources folder location."
+
+main :: IO()
+main = do
+    putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
+    runCommand $ \opts _ ->
+      let port = PortNumber $ fromIntegral $ dbPort opts
+      in openRemoteState skipAuthenticationPerform (dbHost opts) port >>=
+              (\acid -> runBlog acid (blogPort opts) (resourceDir opts))
+
+
diff --git a/services/tazblog/db/Main.hs b/services/tazblog/db/Main.hs
new file mode 100644
index 000000000000..9523041f109a
--- /dev/null
+++ b/services/tazblog/db/Main.hs
@@ -0,0 +1,34 @@
+-- | Main module for the database server
+module Main where
+
+import           BlogDB              (initialBlogState)
+import           Control.Applicative (pure, (<$>), (<*>))
+import           Control.Exception   (bracket)
+import           Data.Acid
+import           Data.Acid.Local     (createCheckpointAndClose)
+import           Data.Acid.Remote
+import           Data.Word
+import           Network             (PortID (..))
+import           Options
+
+data DBOptions = DBOptions {
+  dbPort         :: Word16,
+  stateDirectory :: String
+}
+
+instance Options DBOptions where
+  defineOptions = pure DBOptions
+    <*> simpleOption "dbport" 8070
+        "Port to serve acid-state on remotely."
+    <*> simpleOption "state" "/var/tazblog/state"
+        "Directory in which the acid-state is located."
+
+main :: IO ()
+main = do
+    putStrLn ("Launching TazBlog database server ...")
+    runCommand $ \opts args ->
+      bracket (openState opts) createCheckpointAndClose
+              (acidServer skipAuthenticationCheck $ getPort opts)
+  where
+    openState o = openLocalStateFrom (stateDirectory o) initialBlogState
+    getPort = PortNumber . fromIntegral . dbPort
diff --git a/services/tazblog/src/Blog.hs b/services/tazblog/src/Blog.hs
new file mode 100644
index 000000000000..f35e3d90801f
--- /dev/null
+++ b/services/tazblog/src/Blog.hs
@@ -0,0 +1,234 @@
+module Blog where
+
+import BlogDB
+import Data.Maybe      (fromJust)
+import Data.Text       (Text, append, empty, pack)
+import Data.Text.Lazy  (fromStrict)
+import Data.Time
+import Locales
+import Text.Blaze.Html (preEscapedToHtml)
+import Text.Hamlet
+import Text.Markdown
+
+import qualified Data.Text as T
+
+replace :: Eq a => a -> a -> [a] -> [a]
+replace x y = map (\z -> if z == x then y else z)
+
+show' :: Show a => a -> Text
+show' = pack . show
+
+-- |After this time all entries are Markdown
+markdownCutoff :: UTCTime
+markdownCutoff = fromJust $ parseTimeM False defaultTimeLocale "%s" "1367149834"
+
+-- blog HTML
+blogTemplate :: BlogLang -> Text -> Html -> Html
+blogTemplate lang t_append body = [shamlet|
+$doctype 5
+  <head>
+    <meta charset="utf-8">
+    <meta name="viewport" content="width=device-width, initial-scale=1">
+    <meta name="description" content=#{blogTitle lang t_append}>
+    <link rel="stylesheet" type="text/css" href="/static/blog.css" media="all">
+    <link rel="alternate" type="application/rss+xml" title="RSS-Feed" href=#{rssUrl}>
+    <title>#{blogTitle lang t_append}
+  <body>
+    <header>
+      <h1>
+        <a href="/" .unstyled-link>#{blogTitle lang empty}
+      <hr>
+    ^{body}
+    ^{showFooter}
+|]
+ where
+  rssUrl = T.concat ["/", show' lang, "/rss.xml"]
+
+showFooter :: Html
+showFooter = [shamlet|
+<footer>
+  <p .footer>Served without any dynamic languages.
+  <p .footer>
+    <a href=#{repoURL} .uncoloured-link>Version #{version}
+    |
+    <a href=#{twitter} .uncoloured-link>Twitter
+    |
+    <a href=#{mailTo} .uncoloured-link>Mail
+  <p .lod>
+    ಠ_ಠ
+|]
+
+isEntryMarkdown :: Entry -> Bool
+isEntryMarkdown e = edate e > markdownCutoff
+
+renderEntryMarkdown :: Text -> Html
+renderEntryMarkdown = markdown def {msXssProtect = False} . fromStrict
+
+renderEntries :: Bool -> [Entry] -> Maybe Html -> Html
+renderEntries showAll entries pageLinks = [shamlet|
+$forall entry <- toDisplay
+  <article>
+    <h2 .inline>
+      <a href=#{linkElems entry} .unstyled-link>
+        #{title entry}
+    <aside .date>
+      #{pack $ formatTime defaultTimeLocale "%Y-%m-%d" $ edate entry}
+    $if (isEntryMarkdown entry)
+      ^{renderEntryMarkdown $ btext entry}
+    $else
+      ^{preEscapedToHtml $ btext entry}
+    $if ((/=) (mtext entry) empty)
+      <p>
+        <a .uncoloured-link href=#{linkElems entry}>
+          #{readMore $ lang entry}
+  <hr>
+$maybe links <- pageLinks
+  ^{links}
+|]
+  where
+   toDisplay = if showAll then entries else (take 6 entries)
+   linkElems Entry{..} = concat $ ["/", show lang, "/", show entryId]
+
+showLinks :: Maybe Int -> BlogLang -> Html
+showLinks (Just i) lang = [shamlet|
+  $if ((>) i 1)
+    <div .navigation>
+      <a href=#{nLink $ succ i} .uncoloured-link>#{backText lang}
+      |
+      <a href=#{nLink $ pred i} .uncoloured-link>#{nextText lang}
+  $elseif ((<=) i 1)
+    ^{showLinks Nothing lang}
+|]
+  where
+   nLink page = T.concat ["/", show' lang, "/?page=", show' page]
+showLinks Nothing lang = [shamlet|
+<div .navigation>
+  <a href=#{nLink} .uncoloured-link>#{backText lang}
+|]
+  where
+   nLink = T.concat ["/", show' lang, "/?page=2"]
+
+renderEntry :: Entry -> Html
+renderEntry e@Entry{..} = [shamlet|
+<article>
+  <h2 .inline>
+    #{title}
+  <aside .date>
+    #{pack $ formatTime defaultTimeLocale "%Y-%m-%d" edate}
+  $if (isEntryMarkdown e)
+    ^{renderEntryMarkdown btext}
+    <p>^{renderEntryMarkdown $ mtext}
+  $else
+    ^{preEscapedToHtml $ btext}
+    <p>^{preEscapedToHtml $ mtext}
+<hr>
+|]
+
+{- Administration pages -}
+
+adminTemplate :: Text -> Html -> Html
+adminTemplate title body = [shamlet|
+$doctype 5
+<head>
+ <link rel="stylesheet" type="text/css" href="/static/admin.css" media="all">
+ <meta http-equiv="content-type" content="text/html;charset=UTF-8">
+ <title>#{append "TazBlog Admin: " title}
+<body>
+ ^{body}
+|]
+
+adminLogin :: Html
+adminLogin = adminTemplate "Login" $ [shamlet|
+<div class="loginBox">
+ <div class="loginBoxTop">TazBlog Admin: Login
+ <div class="loginBoxMiddle">
+  <form action="/admin" method="POST">
+   <p>Account ID
+   <p><input type="text" style="font-size:2;" name="account" value="tazjin" readonly="1">
+   <p>Passwort
+   <p><input type="password" style="font-size:2;" name="password">
+   <p><input alt="Anmelden" type="image" src="/static/signin.gif">
+|]
+
+adminIndex :: Text -> Html
+adminIndex sUser = adminTemplate "Index" $ [shamlet|
+<div style="float:center;">
+ <form action="/admin/entry" method="POST">
+  <table>
+   <tr>
+    <thead><td>Title:
+    <td><input type="text" name="title">
+   <tr>
+    <thead><td>Language:
+    <td><select name="lang">
+     <option value="en">English
+     <option value="de">Deutsch
+   <tr>
+    <thead><td>Text:
+    <td>
+     <textarea name="btext" cols="100" rows="15">
+   <tr>
+    <thead>
+     <td style="vertical-align:top;">Read more:
+    <td>
+     <textarea name="mtext" cols="100" rows="15">
+  <input type="hidden" name="author" value=#{sUser}>
+  <input style="margin-left:20px;" type="submit" value="Submit">
+ ^{adminFooter}
+|]
+
+adminFooter :: Html
+adminFooter = [shamlet|
+<a href="/">Front page
+\ -- #
+  <a href="/admin">New article
+\ -- Entry list: #
+  <a href="/admin/entrylist/en">EN
+\ & #
+<a href="/admin/entrylist/de">DE
+|]
+
+adminEntryList :: [Entry] -> Html
+adminEntryList entries = adminTemplate "EntryList" $ [shamlet|
+<div style="float: center;">
+ <table>
+  $forall entry <- entries
+   <tr>
+    <td><a href=#{append "/admin/entry/" (show' $ entryId entry)}>#{title entry}
+    <td>#{formatPostDate $ edate entry}
+|]
+ where
+  formatPostDate = formatTime defaultTimeLocale "[On %D at %H:%M]"
+
+editPage :: Entry -> Html
+editPage (Entry{..}) = adminTemplate "Index" $ [shamlet|
+<div style="float:center;">
+ <form action=#{append "/admin/entry/" (show' entryId)} method="POST">
+  <table>
+   <tr>
+    <td>Title:
+    <td>
+     <input type="text" name="title" value=#{title}>
+   <tr>
+    <td style="vertical-align:top;">Text:
+    <td>
+     <textarea name="btext" cols="100" rows="15">#{btext}
+   <tr>
+    <td style="vertical-align:top;">Read more:
+    <td>
+     <textarea name="mtext" cols="100" rows="15">#{mtext}
+  <input type="submit" style="margin-left:20px;" value="Submit">
+  <p>^{adminFooter}
+|]
+
+showError :: BlogError -> BlogLang -> Html
+showError NotFound l = blogTemplate l (T.append ": " $ notFoundTitle l) $ [shamlet|
+<p>:(
+<p>#{notFoundText l}
+<hr>
+|]
+showError UnknownError l = blogTemplate l "" $ [shamlet|
+<p>:(
+<p>#{unknownErrorText l}
+<hr>
+|]
diff --git a/services/tazblog/src/BlogDB.hs b/services/tazblog/src/BlogDB.hs
new file mode 100644
index 000000000000..bc9c24393302
--- /dev/null
+++ b/services/tazblog/src/BlogDB.hs
@@ -0,0 +1,229 @@
+module BlogDB where
+
+import Control.Monad.Reader (ask)
+import Control.Monad.State  (get, put)
+import Data.Acid
+import Data.Acid.Advanced
+import Data.Acid.Remote
+import Data.ByteString      (ByteString)
+import Data.Data            (Data, Typeable)
+import Data.IxSet           (Indexable (..), IxSet, Proxy (..), getOne, ixFun, ixSet, (@=))
+import Data.SafeCopy        (base, deriveSafeCopy)
+import Data.Text            (Text, pack)
+import Data.Time
+import Network              (PortID (..))
+import System.Environment   (getEnv)
+
+import qualified Crypto.Hash.SHA512     as SHA (hash)
+import qualified Data.ByteString.Base64 as B64 (encode)
+import qualified Data.ByteString.Char8  as B
+import qualified Data.IxSet             as IxSet
+
+newtype EntryId = EntryId { unEntryId :: Integer }
+    deriving (Eq, Ord, Data, Enum, Typeable)
+
+$(deriveSafeCopy 2 'base ''EntryId)
+
+instance Show EntryId where
+  show = show . unEntryId
+
+data BlogLang = EN | DE
+    deriving (Eq, Ord, Data, Typeable)
+
+instance Show BlogLang where
+    show DE = "de"
+    show EN = "en"
+
+$(deriveSafeCopy 0 'base ''BlogLang)
+
+data Entry = Entry {
+    entryId :: EntryId,
+    lang    :: BlogLang,
+    author  :: Text,
+    title   :: Text,
+    btext   :: Text,
+    mtext   :: Text,
+    edate   :: UTCTime
+} deriving (Eq, Ord, Show, Data, Typeable)
+
+$(deriveSafeCopy 2 'base ''Entry)
+
+-- ixSet requires different datatypes for field indexes, so let's define some
+newtype Author = Author Text   deriving (Eq, Ord, Data, Typeable)
+newtype Title  = Title Text    deriving (Eq, Ord, Data, Typeable)
+newtype BText  = BText Text    deriving (Eq, Ord, Data, Typeable) -- standard text
+newtype MText  = MText Text    deriving (Eq, Ord, Data, Typeable) -- "read more" text
+newtype Tag    = Tag Text      deriving (Eq, Ord, Data, Typeable)
+newtype EDate  = EDate UTCTime deriving (Eq, Ord, Data, Typeable)
+newtype SDate  = SDate UTCTime   deriving (Eq, Ord, Data, Typeable)
+newtype Username = Username Text deriving (Eq, Ord, Data, Typeable)
+newtype SessionID = SessionID Text deriving (Eq, Ord, Data, Typeable)
+
+$(deriveSafeCopy 2 'base ''Author)
+$(deriveSafeCopy 2 'base ''Title)
+$(deriveSafeCopy 2 'base ''BText)
+$(deriveSafeCopy 2 'base ''MText)
+$(deriveSafeCopy 2 'base ''Tag)
+$(deriveSafeCopy 2 'base ''EDate)
+$(deriveSafeCopy 2 'base ''SDate)
+$(deriveSafeCopy 2 'base ''Username)
+$(deriveSafeCopy 2 'base ''SessionID)
+
+instance Indexable Entry where
+    empty = ixSet [ ixFun $ \e -> [ entryId e]
+                  , ixFun $ (:[]) . lang
+                  , ixFun $ \e -> [ Author $ author e ]
+                  , ixFun $ \e -> [ Title $ title e]
+                  , ixFun $ \e -> [ BText $ btext e]
+                  , ixFun $ \e -> [ MText $ mtext e]
+                  , ixFun $ \e -> [ EDate $ edate e]
+                  ]
+
+data User = User {
+    username :: Text,
+    password :: ByteString
+} deriving (Eq, Ord, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''User)
+
+data Session = Session {
+    sessionID :: Text,
+    user      :: User,
+    sdate     :: UTCTime
+} deriving (Eq, Ord, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Session)
+
+instance Indexable User where
+    empty = ixSet [ ixFun $ \u -> [Username $ username u]
+                  , ixFun $ (:[]) . password
+                  ]
+
+instance Indexable Session where
+    empty = ixSet [ ixFun $ \s -> [SessionID $ sessionID s]
+                  , ixFun $ (:[]) . user
+                  , ixFun $ \s -> [SDate $ sdate s]
+                  ]
+
+data Blog = Blog {
+    blogSessions :: IxSet Session,
+    blogUsers    :: IxSet User,
+    blogEntries  :: IxSet Entry
+} deriving (Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Blog)
+
+initialBlogState :: Blog
+initialBlogState =
+    Blog { blogSessions = empty
+         , blogUsers = empty
+         , blogEntries = empty }
+
+-- acid-state database functions (purity is necessary!)
+
+insertEntry :: Entry -> Update Blog Entry
+insertEntry e =
+    do b@Blog{..} <- get
+       put $ b { blogEntries = IxSet.insert e blogEntries }
+       return e
+
+updateEntry :: Entry -> Update Blog Entry
+updateEntry e =
+    do b@Blog{..} <- get
+       put $ b { blogEntries = IxSet.updateIx (entryId e) e blogEntries }
+       return e
+
+deleteEntry :: EntryId -> Update Blog EntryId
+deleteEntry entry =
+    do b@Blog{..} <- get
+       put $ b { blogEntries = IxSet.deleteIx entry blogEntries }
+       return entry
+
+getEntry :: EntryId -> Query Blog (Maybe Entry)
+getEntry eId =
+    do Blog{..} <- ask
+       return $ getOne $ blogEntries @= eId
+
+latestEntries :: BlogLang -> Query Blog [Entry]
+latestEntries lang =
+    do Blog{..} <- ask
+       return $ IxSet.toDescList (Proxy :: Proxy EDate) $ blogEntries @= lang
+
+addSession :: Session -> Update Blog Session
+addSession nSession =
+    do b@Blog{..} <- get
+       put $ b { blogSessions = IxSet.insert nSession blogSessions}
+       return nSession
+
+getSession :: SessionID -> Query Blog (Maybe Session)
+getSession sId =
+  do Blog{..} <- ask
+     return $ getOne $ blogSessions @= sId
+
+clearSessions :: Update Blog [Session]
+clearSessions =
+  do b@Blog{..} <- get
+     put $ b { blogSessions = empty }
+     return []
+
+addUser :: Text -> String -> Update Blog User
+addUser un pw =
+    do b@Blog{..} <- get
+       let u = User un $ hashString pw
+       put $ b { blogUsers = IxSet.insert u blogUsers}
+       return u
+
+getUser :: Username -> Query Blog (Maybe User)
+getUser uN =
+  do Blog{..} <- ask
+     return $ getOne $ blogUsers @= uN
+
+checkUser :: Username -> String -> Query Blog Bool
+checkUser uN pw =
+  do Blog{..} <- ask
+     let user = getOne $ blogUsers @= uN
+     case user of
+       Nothing  -> return False
+       (Just u) -> return $ password u == hashString pw
+
+-- various functions
+hashString :: String -> ByteString
+hashString = B64.encode .  SHA.hash . B.pack
+
+$(makeAcidic ''Blog
+    [ 'insertEntry
+    , 'updateEntry
+    , 'deleteEntry
+    , 'getEntry
+    , 'latestEntries
+    , 'addSession
+    , 'getSession
+    , 'addUser
+    , 'getUser
+    , 'checkUser
+    , 'clearSessions
+    ])
+
+interactiveUserAdd :: String -> IO ()
+interactiveUserAdd dbHost = do
+  acid <- openRemoteState skipAuthenticationPerform dbHost (PortNumber 8070)
+  putStrLn "Username:"
+  un <- getLine
+  putStrLn "Password:"
+  pw <- getLine
+  update' acid (AddUser (pack un) pw)
+  closeAcidState acid
+
+flushSessions :: IO ()
+flushSessions = do
+  tbDir <- getEnv "TAZBLOG"
+  acid <- openLocalStateFrom (tbDir ++ "/BlogState") initialBlogState
+  update' acid ClearSessions
+  closeAcidState acid
+
+archiveState :: IO ()
+archiveState = do
+    tbDir <- getEnv "TAZBLOG"
+    acid <- openLocalStateFrom (tbDir ++ "/BlogState") initialBlogState
+    createArchive acid
+    closeAcidState acid
diff --git a/services/tazblog/src/Locales.hs b/services/tazblog/src/Locales.hs
new file mode 100644
index 000000000000..c1ddcb38faa4
--- /dev/null
+++ b/services/tazblog/src/Locales.hs
@@ -0,0 +1,61 @@
+module Locales where
+
+import           BlogDB      (BlogLang (..))
+import           Data.Maybe  (fromMaybe)
+import           Data.Text   (Text)
+import qualified Data.Text   as T
+import           Network.URI
+
+data BlogError = NotFound | UnknownError
+
+version = "5.1.2"
+
+blogTitle :: BlogLang -> Text -> Text
+blogTitle DE s = T.concat ["Tazjins blog", s]
+blogTitle EN s = T.concat ["Tazjin's blog", s]
+
+showLangText :: BlogLang -> Text
+showLangText EN = "en"
+showLangText DE = "de"
+
+backText :: BlogLang -> Text
+backText DE = "Früher"
+backText EN = "Earlier"
+
+nextText :: BlogLang -> Text
+nextText DE = "Später"
+nextText EN = "Later"
+
+readMore :: BlogLang -> Text
+readMore DE = "[Weiterlesen]"
+readMore EN = "[Read more]"
+
+-- RSS Strings
+rssTitle :: BlogLang -> String
+rssTitle DE = "Tazjins Blog"
+rssTitle EN = "Tazjin's Blog"
+
+rssDesc :: BlogLang -> String
+rssDesc DE = "Feed zu Tazjins Blog"
+rssDesc EN = "Feed for Tazjin's Blog"
+
+rssLink :: BlogLang -> URI
+rssLink l = fromMaybe nullURI $ parseURI ("http://tazj.in/" ++ show l)
+
+-- errors
+notFoundTitle :: BlogLang -> Text
+notFoundTitle DE = "Nicht gefunden"
+notFoundTitle EN = "Not found"
+
+notFoundText :: BlogLang -> Text
+notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden."
+notFoundText EN = "The requested object could not be found."
+
+unknownErrorText :: BlogLang -> Text
+unknownErrorText DE = "Ein unbekannter Fehler ist aufgetreten."
+unknownErrorText EN = "An unknown error has occured."
+
+-- static information
+repoURL   :: Text = "https://bitbucket.org/tazjin/tazblog-haskell"
+mailTo    :: Text = "mailto:tazjin+blog@gmail.com"
+twitter   :: Text = "https://twitter.com/tazjin"
diff --git a/services/tazblog/src/RSS.hs b/services/tazblog/src/RSS.hs
new file mode 100644
index 000000000000..34804cbf0a55
--- /dev/null
+++ b/services/tazblog/src/RSS.hs
@@ -0,0 +1,41 @@
+module RSS (renderFeed) where
+
+import qualified Data.Text as T
+
+import Control.Monad (liftM)
+import Data.Maybe    (fromMaybe)
+import Data.Time     (UTCTime, getCurrentTime)
+import Network.URI
+import Text.RSS
+
+import BlogDB  hiding (Title)
+import Locales
+
+createChannel :: BlogLang -> UTCTime -> [ChannelElem]
+createChannel l  now = [ Language $ show l
+                       , Copyright "Vincent Ambo"
+                       , WebMaster "tazjin@gmail.com"
+                       , ChannelPubDate now
+                       ]
+
+createRSS :: BlogLang -> UTCTime -> [Item] -> RSS
+createRSS l t = RSS (rssTitle l) (rssLink l) (rssDesc l) (createChannel l t)
+
+createItem :: Entry -> Item
+createItem Entry{..} = [ Title $ T.unpack title
+                       , Link $ makeLink lang entryId
+                       , Description $ T.unpack btext
+                       , PubDate edate]
+
+makeLink :: BlogLang -> EntryId -> URI
+makeLink l i = let url = "http://tazj.in/" ++ show l ++ "/" ++ show i
+               in fromMaybe nullURI $ parseURI url
+
+createItems :: [Entry] -> [Item]
+createItems = map createItem
+
+createFeed :: BlogLang -> [Entry] -> IO RSS
+createFeed l e = getCurrentTime >>= (\t -> return $ createRSS l t $ createItems e )
+
+renderFeed :: BlogLang -> [Entry] -> IO String
+renderFeed l e = liftM (showXML . rssToXML) (createFeed l e)
diff --git a/services/tazblog/src/Server.hs b/services/tazblog/src/Server.hs
new file mode 100644
index 000000000000..c025be009a2e
--- /dev/null
+++ b/services/tazblog/src/Server.hs
@@ -0,0 +1,189 @@
+-- Server implementation based on Happstack
+
+module Server where
+
+import           Control.Applicative    (optional)
+import           Control.Monad          (msum, mzero, unless)
+import           Control.Monad.IO.Class (liftIO)
+import           Data.Acid
+import           Data.Acid.Advanced
+import           Data.ByteString.Char8  (unpack)
+import           Data.Char              (toLower)
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import           Data.Time
+import           Happstack.Server       hiding (Session)
+
+import Blog
+import BlogDB  hiding (updateEntry)
+import Locales
+import RSS
+
+instance FromReqURI BlogLang where
+  fromReqURI sub =
+    case map toLower sub of
+      "de" -> Just DE
+      "en" -> Just EN
+      _    -> Nothing
+
+tmpPolicy :: BodyPolicy
+tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000
+
+runBlog :: AcidState Blog -> Int -> String -> IO ()
+runBlog acid port respath =
+  simpleHTTP nullConf {port = port} $ tazBlog acid respath
+
+tazBlog :: AcidState Blog -> String -> ServerPart Response
+tazBlog acid resDir = do
+    msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang
+         , dir "admin" $ msum [
+                adminHandler acid -- this checks auth
+              , method GET >> (ok $ toResponse adminLogin)
+              , method POST >> processLogin acid ]
+         , dir "static" $ staticHandler resDir
+         , blogHandler acid EN
+         , staticHandler resDir
+         , notFound $ toResponse $ showError NotFound DE
+         ]
+
+blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response
+blogHandler acid lang =
+    msum [ path $ \(eId :: Integer) -> showEntry acid lang $ EntryId eId
+         , nullDir >> showIndex acid lang
+         , dir "rss" $ nullDir >> showRSS acid lang
+         , dir "rss.xml" $ nullDir >> showRSS acid lang
+         , notFound $ toResponse $ showError NotFound lang
+         ]
+
+staticHandler :: String -> ServerPart Response
+staticHandler resDir = do
+  setHeaderM "cache-control" "max-age=630720000"
+  setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT"
+  serveDirectory DisableBrowsing [] resDir
+
+adminHandler :: AcidState Blog -> ServerPart Response
+adminHandler acid = do
+  guardSession acid
+  msum [ dir "entry" $ method POST >> postEntry acid
+       , dir "entry" $ path $ \(entry :: Integer) -> msum [
+              method GET >> editEntry acid entry
+            , method POST >> updateEntry acid entry ]
+       , dir "entrylist" $ path $ \(lang :: BlogLang) -> entryList acid lang
+       , ok $ toResponse $ adminIndex "tazjin"
+       ]
+
+showEntry :: AcidState Blog -> BlogLang -> EntryId -> ServerPart Response
+showEntry acid lang eId = do
+    entry <- query' acid (GetEntry eId)
+    tryEntry entry lang
+
+tryEntry :: Maybe Entry -> BlogLang -> ServerPart Response
+tryEntry Nothing lang = notFound $ toResponse $ showError NotFound lang
+tryEntry (Just entry) _ = ok $ toResponse $ blogTemplate eLang eTitle $ renderEntry entry
+    where
+        eTitle = T.append ": " (title entry)
+        eLang = lang entry
+
+showIndex :: AcidState Blog -> BlogLang -> ServerPart Response
+showIndex acid lang = do
+    entries <- query' acid (LatestEntries lang)
+    (page :: Maybe Int) <- optional $ lookRead "page"
+    ok $ toResponse $ blogTemplate lang "" $
+        renderEntries False (eDrop page entries) (Just $ showLinks page lang)
+  where
+    eDrop :: Maybe Int -> [a] -> [a]
+    eDrop (Just i) = drop ((i-1) * 6)
+    eDrop Nothing = drop 0
+
+showRSS :: AcidState Blog -> BlogLang -> ServerPart Response
+showRSS acid lang = do
+    entries <- query' acid (LatestEntries lang)
+    feed <- liftIO $ renderFeed lang $ take 6 entries
+    setHeaderM "content-type" "text/xml"
+    ok $ toResponse feed
+
+{- ADMIN stuff -}
+
+postEntry :: AcidState Blog -> ServerPart Response
+postEntry acid = do
+    nullDir
+    decodeBody tmpPolicy
+    now <- liftIO getCurrentTime
+    let eId = timeToId now
+    lang <- look "lang"
+    nBtext <- lookText' "btext"
+    nMtext <- lookText' "mtext"
+    nEntry <- Entry <$> pure eId
+                    <*> getLang lang
+                    <*> readCookieValue "sUser"
+                    <*> lookText' "title"
+                    <*> pure nBtext
+                    <*> pure nMtext
+                    <*> pure now
+    update' acid (InsertEntry nEntry)
+    seeOther ("/" ++ lang ++ "/" ++ show eId) (toResponse())
+  where
+    timeToId :: UTCTime -> EntryId
+    timeToId t = EntryId . read $ formatTime defaultTimeLocale "%s" t
+    getLang :: String -> ServerPart BlogLang
+    getLang "de" = return DE
+    getLang _ = return EN -- English is default
+
+entryList :: AcidState Blog -> BlogLang -> ServerPart Response
+entryList acid lang = do
+    entries <- query' acid (LatestEntries lang)
+    ok $ toResponse $ adminEntryList entries
+
+editEntry :: AcidState Blog -> Integer -> ServerPart Response
+editEntry acid entryId = do
+    (Just entry) <- query' acid (GetEntry $ EntryId entryId)
+    ok $ toResponse $ editPage entry
+
+updateEntry :: AcidState Blog -> Integer -> ServerPart Response
+updateEntry acid entryId = do
+    decodeBody tmpPolicy
+    (Just entry) <- query' acid (GetEntry $ EntryId entryId)
+    nTitle <- lookText' "title"
+    nBtext <- lookText' "btext"
+    nMtext <- lookText' "mtext"
+    let newEntry = entry { title = nTitle
+                         , btext = nBtext
+                         , mtext = nMtext}
+    update' acid (UpdateEntry newEntry)
+    seeOther (concat $ ["/", show $ lang entry, "/", show entryId])
+             (toResponse ())
+
+guardSession :: AcidState Blog -> ServerPartT IO ()
+guardSession acid = do
+    (sId :: Text) <- readCookieValue "session"
+    (uName :: Text) <- readCookieValue "sUser"
+    now <- liftIO getCurrentTime
+    mS <- query' acid (GetSession $ SessionID sId)
+    case mS of
+      Nothing -> mzero
+      (Just Session{..}) -> unless ((uName == username user) && sessionTimeDiff now sdate)
+                                   mzero
+  where
+    sessionTimeDiff :: UTCTime -> UTCTime -> Bool
+    sessionTimeDiff now sdate = diffUTCTime now sdate < 43200
+
+
+processLogin :: AcidState Blog -> ServerPart Response
+processLogin acid = do
+    decodeBody tmpPolicy
+    account <- lookText' "account"
+    password <- look "password"
+    login <- query' acid (CheckUser (Username account) password)
+    if login
+      then createSession account
+      else unauthorized $ toResponse adminLogin
+  where
+    createSession account = do
+      now <- liftIO getCurrentTime
+      let sId = hashString $ show now
+      addCookie (MaxAge 43200) (mkCookie "session" $ unpack sId)
+      addCookie (MaxAge 43200) (mkCookie "sUser" $ T.unpack account)
+      (Just user) <- query' acid (GetUser $ Username account)
+      let nSession = Session (T.pack $ unpack sId) user now
+      update' acid (AddSession nSession)
+      seeOther ("/admin?do=login" :: Text) (toResponse())
diff --git a/services/tazblog/static/admin.css b/services/tazblog/static/admin.css
new file mode 100644
index 000000000000..10980dc9e4c1
--- /dev/null
+++ b/services/tazblog/static/admin.css
@@ -0,0 +1,49 @@
+@charset "UTF-8";
+/* CSS Document */
+
+body {
+	padding-top: 20px;
+	font-family: 'PT Sans', sans-serif;
+	background-image: linear-gradient(bottom, rgb(245,245,245) 66%, rgb(239,239,239) 83%);
+	background-image: -o-linear-gradient(bottom, rgb(245,245,245) 66%, rgb(239,239,239) 83%);
+	background-image: -webkit-linear-gradient(bottom, rgb(245,245,245) 66%, rgb(239,239,239) 83%);
+	background-image: -webkit-gradient(
+		linear,
+		left bottom,
+		left top,
+		color-stop(0.66, rgb(245,245,245)),
+		color-stop(0.83, rgb(239,239,239))
+	);
+	background-repeat: no-repeat;
+	background-color: rgb(245,245,245);
+}
+
+.loginBox {
+	width: 400px;
+	margin: 0 auto;
+}
+
+.loginBoxTop {
+	width: 380px;
+	height: 28px;
+	color: #FFFFFF;
+	font-size: 12px;
+	padding-left: 20px;
+	padding-top: 11px;
+	background: url(/static/loginBoxTop.png);
+}
+
+.loginBoxMiddle {
+    background-color: #F3F3F3;
+    border-top: 0px hidden;
+    border:1px solid #D2D2D2;
+    border-bottom-left-radius: 12px;
+    border-bottom-right-radius: 12px;
+	text-align: center;
+    font-size:12px;
+    height:auto;
+    padding-left: 10px;
+    padding-right: 10px;
+    min-height:200px;
+    width:378px;
+}
diff --git a/services/tazblog/static/apple-touch-icon.png b/services/tazblog/static/apple-touch-icon.png
new file mode 100644
index 000000000000..22ba058cddd4
--- /dev/null
+++ b/services/tazblog/static/apple-touch-icon.png
Binary files differdiff --git a/services/tazblog/static/blog.css b/services/tazblog/static/blog.css
new file mode 100644
index 000000000000..e6e4ae3c2be0
--- /dev/null
+++ b/services/tazblog/static/blog.css
@@ -0,0 +1,35 @@
+body {
+    margin: 40px auto;
+    max-width: 650px;
+    line-height: 1.6;
+    font-size: 18px;
+    color: #383838;
+    padding: 0 10px
+}
+h1, h2, h3 {
+    line-height: 1.2
+}
+.footer {
+    text-align: right;
+}
+.lod {
+    text-align: center;
+}
+.unstyled-link {
+    color: inherit;
+    text-decoration: none;
+}
+.uncoloured-link {
+    color: inherit;
+}
+.date {
+    text-align: right;
+    font-style: italic;
+    float: right;
+}
+.inline {
+    display: inline;
+}
+.navigation {
+    text-align: center;
+}
diff --git a/services/tazblog/static/favicon.ico b/services/tazblog/static/favicon.ico
new file mode 100644
index 000000000000..2958dd3afcb0
--- /dev/null
+++ b/services/tazblog/static/favicon.ico
Binary files differdiff --git a/services/tazblog/static/keybase.txt b/services/tazblog/static/keybase.txt
new file mode 100644
index 000000000000..661c33e01e73
--- /dev/null
+++ b/services/tazblog/static/keybase.txt
@@ -0,0 +1,69 @@
+==================================================================
+https://keybase.io/tazjin
+--------------------------------------------------------------------
+
+I hereby claim:
+
+  * I am an admin of http://tazj.in
+  * I am tazjin (https://keybase.io/tazjin) on keybase.
+  * I have a public key with fingerprint DCF3 4CFA C1AC 44B8 7E26  3331 36EE 3481 4F6D 294A
+
+To claim this, I am signing this object:
+
+{
+    "body": {
+        "key": {
+            "fingerprint": "dcf34cfac1ac44b87e26333136ee34814f6d294a",
+            "host": "keybase.io",
+            "key_id": "36EE34814F6D294A",
+            "uid": "2268b75a56bb9693d3ef077bc1217900",
+            "username": "tazjin"
+        },
+        "service": {
+            "hostname": "tazj.in",
+            "protocol": "http:"
+        },
+        "type": "web_service_binding",
+        "version": 1
+    },
+    "ctime": 1397644545,
+    "expire_in": 157680000,
+    "prev": "4973fdda56a6cfa726a813411c915458c652be45dd19283f7a4ae4f9c217df14",
+    "seqno": 4,
+    "tag": "signature"
+}
+
+with the aforementioned key, yielding the PGP signature:
+
+-----BEGIN PGP MESSAGE-----
+Version: GnuPG v2.0.22 (GNU/Linux)
+
+owGbwMvMwMWY9pU1Q3bHF2vG0wdeJTEE+8WyVSsl5adUKllVK2Wngqm0zLz01KKC
+osy8EiUrpZTkNGOT5LTEZMPEZBOTJAvzVCMzY2NjQ2Oz1FRjEwtDkzSzFCNLk0Ql
+HaWM/GKQDqAxSYnFqXqZ+UAxICc+MwUoamzm6gpW72bmAlTvCJQrBUsYGZlZJJmb
+JpqaJSVZmlkapxinphmYmyclGxoZmlsaGIAUFqcW5SXmpgJVlyRWZWXmKdXqKAHF
+yjKTU0EuBlmMJK8HVKCjVFCUX5KfnJ8DFMwoKSmwAukpqSwAKSpPTYqHao9PysxL
+AXoYqKEstag4Mz9PycoQqDK5JBNknqGxpbmZiYmpiamOUmpFQWZRanwmSIWpuZmF
+ARCArEktAxppYmlunJaSAvRFohkwtMyNzBItDI1NDA2TLQ2Bui2SzUyNklJNTFNS
+DC2NLIzTzBNNElNN0iyTgZ5MSTM0UQJ5qDAvX8nKBOjMxHSgkcWZ6XmJJaVFqUq1
+nUwyLAyMXAxsrEygKGPg4hSARWSZH/8/0573HMdvfH5XxeayYZ2efPb8bw730i1/
+WBU3qru5pKlf3xKmeK5ihtKeT6VXGm3usV2reZWyvO/0joi83oT9P80s88Q6U/vb
+vmycHnB7e110v/3OZadu/Sx6+uXk/ZeCR8u+p/+6dNc8XWqX/68t06pnrGKU/BfU
+F7X5S/HUy4ysvyZN+v1Jj6NtMvvN1EvPpCpv3kz2tGU1EzpZFfl8Xujq1OopuxZJ
+l5kvDlgZ78ezdLZ1+aOlixbsXra4/3fdbZ8XnQX1DatzV18+e2rmMcPKm6qngqIf
+Xp8oKTAz+Mg1v6gHP0wLN/Mf3JKjYHnX5U6L/KIvkbsLArtES0r7w1iWZ3OvvSPr
+fW6heune1tOb7j3vP+1XeOyV2ekr6pPO3bdrv9X25HbTaqs7z06f0v35fmtQ3uUZ
+Z35eLYmaEmb/x/u3vFh6GsvMDocpCTpPlHa0z+xzOGbhzLFO18v21Zd9ISG3Hqtd
+F7jaLlWa2W+TsytNnXudVrfCBSbl8zNMfuk2e0Z8i9ix3PmEVa3rTEfhde3qwgtY
+dy8rUbzzd5d9ccF63btqO/VMb4oe04x4uCLB5RD3p+8+s77o/T4WP2cFw+0cviX6
+StlJX5f+U3Or3fZY7dUfPcmMJZ/eSs7m+1d5IUbs3jI27olHFzGVvTcsu7w79aOK
+SxmXvnEIUwZXgP6BL4LrPDY1rN2V0q1cZj1/efj880rzeu6+OQYA
+=xHfH
+-----END PGP MESSAGE-----
+
+And finally, I am proving ownership of this host by posting or
+appending to this document.
+
+View my publicly-auditable identity here: https://keybase.io/tazjin
+
+==================================================================
diff --git a/services/tazblog/static/loginBoxTop.png b/services/tazblog/static/loginBoxTop.png
new file mode 100644
index 000000000000..8a0ee3ba8d6f
--- /dev/null
+++ b/services/tazblog/static/loginBoxTop.png
Binary files differdiff --git a/services/tazblog/static/signin.gif b/services/tazblog/static/signin.gif
new file mode 100644
index 000000000000..bbe282bae0a4
--- /dev/null
+++ b/services/tazblog/static/signin.gif
Binary files differdiff --git a/services/tazblog/tazblog.cabal b/services/tazblog/tazblog.cabal
new file mode 100644
index 000000000000..3ca9d373b277
--- /dev/null
+++ b/services/tazblog/tazblog.cabal
@@ -0,0 +1,71 @@
+Name:                tazblog
+Version:             5.1.3
+Synopsis:            Tazjin's Blog
+License:             MIT
+License-file:        LICENSE
+Author:              Vincent Ambo
+Maintainer:          tazjin@gmail.com
+Category:            Web blog
+Build-type:          Simple
+cabal-version:       >= 1.10
+
+library
+  hs-source-dirs: src
+  default-language: Haskell2010
+  ghc-options: -W
+  exposed-modules: Blog, BlogDB, Locales, Server, RSS
+  build-depends: base,
+                 bytestring,
+                 happstack-server,
+                 text,
+                 blaze-html,
+                 blaze-markup,
+                 crypto-api,
+                 cryptohash,
+                 old-locale,
+                 time,
+                 base64-bytestring,
+                 acid-state,
+                 ixset,
+                 safecopy,
+                 mtl,
+                 transformers,
+                 network,
+                 network-uri,
+                 rss,
+                 hamlet,
+                 shakespeare,
+                 markdown
+  default-extensions:
+             DeriveDataTypeable
+             FlexibleContexts
+             GeneralizedNewtypeDeriving
+             MultiParamTypeClasses
+             OverloadedStrings
+             RecordWildCards
+             ScopedTypeVariables
+             TemplateHaskell
+             TypeFamilies
+             QuasiQuotes
+
+executable tazblog
+  hs-source-dirs: blog
+  main-is: Main.hs
+  default-language:    Haskell2010
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends: base,
+                 acid-state,
+                 tazblog,
+                 options,
+                 network
+
+executable tazblog-db
+  hs-source-dirs: db
+  main-is: Main.hs
+  default-language: Haskell2010
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends: base,
+                 acid-state,
+                 tazblog,
+                 options,
+                 network