aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--cli/Main.hs6
-rw-r--r--src/Web/ZeroBin.hs27
2 files changed, 17 insertions, 16 deletions
diff --git a/cli/Main.hs b/cli/Main.hs
index 5d6b445..bcd7d54 100644
--- a/cli/Main.hs
+++ b/cli/Main.hs
@@ -72,9 +72,5 @@ main = do
cnt <- getContent (args `O.isPresent` O.longOption "file") text
case getExpiration expire of
Nothing -> die "invalid value for expiration"
- Just e -> do
- rc <- share bin e cnt
- case rc of
- Left err -> die err
- Right uri -> putStrLn uri
+ Just e -> share bin e cnt >>= putStrLn
diff --git a/src/Web/ZeroBin.hs b/src/Web/ZeroBin.hs
index 24e7115..94c2b17 100644
--- a/src/Web/ZeroBin.hs
+++ b/src/Web/ZeroBin.hs
@@ -1,13 +1,18 @@
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Web.ZeroBin (
Expiration(..),
+ ZeroBinError(..),
share
) where
+import Control.Exception (Exception)
+import Control.Exception.Base (throwIO)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (encode)
import Data.Maybe (fromJust)
+import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Web.ZeroBin.SJCL (encrypt, Content)
import Web.ZeroBin.Utils (makePassword)
@@ -23,6 +28,10 @@ data Response = Response {
} deriving (Generic, Show)
instance JSON.FromJSON Response
+data ZeroBinError = ZeroBinError String
+ deriving (Show, Typeable)
+instance Exception ZeroBinError
+
data Expiration
= Once
| Day
@@ -37,7 +46,7 @@ form Week = "1_week"
form Month = "1_month"
form Never = "never"
-post :: String -> Expiration -> Content -> IO (Either String String)
+post :: String -> Expiration -> Content -> IO String
post bin ex ct = do
req' <- HTTP.parseUrl $ bin ++ "/paste/create"
let req = HTTP.urlEncodedBody
@@ -48,17 +57,13 @@ post bin ex ct = do
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
+ "ok" -> return $ bin ++ "/paste/" ++ (fromJust . paste) resp
+ _ -> throwIO . ZeroBinError $ (fromJust . message) resp
-share :: String -> Expiration -> ByteString -> IO (Either String String)
+share :: String -> Expiration -> ByteString -> IO 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
+ cnt <- encrypt pwd (encode txt)
+ uri <- post bin ex cnt
+ return $ uri ++ "#" ++ pwd