From 56115491d0dce58bf06f92fd5022363eb05a3755 Mon Sep 17 00:00:00 2001
From: Igor Pashev <pashev.igor@gmail.com>
Date: Thu, 5 Nov 2015 20:20:19 +0300
Subject: Throw ZeroBinError instead of return Either

It can throw HttpException anyway
---
 cli/Main.hs        |  6 +-----
 src/Web/ZeroBin.hs | 27 ++++++++++++++++-----------
 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
 
-- 
cgit v1.2.3