fernet (empty) → 0.1.0.0
raw patch · 13 files changed
+1046/−0 lines, 13 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HUnit, QuickCheck, aeson, base, binary, byteable, bytestring, cryptonite, fernet, memory, optparse-applicative, tasty, tasty-golden, tasty-hunit, tasty-quickcheck, time, unix
Files
- ChangeLog.md +5/−0
- LICENSE +165/−0
- README.md +79/−0
- Setup.hs +2/−0
- cli/FernetMain.hs +146/−0
- fernet.cabal +88/−0
- src/Network/Fernet.hs +184/−0
- src/Network/Fernet/Base64.hs +41/−0
- src/Network/Fernet/Crypto.hs +59/−0
- src/Network/Fernet/Key.hs +89/−0
- src/Network/Fernet/Token.hs +87/−0
- test/Main.hs +10/−0
- test/Network/Fernet/Tests.hs +91/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for fernet++## 0.1.0.0 -- 2017-03-22++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions.++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version.++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ README.md view
@@ -0,0 +1,79 @@+# Fernet Haskell Implementation++[](https://travis-ci.org/rvl/fernet-hs) [](http://hackage.haskell.org/package/fernet)++*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).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cli/FernetMain.hs view
@@ -0,0 +1,146 @@+module Main where++import Options.Applicative+import Data.Monoid ((<>))+import Control.Monad (join, unless, when)+import Data.Time.Clock (NominalDiffTime)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.ByteArray.Encoding as B (Base(..), convertFromBase)+import Text.Read (readEither)+import System.IO+import Data.Bifunctor (first)+import System.Posix.IO (handleToFd, stdInput)+import System.Posix.Terminal (queryTerminal)++import Network.Fernet++main :: IO ()+main = join . execParser $+ info (helper <*> parser)+ ( fullDesc+ <> header "Fernet Utility"+ <> progDesc (+ "Encrypts/decrypts Fernet tokens. " +++ "One token written to stdout for each line read from stdin. " +++ "Use --gen-key to make a key."+ ))+ where+ parser :: Parser (IO ())+ parser =+ (fernet+ <$> (KeyText <$> ( strOption+ ( long "key"+ <> short 'k'+ <> metavar "STRING"+ <> help "Base64-urlsafe-encoded 32 byte encryption key"+ )) <|>+ KeyFile <$> ( strOption+ ( long "key-file"+ <> metavar "FILENAME"+ <> help "File containing the encryption key"+ )+ ))+ <*> ( optional+ ( flag' Encrypt+ ( long "encrypt"+ <> short 'e'+ <> help "Encryption mode (default: autodetect)" )+ <|>+ flag' Decrypt+ ( long "decrypt"+ <> short 'd'+ <> help "Decryption mode (default: autodetect)" )+ )+ )+ <*> option ttl+ ( long "ttl"+ <> metavar "SECONDS"+ <> help "Token lifetime in seconds (default: 1 minute)"+ <> value 60+ )) <|>+ (genKey <$> ( flag' True+ (long "gen-key"+ <> short 'g'+ <> help "Generate a key from the password on standard input"+ )))++genKey :: Bool -> IO ()+genKey _ = do+ password <- askPassword+ (k, _) <- generateKeyFromPassword iterations password+ S8.hPutStrLn stdout (keyToBase64 k)++askPassword :: IO ByteString+askPassword = do+ isatty <- queryTerminal stdInput+ when isatty $ do+ hSetEcho stdin False+ S8.hPutStr stderr "Enter password: "+ hFlush stdout+ password <- S8.hGetLine stdin+ when isatty $ do+ hSetEcho stdin True+ S8.hPut stderr "\n"+ return password++ttl :: ReadM NominalDiffTime+ttl = eitherReader (fmap fromInteger . readEither)++data Action = Encrypt | Decrypt+data Keys = KeyText String | KeyFile FilePath+data Password = PasswordText String | PasswordFile FilePath++fernet :: Keys -> Maybe Action -> NominalDiffTime -> IO ()+fernet ks ax ttl = do+ k <- readKeys ks+ L8.hGetContents stdin >>= mapM_ (processLine k ax ttl) . L8.lines++processLine :: Key -> Maybe Action -> NominalDiffTime -> L8.ByteString -> IO ()+processLine k ax ttl s = doLine k ax ttl s >>= uncurry L8.hPutStrLn . output++output :: Either String ByteString -> (Handle, L8.ByteString)+output (Left e) = (stderr, L8.pack e)+output (Right s) = (stdout, L8.fromStrict s)++doLine :: Key -> Maybe Action -> NominalDiffTime -> L8.ByteString -> IO (Either String ByteString)+doLine k (Just Encrypt) _ s = lineEncrypt k s+doLine k (Just Decrypt) ttl s = lineDecrypt k ttl s+doLine k Nothing ttl s = doLine k (Just $ sniff s) ttl s++sniff :: BL.ByteString -> Action+sniff s | ver >= "gA" && ver <= "gP" = Decrypt+ | otherwise = Encrypt+ where ver = BL.take 2 s++lineEncrypt :: Key -> L8.ByteString -> IO (Either String ByteString)+lineEncrypt k s = Right <$> encrypt k (L8.toStrict s)++lineDecrypt :: Key -> NominalDiffTime -> L8.ByteString -> IO (Either String ByteString)+lineDecrypt k ttl s = first show <$> decrypt k ttl (L8.toStrict s)++readKeys :: Keys -> IO Key+readKeys (KeyText k) = keyFromString k+readKeys (KeyFile f) = readFirstLine f >>= \k -> readKeys (KeyText k)++readPassword :: Password -> IO Key+readPassword (PasswordText p) = fst <$> generateKeyFromPassword iterations (S8.pack p)+readPassword (PasswordFile f) = readFirstLine f >>= \p -> readPassword (PasswordText p)++iterations = 100000 :: Int++readFirstLine :: FilePath -> IO String+readFirstLine f = withFile f ReadMode hGetLine++keyFromString :: String -> IO Key+keyFromString s = case keyFromBase64 (S8.pack s) of+ Right k -> return k+ Left e -> fail e++-- | Converts 'Maybe' to 'Either'.+justRight :: e -> Maybe a -> Either e a+justRight _ (Just a) = Right a+justRight e Nothing = Left e
+ fernet.cabal view
@@ -0,0 +1,88 @@+name: fernet+version: 0.1.0.0+synopsis: Generate and verify HMAC-based authentication tokens.+description: Originally designed for use within OpenStack clusters,+ /Fernet/ is intended to be fast and light-weight, with+ non-persistent tokens. Fernet tokens are signed with a+ SHA256 HMAC and their contents encrypted with AES128+ in CBC mode.+homepage: https://github.com/rvl/fernet-hs+license: LGPL-3+license-file: LICENSE+author: Rodney Lorrimar+maintainer: dev@rodney.id.au+copyright: 2017 Rodney Lorrimar+category: Web, Authentication+build-type: Simple+extra-source-files: README.md, ChangeLog.md+cabal-version: >=1.10+stability: experimental+bug-reports: https://github.com/rvl/fernet/issues++flag cli+ description: Build the example application+ default: True++library+ exposed-modules: Network.Fernet+ other-modules: Network.Fernet.Base64+ , Network.Fernet.Crypto+ , Network.Fernet.Key+ , Network.Fernet.Token+ build-depends: base >=4.9 && <4.10+ , binary >= 0.8.3.0 && < 0.10+ , byteable >= 0.1.1 && < 0.2+ , bytestring >= 0.10.8 && < 0.11+ , cryptonite >= 0.21 && < 0.23+ , memory >= 0.14.1 && < 0.15+ , time >= 1.6.0 && < 1.7+ hs-source-dirs: src+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ , RecordWildCards++executable fernet+ if flag(cli)+ buildable: True+ else+ buildable: False++ hs-source-dirs: cli+ main-is: FernetMain.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , fernet+ , bytestring+ , optparse-applicative >= 0.12 && < 0.15+ , memory+ , time+ , unix >= 2.7.2.1 && < 2.8+ default-language: Haskell2010+ default-extensions: OverloadedStrings+++test-suite fernet-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules: Network.Fernet.Tests+ build-depends: HUnit+ , QuickCheck+ , aeson >= 1.0.2 && < 1.1+ , base+ , bytestring+ , fernet+ , memory >= 0.14.1+ , tasty+ , tasty-golden+ , tasty-hunit+ , tasty-quickcheck+ , time+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ , RecordWildCards++source-repository head+ type: git+ location: https://github.com/rvl/fernet-hs
+ src/Network/Fernet.hs view
@@ -0,0 +1,184 @@+-- | /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+ ( -- * Tokens+ encrypt+ , decrypt+ , encrypt'+ , decrypt'+ , DecryptError(..)+ , isExpired+ , hasExpired+ -- * Keys+ , Key+ , key+ , generateKey+ , generateKeyFromPassword+ , keyFromBase64+ , keyToBase64+ -- * Other+ , version+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteArray (ScrubbedBytes)+import Data.Byteable (constEqBytes)+import Data.Word (Word8)+import Data.Time.Clock (NominalDiffTime)+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)+import Data.Bifunctor (first)++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++-- | 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' 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 -- ^ 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, unless iv is wrong++makeToken :: ScrubbedBytes -- ^ Keys+ -> POSIXTime -- ^ Timestamp+ -> ByteString -- ^ Initialization Vector+ -> ByteString -- ^ Plain text+ -> Maybe TokenFields+makeToken k ts iv text = TokenFields version ts iv <$> ct+ where ct = aesEncrypt k iv text++----------------------------------------------------------------------------+-- 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.+ | UnacceptableClockSkew -- ^ Token timestamp is too far in the future.+ | KeySizeInvalid -- ^ The key was not suitable for decryption.+ | InvalidBlockSize -- ^ The ciphertext length was not a multiple of the block size.+ | UnsupportedVersion -- ^ The version was not 0x80.+ deriving (Show, Eq)++-- | 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' 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+ checkTimestamp now fields+ checkExpiry ttl now fields+ checkSignature signingKey tb sig+ checkInputSize fields+ case aesDecrypt encryptionKey (tokenIV fields) (tokenCiphertext fields) of+ Just text -> Right text+ Nothing -> Left KeySizeInvalid++checkVersion :: TokenFields -> Either DecryptError ()+checkVersion tf | tokenVersion tf == version = Right ()+ | otherwise = Left UnsupportedVersion++-- | Maximum clock skew in the future direction.+maxClockSkew :: NominalDiffTime+maxClockSkew = 60++checkTimestamp :: POSIXTime -> TokenFields -> Either DecryptError ()+checkTimestamp now TokenFields{..} | tokenTimestamp - now <= maxClockSkew = Right ()+ | otherwise = Left UnacceptableClockSkew++checkExpiry :: NominalDiffTime -> POSIXTime -> TokenFields -> Either DecryptError ()+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 ()+ | otherwise = Left TokenInvalid++checkInputSize :: TokenFields -> Either DecryptError ()+checkInputSize tf | isBlocked (tokenCiphertext tf) = Right ()+ | otherwise = Left InvalidBlockSize+ where isBlocked t = BS.length t `mod` cipherBlockSize == 0
+ src/Network/Fernet/Base64.hs view
@@ -0,0 +1,41 @@+-- | Base64 utilities++module Network.Fernet.Base64 (+ -- * Base64+ b64+ , b64dec+ , b64url+ , b64urldec+ ) where++import Data.Monoid ((<>))+import qualified Data.ByteString.Char8 as S8+import Data.ByteArray (ByteArrayAccess)+import qualified Data.ByteArray.Encoding as B (Base (..), convertToBase, convertFromBase)+import Data.ByteString (ByteString)++-- | Shorthand for encode in Base64.+b64 :: ByteArrayAccess a => a -> ByteString+b64 = B.convertToBase B.Base64++b64url :: ByteArrayAccess a => a -> ByteString+b64url = urlSafeBase64 . b64++b64dec :: ByteArrayAccess a => a -> Either String ByteString+b64dec = B.convertFromBase B.Base64++b64urldec :: ByteString -> Either String ByteString+b64urldec = b64dec . unUrlSafeBase64++-- | Fixes up a Base64 encoded string so that it's more convenient to+-- include in URLs.+-- The characters @+@ and @/@ are replaced with @-@ and @_@.+urlSafeBase64 :: ByteString -> ByteString+urlSafeBase64 = S8.map (tr '+' '-' . tr '/' '_')++-- | The inverse of 'urlSafeBase64'.+unUrlSafeBase64 :: ByteString -> ByteString+unUrlSafeBase64 = S8.map (tr '-' '+' . tr '_' '/')++tr :: Char -> Char -> Char -> Char+tr a b c = if c == a then b else c
+ src/Network/Fernet/Crypto.hs view
@@ -0,0 +1,59 @@+module Network.Fernet.Crypto+ ( sign+ , aesEncrypt+ , aesDecrypt+ , genIV+ , cipherBlockSize+ ) where++import Data.ByteString (ByteString)+import Data.ByteArray (ByteArray, ByteArrayAccess, convert)++import Crypto.Data.Padding (Format(PKCS7), pad, unpad)+import Crypto.Hash.Algorithms (SHA256 (..))+import Crypto.Cipher.AES (AES128)+import Crypto.MAC.HMAC (HMAC(..), hmac, hmacGetDigest)+import Crypto.Cipher.Types+import Crypto.Error+import Crypto.Random (getRandomBytes)++import Network.Fernet.Token (Signature)++sign :: ByteArrayAccess a => a -> ByteString -> Signature+sign key t = convert $ hmacGetDigest (hmac key t :: HMAC SHA256)++aesEncrypt :: ByteArray a+ => a -- ^ The encryption key+ -> ByteString -- ^ Initialization Vector+ -> ByteString -- ^ Plain text+ -> Maybe ByteString+aesEncrypt key iv text = cbcEncrypt <$> ctx <*> iv' <*> text'+ where+ ctx = maybeCryptoError (cipherInit key) :: Maybe AES128+ iv' = makeIV iv+ p = fmap (PKCS7 . blockSize) ctx+ text' = pad <$> p <*> pure text++aesDecrypt :: ByteArray a+ => a -- ^ The encryption key+ -> ByteString -- ^ Initialization Vector+ -> ByteString -- ^ Cipher text+ -> Maybe ByteString+aesDecrypt key iv ct = do+ (ctx, iv', p) <- aesSetup key iv+ let text' = cbcDecrypt ctx iv' ct+ unpad p text'++-- | Block size for AES128+cipherBlockSize :: Int+cipherBlockSize = 16++genIV :: IO ByteString+genIV = getRandomBytes cipherBlockSize++aesSetup :: ByteArray a => a -> ByteString -> Maybe (AES128, IV AES128, Format)+aesSetup key iv = (,,) <$> ctx <*> iv' <*> p+ where+ ctx = maybeCryptoError (cipherInit key)+ iv' = makeIV iv+ p = PKCS7 . blockSize <$> ctx
+ src/Network/Fernet/Key.hs view
@@ -0,0 +1,89 @@+module Network.Fernet.Key+ ( Key(..)+ , key+ , generateKey+ , generateKeyFromPassword+ , keyFromBase64+ , keyToBase64+ ) where++import Data.Monoid ((<>))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Byteable (Byteable(..))+import Data.ByteArray (ScrubbedBytes, ByteArrayAccess(..))+import qualified Data.ByteArray as BA+import qualified Crypto.KDF.PBKDF2 as PBKDF2+import Crypto.Hash.Algorithms (SHA256(..))+import Crypto.Random (getRandomBytes)++import Network.Fernet.Base64++-- | 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. Each key must+-- be exactly 16 bytes long or this will fail.+key :: ByteArrayAccess a+ => a -- ^ Signing Key+ -> a -- ^ Encryption Key+ -> Maybe Key+key s e = Key <$> toKey checkHashKeyLength s <*> toKey checkCipherKeyLength e++toKey :: ByteArrayAccess a => (Int -> Bool) -> a -> Maybe ScrubbedBytes+toKey checkLength k | checkLength (BA.length k) = Just (BA.convert k)+ | otherwise = Nothing++cipherKeyLength :: Int+cipherKeyLength = 16++-- | Check that key length is appropriate for AES128.+checkCipherKeyLength :: Int -> Bool+checkCipherKeyLength = (== cipherKeyLength)++checkHashKeyLength :: Int -> Bool+checkHashKeyLength = (>= 16)++-- | Generates new keys from the PRNG.+generateKey :: IO Key+generateKey = splitKeys <$> getRandomBytes (cipherKeyLength * 2)++-- | 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++-- | Encodes the given key as urlsafe base64.+keyToBase64 :: Key -> ByteString -- ^ URL-safe base64.+keyToBase64 (Key s e) = b64url $ s <> e++-- | 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++-- | 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+ return (splitKeys keys, salt)+ where+ prf = PBKDF2.prfHMAC SHA256+ params = PBKDF2.Parameters iterations 32
+ src/Network/Fernet/Token.hs view
@@ -0,0 +1,87 @@+module Network.Fernet.Token+ ( encode+ , decode+ , serialize+ , deserialize+ , isExpired+ , hasExpired+ , hasExpired'+ , TokenFields(..)+ , Signature+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.Word (Word8)+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)+import Data.Time.Clock (NominalDiffTime)+import Data.Binary.Get+import Data.Binary.Put++import Network.Fernet.Base64++data TokenFields = TokenFields+ { tokenVersion :: Word8 -- ^ Version, 8 bits+ , tokenTimestamp :: POSIXTime -- ^ Timestamp, 64 bits+ , tokenIV :: ByteString -- ^ IV, 128 bits+ , tokenCiphertext :: ByteString -- ^ Ciphertext, variable length, multiple of 128 bits+ } deriving (Show, Eq)++type Signature = ByteString++-- | Size of a SHA256 hash.+hmacLength :: Int+hmacLength = 32++encode :: ByteString -> Signature -> ByteString+encode t s = b64url $ BS.concat [t, s]++decode :: ByteString -> Either String (TokenFields, ByteString, Signature)+decode = (>>= decode') . b64urldec+ where+ decode' bs = do+ (t, sig) <- splitToken bs+ tf <- deserialize t+ return (tf, t, sig)+ splitToken bs | BS.length sig < hmacLength = Left "Missing HMAC"+ | otherwise = Right (t, sig)+ where (t, sig) = BS.splitAt (BS.length bs - hmacLength) bs++serialize :: TokenFields -> ByteString+serialize TokenFields{..} = BL.toStrict . runPut $ do+ putWord8 tokenVersion+ putWord64be (floor tokenTimestamp)+ putByteString tokenIV+ putByteString tokenCiphertext++deserialize :: ByteString -> Either String TokenFields+deserialize t = case runGetOrFail get (BL.fromStrict t) of+ Left (_, _, e) -> Left e+ Right (_, _, tf) -> Right tf+ where get = do+ v <- getWord8+ ts <- getWord64be+ 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 - tokenTimestamp < ttl
+ test/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import Test.Tasty (defaultMain, testGroup)++import qualified Network.Fernet.Tests++main :: IO ()+main = do+ tests <- Network.Fernet.Tests.makeTests+ defaultMain $ testGroup "Tests" [ tests ]
+ test/Network/Fernet/Tests.hs view
@@ -0,0 +1,91 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE DeriveGeneric #-}++module Network.Fernet.Tests (makeTests) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as S8+import Data.Maybe (fromJust, fromMaybe)+import Data.Either (isLeft)+import Data.Aeson+import Control.Applicative+import Data.Time.Clock (NominalDiffTime)+import Data.Time.LocalTime (zonedTimeToUTC)+import Data.Time.Format (parseTimeM, defaultTimeLocale)+import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)+import GHC.Generics+import System.IO++import Test.QuickCheck+import Test.QuickCheck.Monadic+import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck.Monadic as QC+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase)+import Test.HUnit (Assertion, (@?=), assertFailure)++import Network.Fernet++data Spec = Spec+ { desc :: String+ , token :: ByteString+ , now :: POSIXTime+ , ttl :: NominalDiffTime+ , secret :: ByteString+ , src :: ByteString+ , iv :: ByteString+ } deriving (Generic, Show)++instance FromJSON Spec where+ parseJSON = withObject "Spec" $ \v -> Spec+ <$> v .:? "desc" .!= ""+ <*> liftA S8.pack (v .: "token")+ <*> liftA (fromMaybe 0 . parseTime) (v .: "now")+ <*> liftA (fromIntegral :: Int -> NominalDiffTime) (v .:? "ttl_sec" .!= 0)+ <*> liftA S8.pack (v .: "secret")+ <*> liftA S8.pack (v .:? "src" .!= "")+ <*> liftA BS.pack (v .:? "iv" .!= [])++parseTime :: Monad m => String -> m POSIXTime+parseTime = fmap (utcTimeToPOSIXSeconds . zonedTimeToUTC) . parseTimeM False defaultTimeLocale fmt+ where fmt = "%Y-%m-%dT%H:%M:%S%z"++makeTests :: IO TestTree+makeTests = do+ generate <- makeGroup "generate" generateTest+ verify <- makeGroup "verify" verifyTest+ invalid <- makeGroup "invalid" invalidTest+ return $ testGroup "Acceptance Tests" [ generate, verify, invalid ]++makeGroup :: String -> (Spec -> TestTree) -> IO TestTree+makeGroup name makeSpec = do+ let f = "spec/" ++ name ++ ".json"+ withFile f ReadMode $ \h -> do+ c <- BL.hGetContents h+ case eitherDecode' c of+ Right specs -> return $ testGroup name (map makeSpec specs)+ Left e -> return $ testGroup name [testCase ("Loading " ++ f) (assertFailure e)]++getKey :: ByteString -> IO Key+getKey secret = case keyFromBase64 secret of+ Right key -> return key+ Left e -> fail $ "Couldn't decode secret: " ++ e++generateTest :: Spec -> TestTree+generateTest Spec{..} = testCase "Token generation" $ do+ key <- getKey secret+ encrypt' key now iv src @?= token++verifyTest :: Spec -> TestTree+verifyTest Spec{..} = testCase "Successful token verification" $ do+ key <- getKey secret+ decrypt' key ttl now token @?= Right src++invalidTest :: Spec -> TestTree+invalidTest Spec{..} = testCase desc $ do+ key <- getKey secret+ let r = decrypt' key ttl now token+ isLeft r @?= True+