aboutsummaryrefslogtreecommitdiff
path: root/src/ZeroBin.hs
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2015-11-04 11:10:01 +0300
committerIgor Pashev <pashev.igor@gmail.com>2015-11-04 11:17:05 +0300
commitab5802ad6d172adea49fc42edab9742551490be7 (patch)
tree9febbdec60779c5deb763d8ea023b55fed1abe76 /src/ZeroBin.hs
parent5260b4b5d52cd7d7052c0fa980c048d857e2d14b (diff)
downloadzerobin-1.2.0.tar.gz
Use top-level name Web1.2.0
Diffstat (limited to 'src/ZeroBin.hs')
-rw-r--r--src/ZeroBin.hs64
1 files changed, 0 insertions, 64 deletions
diff --git a/src/ZeroBin.hs b/src/ZeroBin.hs
deleted file mode 100644
index 5d8abd8..0000000
--- a/src/ZeroBin.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module ZeroBin (
- Expiration(..),
- share
-) where
-
-import Data.ByteString (ByteString)
-import Data.ByteString.Base64 (encode)
-import Data.Maybe (fromJust)
-import GHC.Generics (Generic)
-import ZeroBin.SJCL (encrypt, Content)
-import ZeroBin.Utils (makePassword)
-import qualified Data.Aeson as JSON
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy as L
-import qualified Network.HTTP.Conduit as HTTP
-
-data Response = Response {
- status :: String
- , message :: Maybe String
- , paste :: Maybe String
- } deriving (Generic, Show)
-instance JSON.FromJSON Response
-
-data Expiration
- = Once
- | Day
- | Week
- | Month
- | Never
-
-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 (Either String String)
-post bin ex ct = do
- req' <- HTTP.parseUrl $ 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 . Right $
- bin ++ "/paste/" ++ (fromJust . paste) resp
- _ -> return . Left $
- (fromJust . message) resp
-
-share :: String -> Expiration -> ByteString -> IO (Either String String)
-share bin ex txt = do
- pwd <- makePassword 33
- c <- encrypt pwd (encode txt)
- append pwd `fmap` post bin ex c
- where
- append _ (Left e) = Left e
- append p (Right u) = Right $ u ++ "#" ++ p
-