diff options
author | Igor Pashev <pashev.igor@gmail.com> | 2015-11-04 11:10:01 +0300 |
---|---|---|
committer | Igor Pashev <pashev.igor@gmail.com> | 2015-11-04 11:17:05 +0300 |
commit | ab5802ad6d172adea49fc42edab9742551490be7 (patch) | |
tree | 9febbdec60779c5deb763d8ea023b55fed1abe76 /src/ZeroBin.hs | |
parent | 5260b4b5d52cd7d7052c0fa980c048d857e2d14b (diff) | |
download | zerobin-1.2.0.tar.gz |
Use top-level name Web1.2.0
Diffstat (limited to 'src/ZeroBin.hs')
-rw-r--r-- | src/ZeroBin.hs | 64 |
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 - |