aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Web/ZeroBin.hs77
-rw-r--r--src/Web/ZeroBin/SJCL.hs93
-rw-r--r--src/Web/ZeroBin/Utils.hs20
3 files changed, 99 insertions, 91 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
-
diff --git a/src/Web/ZeroBin/SJCL.hs b/src/Web/ZeroBin/SJCL.hs
index a27ecb7..c4bc86e 100644
--- a/src/Web/ZeroBin/SJCL.hs
+++ b/src/Web/ZeroBin/SJCL.hs
@@ -6,37 +6,37 @@ Encryption compatible with <https://crypto.stanford.edu/sjcl/ SJCL>
>>> encrypt "secret-word" (pack "hello")
Content {iv = "VxyuJRVtKJqhG2iR/sPjAQ", salt = "AhnDuP1CkTCBlQTHgw", ct = "cqr7/pMRXrcROmcgwA"}
-}
-
{-# LANGUAGE DeriveGeneric #-}
-module Web.ZeroBin.SJCL (
- Content(..),
- encrypt
-) where
+module Web.ZeroBin.SJCL
+ ( Content(..)
+ , encrypt
+ ) where
import Crypto.Cipher.AES (AES128)
-import Crypto.Cipher.Types (ivAdd, blockSize, cipherInit, ecbEncrypt, ctrCombine, makeIV)
+import Crypto.Cipher.Types
+ (blockSize, cipherInit, ctrCombine, ecbEncrypt, ivAdd, makeIV)
import Crypto.Error (throwCryptoErrorIO)
import Crypto.Hash.Algorithms (SHA256(..))
import Crypto.KDF.PBKDF2 (prfHMAC)
+import qualified Crypto.KDF.PBKDF2 as PBKDF2
import Crypto.Number.Serialize (i2ospOf_)
import Crypto.Random.Entropy (getEntropy)
+import qualified Data.Aeson as JSON
+import qualified Data.ByteArray as BA
import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C
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
-- | Encrypted content. Each field is a 'toWeb'-encoded byte-string
-data Content = Content {
- iv :: String -- ^ random initialization vector (IV)
+data Content = Content
+ { iv :: String -- ^ random initialization vector (IV)
, salt :: String -- ^ random salt
- , ct :: String -- ^ encrypted data
+ , ct :: String -- ^ encrypted data
} deriving (Generic, Show)
-- FIXME: http://stackoverflow.com/questions/33045350/unexpected-haskell-aeson-warning-no-explicit-implementation-for-tojson
@@ -49,16 +49,21 @@ makeCipher = throwCryptoErrorIO . cipherInit
-- 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 = PBKDF2.generate (prfHMAC SHA256)
- PBKDF2.Parameters {PBKDF2.iterCounts = 1000, PBKDF2.outputLength = 16}
+makeKey =
+ PBKDF2.generate
+ (prfHMAC SHA256)
+ PBKDF2.Parameters {PBKDF2.iterCounts = 1000, PBKDF2.outputLength = 16}
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)
+ 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
@@ -67,34 +72,34 @@ lengthOf = ceiling . (logBase 256 :: Float -> Float) . fromIntegral
-- Follows <https://tools.ietf.org/html/rfc3610 RFC3610> with a 8-bytes tag.
-- Uses 16-bytes cipher key generated from the password and a random 'salt'
-- by PBKDF2-HMAC-SHA256 with 1000 iterations.
-encrypt :: String -- ^ the password
- -> ByteString -- ^ the plain data to encrypt
- -> IO Content
+encrypt ::
+ String -- ^ the password
+ -> ByteString -- ^ the plain data to encrypt
+ -> IO Content
encrypt password plaintext = do
- ivd <- getEntropy 16 -- XXX it is truncated to get the nonce below
- slt <- getEntropy 13 -- arbitrary length
+ 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)
+ 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
- ]
+ 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 }
-
+ ciphtext =
+ BS.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/Web/ZeroBin/Utils.hs b/src/Web/ZeroBin/Utils.hs
index 559d9ec..70068aa 100644
--- a/src/Web/ZeroBin/Utils.hs
+++ b/src/Web/ZeroBin/Utils.hs
@@ -1,11 +1,10 @@
{-|
Various utility functions
-}
-
-module Web.ZeroBin.Utils (
- toWeb
-, makePassword
-) where
+module Web.ZeroBin.Utils
+ ( toWeb
+ , makePassword
+ ) where
import Crypto.Random.Entropy (getEntropy)
import Data.ByteString (ByteString)
@@ -13,12 +12,13 @@ import Data.ByteString.Base64 (encode)
import Data.ByteString.Char8 (unpack)
-- | Encodes to base64 and drops padding '='.
-toWeb :: ByteString -- ^ the data to encode
- -> String -- ^ base64 string without padding
+toWeb ::
+ ByteString -- ^ the data to encode
+ -> String -- ^ base64 string without padding
toWeb = takeWhile (/= '=') . unpack . encode
-- | Makes a random password
-makePassword :: Int -- ^ the number of bytes of entropy
- -> IO String -- ^ random byte-string encoded by 'toWeb'
+makePassword ::
+ Int -- ^ the number of bytes of entropy
+ -> IO String -- ^ random byte-string encoded by 'toWeb'
makePassword n = toWeb `fmap` getEntropy n
-