zerobin 1.1.1 → 1.2.0

raw patch · 10 files changed

+182/−182 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +1/−1
• cli/Main.hs +1/−1
• nodejs/Main.hs +2/−2
• src/Web/ZeroBin.hs +64/−0
• src/Web/ZeroBin/SJCL.hs +91/−0
• src/Web/ZeroBin/Utils.hs +19/−0
• src/ZeroBin.hs +0/−64
• src/ZeroBin/SJCL.hs +0/−91
• src/ZeroBin/Utils.hs +0/−19
• zerobin.cabal +4/−4

@@ -6,7 +6,7 @@ using client-side encryption with [SJCL](https://crypto.stanford.edu/sjcl/).  This library reimplements encryption part of [SJCL](https://crypto.stanford.edu/sjcl/)-allowing you to post secrets from Haskell programs and shell script.+allowing you to post secrets from Haskell programs and shell scripts.  Requirements ============

@@ -8,7 +8,7 @@ import System.Exit (exitFailure) import System.IO (stderr, hPutStrLn) import Text.RawString.QQ (r)-import ZeroBin (share, Expiration(..))+import Web.ZeroBin (share, Expiration(..)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C import qualified System.Console.Docopt.NoTH as O

@@ -4,8 +4,8 @@  import System.Environment (getArgs) import System.Process (callProcess)-import ZeroBin.SJCL (encrypt)-import ZeroBin.Utils (makePassword)+import Web.ZeroBin.SJCL (encrypt)+import Web.ZeroBin.Utils (makePassword) import qualified Data.Aeson as JSON import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C

@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveGeneric #-}++module Web.ZeroBin (+  Expiration(..),+  share+) where++import Data.ByteString (ByteString)+import Data.ByteString.Base64 (encode)+import Data.Maybe (fromJust)+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++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+

@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveGeneric #-}++module Web.ZeroBin.SJCL (+  Content(..),+  encrypt+) where++import Crypto.Cipher.AES (AES256)+import Crypto.Cipher.Types (ivAdd, blockSize, cipherInit, ecbEncrypt, ctrCombine, makeIV)+import Crypto.Error (throwCryptoErrorIO)+import Crypto.Hash.Algorithms (SHA256(..))+import Crypto.KDF.PBKDF2 (prfHMAC)+import Crypto.Number.Serialize (i2ospOf_)+import Crypto.Random.Entropy (getEntropy)+import Data.ByteString (ByteString)+import Data.Maybe (fromJust)+import Data.Word (Word8)+import GHC.Generics (Generic)+import Web.ZeroBin.Utils (toWeb)+import qualified Crypto.KDF.PBKDF2 as PBKDF2+import qualified Data.Aeson as JSON+import qualified Data.ByteArray as BA+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C++data Content = Content {+    iv   :: String+  , salt :: String+  , ct   :: String+  } deriving (Generic, Show)++-- FIXME: http://stackoverflow.com/questions/33045350/unexpected-haskell-aeson-warning-no-explicit-implementation-for-tojson+instance JSON.ToJSON Content where+  toJSON = JSON.genericToJSON JSON.defaultOptions++makeCipher :: ByteString -> IO AES256+makeCipher = throwCryptoErrorIO . cipherInit++-- SJCL uses PBKDF2-HMAC-SHA256 with 1000 iterations, 32 bytes length,+-- but the output is truncated down to 16 bytes.+-- https://github.com/bitwiseshiftleft/sjcl/blob/master/core/pbkdf2.js+-- TODO: this is default, we can specify it explicitly+--       for forward compatibility+makeKey :: ByteString -> ByteString -> ByteString+makeKey pwd slt = BS.take 16 $ PBKDF2.generate (prfHMAC SHA256)+  PBKDF2.Parameters {PBKDF2.iterCounts = 1000, PBKDF2.outputLength = 32}+  pwd slt+++chunks :: Int -> ByteString -> [ByteString]+chunks sz = split+  where split b | cl <= sz = [b'] -- padded+                | otherwise = b1 : split b2+                where cl = BS.length b+                      (b1, b2) = BS.splitAt sz b+                      b' = BS.take sz $ BS.append b (BS.replicate sz 0)++lengthOf :: Int -> Word8+lengthOf = ceiling . (logBase 256 :: Float -> Float) . fromIntegral++-- Ref. https://tools.ietf.org/html/rfc3610+-- SJCL uses 64-bit tag (8 bytes)+encrypt :: String -> ByteString -> IO Content+encrypt password plaintext = do+  ivd    <- getEntropy 16 -- XXX it is truncated to get the nonce below+  slt    <- getEntropy 13 -- arbitrary length+  cipher <- makeCipher $ makeKey (C.pack password) slt+  let tlen = 8 :: Word8+      l = BS.length plaintext+      eL = max 2 (lengthOf l)+      nonce = BS.take (15 - fromIntegral eL) ivd+      b0 = BS.concat [+             BS.pack [8*((tlen-2) `div` 2) + (eL-1)],+             nonce,+             i2ospOf_ (fromIntegral eL) (fromIntegral l)+           ]+      mac = foldl (\ a b -> ecbEncrypt cipher $ BA.xor a b)+                   (ecbEncrypt cipher b0)+                   (chunks (blockSize cipher) plaintext)+      tag = BS.take (fromIntegral tlen) mac+      a0 = BS.concat [+             BS.pack [eL - 1],+             nonce,+             BS.replicate (fromIntegral eL) 0+           ]+      a1iv = ivAdd (fromJust . makeIV $ a0) 1+      ciphtext = BS.append+                  (ctrCombine cipher a1iv plaintext)+                  (BA.xor (ecbEncrypt cipher a0) tag)+  return Content { iv = toWeb ivd, salt = toWeb slt, ct = toWeb ciphtext }+

@@ -0,0 +1,19 @@+module Web.ZeroBin.Utils (+  toWeb+, makePassword+) where++import Crypto.Random.Entropy (getEntropy)+import Data.ByteString (ByteString)+import Data.ByteString.Base64 (encode)+import Data.ByteString.Char8 (unpack)+import Data.Char (isAlphaNum)+++toWeb :: ByteString -> String+toWeb = takeWhile (/= '=') . unpack . encode++makePassword :: Int -> IO String+makePassword n = (map (\c -> if isAlphaNum c then c else 'X')+                  . toWeb) `fmap` getEntropy n+

@@ -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-

@@ -1,91 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module ZeroBin.SJCL (-  Content(..),-  encrypt-) where--import Crypto.Cipher.AES (AES256)-import Crypto.Cipher.Types (ivAdd, blockSize, cipherInit, ecbEncrypt, ctrCombine, makeIV)-import Crypto.Error (throwCryptoErrorIO)-import Crypto.Hash.Algorithms (SHA256(..))-import Crypto.KDF.PBKDF2 (prfHMAC)-import Crypto.Number.Serialize (i2ospOf_)-import Crypto.Random.Entropy (getEntropy)-import Data.ByteString (ByteString)-import Data.Maybe (fromJust)-import Data.Word (Word8)-import GHC.Generics (Generic)-import ZeroBin.Utils (toWeb)-import qualified Crypto.KDF.PBKDF2 as PBKDF2-import qualified Data.Aeson as JSON-import qualified Data.ByteArray as BA-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as C--data Content = Content {-    iv   :: String-  , salt :: String-  , ct   :: String-  } deriving (Generic, Show)---- FIXME: http://stackoverflow.com/questions/33045350/unexpected-haskell-aeson-warning-no-explicit-implementation-for-tojson-instance JSON.ToJSON Content where-  toJSON = JSON.genericToJSON JSON.defaultOptions--makeCipher :: ByteString -> IO AES256-makeCipher = throwCryptoErrorIO . cipherInit---- SJCL uses PBKDF2-HMAC-SHA256 with 1000 iterations, 32 bytes length,--- but the output is truncated down to 16 bytes.--- https://github.com/bitwiseshiftleft/sjcl/blob/master/core/pbkdf2.js--- TODO: this is default, we can specify it explicitly---       for forward compatibility-makeKey :: ByteString -> ByteString -> ByteString-makeKey pwd slt = BS.take 16 $ PBKDF2.generate (prfHMAC SHA256)-  PBKDF2.Parameters {PBKDF2.iterCounts = 1000, PBKDF2.outputLength = 32}-  pwd slt---chunks :: Int -> ByteString -> [ByteString]-chunks sz = split-  where split b | cl <= sz = [b'] -- padded-                | otherwise = b1 : split b2-                where cl = BS.length b-                      (b1, b2) = BS.splitAt sz b-                      b' = BS.take sz $ BS.append b (BS.replicate sz 0)--lengthOf :: Int -> Word8-lengthOf = ceiling . (logBase 256 :: Float -> Float) . fromIntegral---- Ref. https://tools.ietf.org/html/rfc3610--- SJCL uses 64-bit tag (8 bytes)-encrypt :: String -> ByteString -> IO Content-encrypt password plaintext = do-  ivd    <- getEntropy 16 -- XXX it is truncated to get the nonce below-  slt    <- getEntropy 13 -- arbitrary length-  cipher <- makeCipher $ makeKey (C.pack password) slt-  let tlen = 8 :: Word8-      l = BS.length plaintext-      eL = max 2 (lengthOf l)-      nonce = BS.take (15 - fromIntegral eL) ivd-      b0 = BS.concat [-             BS.pack [8*((tlen-2) `div` 2) + (eL-1)],-             nonce,-             i2ospOf_ (fromIntegral eL) (fromIntegral l)-           ]-      mac = foldl (\ a b -> ecbEncrypt cipher $ BA.xor a b)-                   (ecbEncrypt cipher b0)-                   (chunks (blockSize cipher) plaintext)-      tag = BS.take (fromIntegral tlen) mac-      a0 = BS.concat [-             BS.pack [eL - 1],-             nonce,-             BS.replicate (fromIntegral eL) 0-           ]-      a1iv = ivAdd (fromJust . makeIV $ a0) 1-      ciphtext = BS.append-                  (ctrCombine cipher a1iv plaintext)-                  (BA.xor (ecbEncrypt cipher a0) tag)-  return Content { iv = toWeb ivd, salt = toWeb slt, ct = toWeb ciphtext }-

@@ -1,19 +0,0 @@-module ZeroBin.Utils (-  toWeb-, makePassword-) where--import Crypto.Random.Entropy (getEntropy)-import Data.ByteString (ByteString)-import Data.ByteString.Base64 (encode)-import Data.ByteString.Char8 (unpack)-import Data.Char (isAlphaNum)---toWeb :: ByteString -> String-toWeb = takeWhile (/= '=') . unpack . encode--makePassword :: Int -> IO String-makePassword n = (map (\c -> if isAlphaNum c then c else 'X')-                  . toWeb) `fmap` getEntropy n-

@@ -1,5 +1,5 @@ name: zerobin-version: 1.1.1+version: 1.2.0 synopsis: Post to 0bin services description: Post encrypted content to 0bin sites   like http://0bin.net or https://paste.ec@@ -39,9 +39,9 @@       http-conduit      >= 2.1.8,       memory            >= 0.10     exposed-modules:-      ZeroBin,-      ZeroBin.SJCL,-      ZeroBin.Utils+      Web.ZeroBin,+      Web.ZeroBin.SJCL,+      Web.ZeroBin.Utils  executable zerobin     default-language: Haskell2010