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

hpaste :: src / Hpaste / Model /

Report.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
68
69
70
71
72
73
74
75
76
77
78
79
80
81

{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | Report model.

module Hpaste.Model.Report
 (getSomeReports,createReport,countReports)
  where

import           Hpaste.Types
import           Hpaste.Controller.Cache
import           Hpaste.Types.Cache as Key

import           Control.Monad

import           Control.Monad.Env
import           Control.Monad.IO
import           Data.Pagination
import           Data.Maybe
import           Data.Monoid.Operator ((++))
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import           Network.Mail.Mime
import           Prelude              hiding ((++))
import           Snap.App

-- | Get some paginated reports.
getSomeReports :: Pagination -> Model c s [Report]
getSomeReports Pagination{..} =
  queryNoParams ["SELECT created,paste,comments"
                ,"FROM report"
                ,"ORDER BY id DESC"
                ,"OFFSET " ++ show (max 0 (pnCurrentPage - 1) * pnPerPage)
                ,"LIMIT " ++ show pnPerPage]

-- | Count reports.
countReports :: Model c s Integer
countReports = do
  rows <- singleNoParams ["SELECT COUNT(*)"
                         ,"FROM report"]
  return $ fromMaybe 0 rows

-- | Create a new report.
createReport :: ReportSubmit -> Model Config s (Maybe ReportId)
createReport rs@ReportSubmit{..} = do
  res <- single ["INSERT INTO report"
                ,"(paste,comments)"
                ,"VALUES"
                ,"(?,?)"
                ,"returning id"]
                (rsPaste,rsComments)
  _ <- exec ["UPDATE paste"
       	    ,"SET public = false"
	    ,"WHERE id = ?"]
	    (Only rsPaste)
  let reset pid = do
        resetCacheModel (Key.Paste pid)
        resetCacheModel (Key.Revision pid)
  reset rsPaste
  sendReport rs
  return res

sendReport :: ReportSubmit -> Model Config s ()
sendReport ReportSubmit{..} = do
  conf <- env modelStateConfig
  m <- io $ simpleMail (configAdmin conf)
		       (configSiteAddy conf)
		       (T.pack ("Paste reported: #" ++ show rsPaste))
		       (LT.pack body)
		       (LT.pack body)
		       []
  io $ renderSendMail m

  where body =
  	  "Paste " ++ show rsPaste ++ "\n\n" ++
	  "http://hpaste.org/" ++ show rsPaste ++ "?show_private=true" ++
	  "\n\n" ++
	  rsComments
[See repo JSON]