diff options
Diffstat (limited to 'src/Web/ZeroBin.hs')
| -rw-r--r-- | src/Web/ZeroBin.hs | 77 |
1 files changed, 40 insertions, 37 deletions
diff --git a/src/Web/ZeroBin.hs b/src/Web/ZeroBin.hs index f6ba051..0f32a50 100644 --- a/src/Web/ZeroBin.hs +++ b/src/Web/ZeroBin.hs @@ -8,40 +8,42 @@ High-level functions for posting to 0bin services like "http://0bin.net/paste/ZH6VyKXjDHAiPT8J#C6LLidGyHO7xt3xuDtsNHjZ77luualukEuJ25S6w/K1m" -} - {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -module Web.ZeroBin ( - Expiration(..), - ZeroBinError(..), - share -) where +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 Web.ZeroBin.SJCL (encrypt, Content) -import Web.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 +import Web.ZeroBin.SJCL (Content, encrypt) +import Web.ZeroBin.Utils (makePassword) -data Response = Response { - status :: String +data Response = Response + { status :: String , message :: Maybe String - , paste :: Maybe String + , paste :: Maybe String } deriving (Generic, Show) + instance JSON.FromJSON Response -- | 0bin error message -data ZeroBinError = ZeroBinError String +data ZeroBinError = + ZeroBinError String deriving (Show, Typeable) + instance Exception ZeroBinError -- | Expiration of a paste. @@ -50,44 +52,45 @@ instance Exception ZeroBinError -- 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 + = 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 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.parseUrl $ bin ++ "/paste/create" - let req = HTTP.urlEncodedBody - [ (C.pack "expiration" , C.pack $ form ex) - , (C.pack "content" , L.toStrict $ JSON.encode ct) - ] req' + 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 - + _ -> 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 :: + 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 + pwd <- makePassword 33 + cnt <- encrypt pwd (encode txt) + uri <- post bin ex cnt return $ uri ++ "#" ++ pwd - |