Paste server written in Haskell. Fork of Hpaste, fully freedom and privacy respecting and generally improved. At the time of writing there's an instance at <http://paste.rel4tion.org>.

[[ 🗃 ^aoqmo toothpaste ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]

Clone

HTTPS: git clone https://vervis.peers.community/repos/aoqmo

SSH: git clone USERNAME@vervis.peers.community:aoqmo

Branches

Tags

master :: src /

Main.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

{-# OPTIONS -Wall #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Main entry point.

module Main (main) where

import Hpaste.Config
import Hpaste.Controller.Activity as Activity
import Hpaste.Controller.Browse   as Browse
import Hpaste.Controller.Diff     as Diff
import Hpaste.Controller.Home     as Home
import Hpaste.Controller.New      as New
import Hpaste.Controller.Paste    as Paste
import Hpaste.Controller.Raw      as Raw
import Hpaste.Controller.Report   as Report
import Hpaste.Controller.Reported as Reported
import Hpaste.Controller.Rss      as Rss
import Hpaste.Controller.Script   as Script
import Hpaste.Model.Announcer     (newAnnouncer)
import Hpaste.Types
import Hpaste.Types.Announcer

import Control.Concurrent.Chan    (Chan)
import Data.Text.Lazy             (Text)
import System.Environment
import Snap.App
import Snap.Http.Server           hiding (Config)
import Snap.Util.FileServe


-- | Main entry point.
main :: IO ()
main = do
  cpath:_ <- getArgs
  config <- getConfig cpath
  announces <- newAnnouncer (configAnnounce config)
  pool <- newPool (configPostgres config)
  setUnicodeLocale "en_US"
  httpServe server (serve config pool announces)
 where server = setPort 10000 defaultConfig

-- | Serve the controllers.
serve :: Config -> Pool -> Announcer -> Snap ()
serve config pool ans = route routes where
  routes = [("/css/",serveDirectory "static/css")
           ,("/js/amelie.hs.js",run Script.handle)
           ,("/js/",serveDirectory "static/js")
           ,("/hs/",serveDirectory "static/hs")
           ,("",run (Home.handle False))
	   ,("/spam",run (Home.handle True))
           ,("/:id",run (Paste.handle False))
           ,("/raw/:id",run Raw.handle)
           ,("/revision/:id",run (Paste.handle True))
           ,("/report/:id",run Report.handle)
           ,("/reported",run Reported.handle)
           ,("/new",run (New.handle New.NewPaste))
           ,("/annotate/:id",run (New.handle New.AnnotatePaste))
           ,("/edit/:id",run (New.handle New.EditPaste))
           ,("/new/:channel",run (New.handle New.NewPaste))
           ,("/browse",run Browse.handle)
           ,("/activity",run Activity.handle)
           ,("/diff/:this/:that",run Diff.handle)
	   ,("/delete",run Report.handleDelete)
           ,("/channel/:channel/rss",run Rss.handle)
           ]
  run = runHandler ans config pool
[See repo JSON]