Initial commit1.0.0

10 files changed, 454 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..1521c8b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+dist
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..29ed6bf
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2015, Zalora South East Asia Pte. Ltd
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..5e9c9d9
--- /dev/null
+++ b/README.md
@@ -0,0 +1,65 @@
+About
+=====
+This is a library and a command-line utility
+to share secrets via "zerobin" sites like https://paste.ec
+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.
+
+Requirements
+============
+ZeroBin is written in Haskell with [GHC](http://www.haskell.org/ghc/).
+All required Haskell libraries are listed in [zerobin.cabal](zerobin.cabal).
+Use [cabal-install](http://www.haskell.org/haskellwiki/Cabal-Install)
+to fetch and build all pre-requisites automatically.
+
+Installation
+============
+    $ git clone https://github.com/zalora/zerobin.git
+    $ cd zerobin
+    $ cabal install
+
+Command-line utility
+====================
+The command-line utility `zerobin` encrypts text or file,
+post the encrypted data to https://paste.ec and
+prints URI to be shared or error message:
+
+    $ zerobin 'heinrich hertz'
+    https://paste.ec/paste/1j3GBy-7#dg0PXHFglISOhXzRnU4KLWbSAh5jX5KjX4wZEiYM8QA6
+
+
+Type `zerobin --help` to see usage summary:
+
+    Usage:
+      zerobin [options] TEXT
+
+    Options:
+      -e, --expire=E  Set expiration of paste: once, day, week, month [default: week]
+      -f, --file      Paste the content of file TEXT instead of plain TEXT
+
+      -h, --help      Show this message
+
+    Examples:
+      zerobin hello           paste "hello" for a week
+      zerobin -f /etc/fstab   paste file /etc/fstab for a week
+      zerobin -e once hello   paste "hello", it will burn after reading
+
+
+Hacking
+=======
+There is a simple test program in the [./nodejs](./nodejs) directory.
+It uses this library to encrypt a message and original SJCL
+running by [Node.js](https://nodejs.org) to decrypt:
+
+    $ # get nodejs and npm, e. g. on Debian; sudo apt-get install nodejs npm
+    $ npm install sjcl
+    $ git clone https://github.com/zalora/zerobin.git
+    $ cd zerobin
+    $ cabal install --dependencies-only
+    $ cabal install -f nodejs --ghc-option="-Werror"
+    $ ./dist/build/zerobin-nodejs/zerobin-nodejs
+    heinrich hertz
+
+
diff --git a/cli/Main.hs b/cli/Main.hs
new file mode 100644
index 0000000..e32a78f
--- /dev/null
+++ b/cli/Main.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Main where
+
+import Data.Version (showVersion)
+import Paths_zerobin (version) -- from cabal
+import System.Environment (getArgs)
+import System.Exit (exitFailure)
+import System.IO (stderr, hPutStrLn)
+import Text.RawString.QQ (r)
+import ZeroBin (share, Expiration(..), pasteEc)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C
+import qualified System.Console.Docopt.NoTH as O
+
+usage :: String
+usage =  "zerobin " ++ showVersion version
+  ++ " pastes to " ++ pasteEc ++ [r|
+zerobin prints URI to be shared or error message
+
+Usage:
+  zerobin [options] TEXT
+
+Options:
+  -e, --expire=E  Set expiration of paste: once, day, week, month [default: week]
+  -f, --file      Paste the content of file TEXT instead of plain TEXT
+
+  -h, --help      Show this message
+
+Examples:
+  zerobin hello           paste "hello" for a week
+  zerobin -f /etc/fstab   paste file /etc/fstab for a week
+  zerobin -e once hello   paste "hello", it will burn after reading
+|]
+
+
+getExpiration :: String -> Maybe Expiration
+getExpiration e =
+  case e of
+    "once"  -> Just Once
+    "day"   -> Just Day
+    "week"  -> Just Week
+    "month" -> Just Month
+    _       -> Nothing
+
+die :: String -> IO ()
+die msg = do
+  hPutStrLn stderr $ "zerobin: " ++ msg
+  exitFailure
+
+getContent :: Bool -> String -> IO BS.ByteString
+getContent asFile text =
+  if not asFile
+    then return $ C.pack text
+    else BS.readFile text
+
+
+main :: IO ()
+main = do
+  doco <- O.parseUsageOrExit usage
+  args  <- O.parseArgsOrExit doco =<< getArgs
+  if args `O.isPresent` O.longOption "help"
+  then putStrLn $ O.usage doco
+  else do
+    let get = O.getArgOrExitWith doco
+    expire <- args `get` O.longOption "expire"
+    text   <- args `get` O.argument "TEXT"
+    cnt    <- getContent (args `O.isPresent` O.longOption "file") text
+    case getExpiration expire of
+      Nothing  -> die "invalid value for expiration"
+      Just e   -> do
+        rc <- share e cnt
+        case rc of
+          Left err -> die err
+          Right uri -> putStrLn uri
+
diff --git a/nodejs/Main.hs b/nodejs/Main.hs
new file mode 100644
index 0000000..e1acb5d
--- /dev/null
+++ b/nodejs/Main.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import System.Environment (getArgs)
+import System.Process (callProcess)
+import ZeroBin.SJCL (encrypt)
+import ZeroBin.Utils (makePassword)
+import qualified Data.Aeson as JSON
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Lazy as L
+
+-- nodejs is a Debian's thing, others may have simple "node"
+
+getText :: IO BS.ByteString
+getText = do
+  args <- map C.pack `fmap` getArgs
+  if null args
+    then return "heinrich hertz"
+    else return . BS.intercalate " " $ args
+
+main :: IO ()
+main = do
+  password <- makePassword 32
+  text     <- getText
+  cont     <- encrypt password text
+  callProcess "nodejs" [ "nodejs/decrypt.js"
+      , password
+      , C.unpack . L.toStrict $ JSON.encode cont
+    ]
+
diff --git a/nodejs/decrypt.js b/nodejs/decrypt.js
new file mode 100644
index 0000000..1fa3a62
--- /dev/null
+++ b/nodejs/decrypt.js
@@ -0,0 +1,11 @@
+/* npm install sjcl */
+
+var sjcl = require('sjcl')
+
+var args = process.argv.slice(2)
+  ,  pass = args[0]
+  ,  cont = args[1]
+
+var out = sjcl.decrypt(pass, cont)
+console.log(out)
+
diff --git a/src/ZeroBin.hs b/src/ZeroBin.hs
new file mode 100644
index 0000000..d7bfc5c
--- /dev/null
+++ b/src/ZeroBin.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module ZeroBin (
+  Expiration(..),
+  pasteEc,
+  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
+
+pasteEc :: String
+pasteEc = "https://paste.ec"
+
+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
+
+instance Show Expiration where
+  show Once  = "burn_after_reading"
+  show Day   = "1_day"
+  show Week  = "1_week"
+  show Month = "1_month"
+  show Never = "never"
+
+post :: Expiration -> Content -> IO Response
+post ex ct = do
+  req' <- HTTP.parseUrl $ pasteEc ++ "/paste/create"
+  let req = HTTP.urlEncodedBody
+            [ (C.pack "expiration" , C.pack     $ show ex)
+            , (C.pack "content"    , L.toStrict $ JSON.encode ct)
+            ] (req' { HTTP.secure = True })
+  manager <- HTTP.newManager HTTP.tlsManagerSettings
+  response <- HTTP.httpLbs req manager
+  return . fromJust . JSON.decode $ HTTP.responseBody response
+
+share :: Expiration -> ByteString -> IO (Either String String)
+share ex txt = do 
+  pwd  <- makePassword 33
+  c    <- encrypt pwd (encode txt)
+  resp <- post ex c
+  case status resp of
+    "ok" -> return . Right $
+            pasteEc ++ "/paste/" ++ (fromJust . paste) resp ++ "#" ++ pwd
+    _    -> return . Left $
+            (fromJust . message) resp
+
diff --git a/src/ZeroBin/SJCL.hs b/src/ZeroBin/SJCL.hs
new file mode 100644
index 0000000..b121546
--- /dev/null
+++ b/src/ZeroBin/SJCL.hs
@@ -0,0 +1,91 @@
+{-# 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 = C.append
+                  (ctrCombine cipher a1iv plaintext)
+                  (BA.xor (ecbEncrypt cipher a0) tag)
+  return Content { iv = toWeb ivd, salt = toWeb slt, ct = toWeb ciphtext }
+
diff --git a/src/ZeroBin/Utils.hs b/src/ZeroBin/Utils.hs
new file mode 100644
index 0000000..34871d2
--- /dev/null
+++ b/src/ZeroBin/Utils.hs
@@ -0,0 +1,19 @@
+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
+
diff --git a/zerobin.cabal b/zerobin.cabal
new file mode 100644
index 0000000..e9174b7
--- /dev/null
+++ b/zerobin.cabal
@@ -0,0 +1,74 @@
+name: zerobin
+version: 1.0.0
+synopsis: Post to paste.ec
+description:
+license: MIT
+license-file: LICENSE
+author: Igor Pashev
+maintainer: Igor Pashev <pashev.igor@gmail.com>
+copyright: 2015, Zalora South East Asia Pte. Ltd
+category: Cryptography, Web
+build-type: Simple
+extra-source-files: README.md
+cabal-version: >= 1.20
+
+source-repository head
+  type: git
+  location: https://github.com/zalora/zerobin.git
+
+flag nodejs
+    description: Build a test program for decrypting with Node.js and SJCL.
+                 You need Node.js and SJCL installed (via NPM for example)
+    default: False
+
+flag cli
+    description: Build a command-line utility. You can use it in shell scripts
+    default: True
+
+library
+    default-language: Haskell2010
+    ghc-options: -Wall
+    hs-source-dirs: src
+    build-depends:
+      aeson             >= 0.10,
+      base              >= 4.7,
+      base64-bytestring >= 1.0,
+      bytestring        >= 0.10.6.0,
+      cryptonite        >= 0.8,
+      http-conduit      >= 2.1.8,
+      memory            >= 0.10
+    exposed-modules:
+      ZeroBin,
+      ZeroBin.SJCL,
+      ZeroBin.Utils
+
+executable zerobin
+    default-language: Haskell2010
+    ghc-options: -Wall -static
+    hs-source-dirs: cli
+    main-is: Main.hs
+    if flag(cli)
+      build-depends:
+        base           >= 4.7,
+        bytestring     >= 0.10.6.0,
+        docopt         >= 0.7.0.4,
+        zerobin,
+        raw-strings-qq >= 1.0.2
+    else
+      buildable: False
+
+executable zerobin-nodejs
+    default-language: Haskell2010
+    ghc-options: -Wall
+    hs-source-dirs: nodejs
+    main-is: Main.hs
+    if flag(nodejs)
+      build-depends:
+        aeson      >= 0.10,
+        base       >= 4.7,
+        bytestring >= 0.10.6.0,
+        zerobin,
+        process    >= 1.3.0.0
+    else
+      buildable: False
+