aboutsummaryrefslogtreecommitdiff
path: root/src/Web/ZeroBin.hs
blob: de32ce3b0ddf08e299a5e560d5441541a4e265d3 (plain)
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
{-|
High-level functions for posting to 0bin services like
<http://0bin.net> or <http://paste.ec>.

 >>> import Web.ZeroBin
 >>> import Data.ByteString.Char8
 >>> share "http://0bin.net" Day (pack "hello")
"http://0bin.net/paste/ZH6VyKXjDHAiPT8J#C6LLidGyHO7xt3xuDtsNHjZ77luualukEuJ25S6w/K1m"

-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Web.ZeroBin
  ( Expiration(..)
  , ZeroBinError(..)
  , share
  ) where

import Control.Exception (Exception)
import Control.Exception.Base (throwIO)
import qualified Data.Aeson as JSON
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (encode)
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
import Data.Maybe (fromJust)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import qualified Network.HTTP.Conduit as HTTP
import Web.ZeroBin.SJCL (Content, encrypt)
import Web.ZeroBin.Utils (makePassword)

data Response = Response
  { status :: String
  , message :: Maybe String
  , paste :: Maybe String
  } deriving (Generic, Show)

instance JSON.FromJSON Response

-- | 0bin error message
data ZeroBinError =
  ZeroBinError String
  deriving (Show, Typeable)

instance Exception ZeroBinError

-- | Expiration of a paste.
--   "Burn after reading" really means "burn after two readings",
--   because we do not redirect to the paste like a browser does.
--   You can verify your paste before sharing the link.
--   Original <http://0bin.net> does not support 'Week'.
data Expiration
  = Once -- ^ burn after reading
  | Day -- ^ keep for 24 hours
  | Week -- ^ for 7 days
  | Month -- ^ for 30 days
  | Never -- ^ for 100 years

form :: Expiration -> String
form Once = "burn_after_reading"
form Day = "1_day"
form Week = "1_week"
form Month = "1_month"
form Never = "never"

post :: String -> Expiration -> Content -> IO String
post bin ex ct = do
  req' <- HTTP.parseRequest $ bin ++ "/paste/create"
  let req =
        HTTP.urlEncodedBody
          [ (C.pack "expiration", C.pack $ form ex)
          , (C.pack "content", L.toStrict $ JSON.encode ct)
          ]
          req'
  manager <- HTTP.newManager HTTP.tlsManagerSettings
  response <- HTTP.httpLbs req manager
  let resp = fromJust . JSON.decode $ HTTP.responseBody response
  case status resp of
    "ok" -> return $ bin ++ "/paste/" ++ (fromJust . paste) resp
    _ -> throwIO . ZeroBinError $ (fromJust . message) resp

-- | Encrypts the plain data with a random password,
--   post to 0bin and return the URI of a new paste.
--   Can throw 'ZeroBinError' or 'Network.HTTP.Conduit.HttpException'.
share ::
     String -- ^ the address of 0bin, e. g. <http://0bin.net> or <https://paste.ec>
  -> Expiration
  -> ByteString -- ^ the plain data to encrypt and paste
  -> IO String -- ^ the URI of paste
share bin ex txt = do
  pwd <- makePassword 33
  cnt <- encrypt pwd (encode txt)
  uri <- post bin ex cnt
  return $ uri ++ "#" ++ pwd