Add haddocks

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).

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

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 <https://github.com/fernet/spec/blob/master/Spec.md Fernet Spec>
+-- 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 ()

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

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