From a720f410c3ff821e0f847885bad7233a0dc23355 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Tue, 21 Mar 2017 01:47:36 +0000 Subject: [PATCH] Add haddocks --- README.md | 70 ++++++++++++++++++++++ cli/FernetMain.hs | 4 +- src/Network/Fernet.hs | 112 ++++++++++++++++++++++++++++++------ src/Network/Fernet/Key.hs | 35 +++++++---- src/Network/Fernet/Token.hs | 26 ++++++++- 5 files changed, 214 insertions(+), 33 deletions(-) diff --git a/README.md b/README.md index 327e45e..646fa37 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,76 @@ *Fernet* generates and verifies HMAC-based authentication tokens. +Originally designed for use within OpenStack clusters, it was intended +to be fast and light-weight, with non-persistent tokens. Integrity and +confidentiality of the token contents are implemented with HMAC SHA256 +and AES128 CBC. + See the [Fernet Spec][spec] for a little more information. [spec]: https://github.com/fernet/spec/blob/master/Spec.md + +## Usage + +To encrypt a token: + + >>> import Network.Fernet + >>> k <- generateKey + >>> keyToBase64 k + "JQAeL3iFN9wIW_hMKiIzA1EiG_EZNivnMPBOOJn2wZc=" + >>> token <- encrypt k "secret text" + >>> print token + "gAAAAABY0H9kx7ihkcj6ZF_bQ73Lvc7aG-ZlEtjx24io-DQy5tCjLbq1JvVY27uAe6BuwG8css-4LDIywOJRyY_zetq7aLPPag==" + +The resulting token can be distributed to clients. To check and +decrypt the token, use the same key: + + >>> decrypt k 60 token + Right "secret text" + +Do read the [Network.Fernet module][haddock] documentation for further +information. + +[haddock]: http://hackage.haskell.org/package/fernet/docs/Network-Fernet.html + + +## Command-line tool + +This package also includes a command-line tool for encrypting and +decrypting tokens. + + Fernet Utility + + Usage: fernet (((-k|--key STRING) | --key-file FILENAME) ([-e|--encrypt] | + [-d|--decrypt]) [--ttl SECONDS] | (-g|--gen-key)) + Encrypts/decrypts Fernet tokens. One token written to stdout for each line + read from stdin. Use --gen-key to make a key. + + Available options: + -h,--help Show this help text + -k,--key STRING Base64-urlsafe-encoded 32 byte encryption key + --key-file FILENAME File containing the encryption key + -e,--encrypt Encryption mode (default: autodetect) + -d,--decrypt Decryption mode (default: autodetect) + --ttl SECONDS Token lifetime in seconds (default: 1 minute) + -g,--gen-key Generate a key from the password on standard input + +## Development + +### Building with Stack + +``` +stack build +``` + +### Building with Nix + +``` +nix-shell -p cabal2nix --command "cabal2nix --shell . > default.nix" +nix-shell --command "cabal configure" +cabal build +``` + +## Better & Cooler Stuff + +You might also be interested in [hsoz](https://github.com/rvl/hsoz). diff --git a/cli/FernetMain.hs b/cli/FernetMain.hs index 662e06e..3996765 100644 --- a/cli/FernetMain.hs +++ b/cli/FernetMain.hs @@ -71,7 +71,7 @@ main = join . execParser $ genKey :: Bool -> IO () genKey _ = do password <- askPassword - k <- generateKeyFromPassword iterations password + (k, _) <- generateKeyFromPassword iterations password S8.hPutStrLn stdout (keyToBase64 k) askPassword :: IO ByteString @@ -127,7 +127,7 @@ readKeys (KeyText k) = keyFromString k readKeys (KeyFile f) = readFirstLine f >>= \k -> readKeys (KeyText k) readPassword :: Password -> IO Key -readPassword (PasswordText p) = generateKeyFromPassword iterations (S8.pack p) +readPassword (PasswordText p) = fst <$> generateKeyFromPassword iterations (S8.pack p) readPassword (PasswordFile f) = readFirstLine f >>= \p -> readPassword (PasswordText p) iterations = 100000 :: Int diff --git a/src/Network/Fernet.hs b/src/Network/Fernet.hs index 5fb71b3..d43d385 100644 --- a/src/Network/Fernet.hs +++ b/src/Network/Fernet.hs @@ -1,14 +1,56 @@ +-- | /Fernet/ generates and verifies HMAC-based authentication tokens. +-- +-- Originally designed for use within OpenStack clusters, it was +-- intended to be fast and light-weight, with non-persistent +-- tokens. Integrity and confidentiality of the token contents are +-- implemented with HMAC SHA256 and AES128 CBC. +-- +-- See the +-- for a little more information. +-- +-- == Usage +-- To encrypt a token: +-- +-- >>> import Network.Fernet +-- >>> k <- generateKey +-- >>> keyToBase64 k +-- "JQAeL3iFN9wIW_hMKiIzA1EiG_EZNivnMPBOOJn2wZc=" +-- >>> token <- encrypt k "secret text" +-- >>> print token +-- "gAAAAABY0H9kx7ihkcj6ZF_bQ73Lvc7aG-ZlEtjx24io-DQy5tCjLbq1JvVY27uAe6BuwG8css-4LDIywOJRyY_zetq7aLPPag==" +-- +-- The resulting token can be distributed to clients. To check and +-- decrypt the token, use the same key: +-- +-- >>> decrypt k 60 token +-- Right "secret text" +-- +-- When decrypting, a TTL value is supplied to determine whether the +-- token has expired. The timestamp is stored in plain text and can +-- also be checked with 'hasExpired'. +-- +-- == Related Modules +-- +-- * "Network.Iron" +-- * "Jose.Jwt" + module Network.Fernet - ( encrypt + ( -- * Tokens + encrypt , decrypt , encrypt' , decrypt' + , DecryptError(..) + , isExpired + , hasExpired + -- * Keys , Key , key , generateKey , generateKeyFromPassword , keyFromBase64 , keyToBase64 + -- * Other , version ) where @@ -26,27 +68,43 @@ import Network.Fernet.Crypto import Network.Fernet.Key import Network.Fernet.Token +-- | @0x80@ is the latest token format version, and the only one +-- supported by this library. version :: Word8 version = 0x80 ---------------------------------------------------------------------------- -- Encryption -encrypt :: Key -> ByteString -> IO ByteString -encrypt key text = do +-- | Encrypts, encodes, and signs the given token contents with the +-- given key. +-- +-- Its timestamp is set to the current time and stored /unencrypted/ +-- in the token. +encrypt :: Key -- ^ The encryption and signing keys. + -> ByteString -- ^ Token contents. + -> IO ByteString -- ^ An encoded /Fernet/ token. +encrypt k text = do ts <- getPOSIXTime iv <- genIV - return $ encrypt' key ts iv text - -encrypt' :: Key -- ^ Keys + return $ encrypt' k ts iv text + +-- | Encrypts, encodes, and signs the given token contents with the +-- given key. +-- +-- The provided timestamp is stored /unencrypted/ in the token. +-- +-- The given IV (initialization vector) string should be a random +-- sequence of exactly 128 bits. +encrypt' :: Key -- ^ The encryption and signing keys. -> POSIXTime -- ^ Timestamp - -> ByteString -- ^ Initialization Vector - -> ByteString -- ^ Plain text - -> ByteString + -> ByteString -- ^ Initialization Vector. + -> ByteString -- ^ Token contents. + -> ByteString -- ^ An encoded /Fernet/ token. encrypt' Key{..} ts iv text = case serialize <$> makeToken encryptionKey ts iv text of Just token -> encode token (sign signingKey token) - Nothing -> "" -- this shouldn't happen + Nothing -> "" -- this shouldn't happen, unless iv is wrong makeToken :: ScrubbedBytes -- ^ Keys -> POSIXTime -- ^ Timestamp @@ -59,6 +117,7 @@ makeToken k ts iv text = TokenFields version ts iv <$> ct ---------------------------------------------------------------------------- -- Decryption +-- | Some of the reasons why decryption can fail. data DecryptError = TokenMalformed -- ^ The token could not be decoded into fields. | TokenInvalid -- ^ Signature verification failed. | TokenExpired -- ^ Token age exceeded given TTL value. @@ -68,12 +127,27 @@ data DecryptError = TokenMalformed -- ^ The token could not be decoded into | UnsupportedVersion -- ^ The version was not 0x80. deriving (Show, Eq) -decrypt :: Key -> NominalDiffTime -> ByteString -> IO (Either DecryptError ByteString) -decrypt key ttl t = do +-- | Decodes, checks, and decrypts, the given /Fernet/ token. +-- +-- If the token's age (determined by its timestamp) exceeds the given +-- TTL, then this function will fail. +decrypt :: Key -- ^ The encryption and signing keys. + -> NominalDiffTime -- ^ Token TTL. + -> ByteString -- ^ The encoded token. + -> IO (Either DecryptError ByteString) -- ^ Token contents, or an error. +decrypt k ttl t = do now <- getPOSIXTime - return $ decrypt' key ttl now t - -decrypt' :: Key -> NominalDiffTime -> POSIXTime -> ByteString -> Either DecryptError ByteString + return $ decrypt' k ttl now t + +-- | Decodes, checks, and decrypts, the given /Fernet/ token. +-- +-- If the token's age (determined by its timestamp) exceeds the given +-- TTL, then this function will fail. +decrypt' :: Key -- ^ The encryption and signing keys. + -> NominalDiffTime -- ^ Token TTL. + -> POSIXTime -- ^ The current time, used to determine token age. + -> ByteString -- ^ The encoded token. + -> Either DecryptError ByteString -- ^ Token contents, or an error. decrypt' Key{..} ttl now t = do (fields, tb, sig) <- first (const TokenMalformed) (decode t) checkVersion fields @@ -84,7 +158,7 @@ decrypt' Key{..} ttl now t = do case aesDecrypt encryptionKey (tfIV fields) (tfCiphertext fields) of Just text -> Right text Nothing -> Left KeySizeInvalid - + checkVersion :: TokenFields -> Either DecryptError () checkVersion tf | tfVersion tf == version = Right () | otherwise = Left UnsupportedVersion @@ -96,10 +170,10 @@ maxClockSkew = 60 checkTimestamp :: POSIXTime -> TokenFields -> Either DecryptError () checkTimestamp now TokenFields{..} | tfTimestamp - now <= maxClockSkew = Right () | otherwise = Left UnacceptableClockSkew - + checkExpiry :: NominalDiffTime -> POSIXTime -> TokenFields -> Either DecryptError () -checkExpiry ttl now TokenFields{..} | now - tfTimestamp < ttl = Right () - | otherwise = Left TokenExpired +checkExpiry ttl now tf | hasExpired' ttl now tf = Right () + | otherwise = Left TokenExpired checkSignature :: ScrubbedBytes -> ByteString -> ByteString -> Either DecryptError () checkSignature k tf sig | constEqBytes sig (sign k tf) = Right () diff --git a/src/Network/Fernet/Key.hs b/src/Network/Fernet/Key.hs index 5f489e9..a6646da 100644 --- a/src/Network/Fernet/Key.hs +++ b/src/Network/Fernet/Key.hs @@ -19,13 +19,15 @@ import Crypto.Random (getRandomBytes) import Network.Fernet.Base64 --- | Contains the signing key and encryption key. Create a 'Key' with 'key'. +-- | Contains the signing key and encryption key. Create one with +-- 'key', 'keyFromBase64', or 'generateKeyFromPassword'. data Key = Key { signingKey :: ScrubbedBytes , encryptionKey :: ScrubbedBytes } deriving (Show, Eq) --- | Constructs a pair of signing and encryption keys. +-- | Constructs a pair of signing and encryption keys. Each key must +-- be exactly 16 bytes long or this will fail. key :: ByteArrayAccess a => a -- ^ Signing Key -> a -- ^ Encryption Key @@ -46,31 +48,42 @@ checkCipherKeyLength = (== cipherKeyLength) checkHashKeyLength :: Int -> Bool checkHashKeyLength = (>= 16) -generateKey :: IO ByteString -generateKey = b64url <$> generateKeyBytes +-- | Generates new keys from the PRNG. +generateKey :: IO Key +generateKey = splitKeys <$> getRandomBytes (cipherKeyLength * 2) -generateKeyBytes :: IO ByteString -generateKeyBytes = getRandomBytes cipherKeyLength +-- | Input must be exactly length 32 chars +splitKeys :: ByteString -> Key +splitKeys = make . BS.splitAt cipherKeyLength + where make (s, e) = Key (BA.convert s) (BA.convert e) genSalt :: IO ByteString genSalt = getRandomBytes 16 -keyToBase64 :: Key -> ByteString +-- | Encodes the given key as urlsafe base64. +keyToBase64 :: Key -> ByteString -- ^ URL-safe base64. keyToBase64 (Key s e) = b64url $ s <> e -keyFromBase64 :: ByteString -> Either String Key +-- | Decodes urlsafe base64-encoded bytes into a key. This will fail +-- if the input is not exactly 256 bits long (43 characters in +-- base64). +keyFromBase64 :: ByteString -- ^ URL-safe base64. + -> Either String Key keyFromBase64 = (>>= make) . b64urldec where make s = case key sk ek of Just k -> Right k Nothing -> Left "Invalid key length" where (sk, ek) = BS.splitAt ((BS.length s) - 16) s -generateKeyFromPassword :: Byteable p => Int -> p -> IO Key +-- | Stretches the given password into a 'Key' using PBKDF2. +generateKeyFromPassword :: Byteable p + => Int -- ^ Number of key derivation function iterations. + -> p -- ^ The password. + -> IO (Key, ByteString) -- ^ The key and random salt used. generateKeyFromPassword iterations p = do salt <- genSalt let keys = PBKDF2.generate prf params (toBytes p) salt - (sk, ek) = BS.splitAt 16 keys - return $ Key (BA.convert sk) (BA.convert ek) + return (splitKeys keys, salt) where prf = PBKDF2.prfHMAC SHA256 params = PBKDF2.Parameters iterations 32 diff --git a/src/Network/Fernet/Token.hs b/src/Network/Fernet/Token.hs index 05ce1d0..52f6138 100644 --- a/src/Network/Fernet/Token.hs +++ b/src/Network/Fernet/Token.hs @@ -3,6 +3,9 @@ module Network.Fernet.Token , decode , serialize , deserialize + , isExpired + , hasExpired + , hasExpired' , TokenFields(..) , Signature ) where @@ -12,7 +15,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Data.Word (Word8) -import Data.Time.Clock.POSIX (POSIXTime) +import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) +import Data.Time.Clock (NominalDiffTime) import Data.Binary.Get import Data.Binary.Put @@ -62,3 +66,23 @@ deserialize t = case runGetOrFail get (BL.fromStrict t) of iv <- getByteString 16 ct <- BL.toStrict <$> getRemainingLazyByteString return $! TokenFields v (fromIntegral ts) iv ct + +-- | Returns @Right True@ if the token has expired, +-- @Left _@ if the token could not be parsed. +hasExpired :: NominalDiffTime -- ^ TTL value. + -> ByteString -- ^ Encoded token. + -> IO (Either String Bool) +hasExpired ttl token = isExpired ttl token <$> getPOSIXTime + +-- | Returns @Right True@ if the token is expired at the given time, +-- @Left _@ if the token could not be parsed. +isExpired :: NominalDiffTime -- ^ TTL value. + -> ByteString -- ^ Encoded token. + -> POSIXTime -- ^ The time to consider. + -> Either String Bool +isExpired ttl token now = do + (tf, _, _) <- decode token + return $ hasExpired' ttl now tf + +hasExpired' :: NominalDiffTime -> POSIXTime -> TokenFields -> Bool +hasExpired' ttl now TokenFields{..} = now - tfTimestamp < ttl