wai-secure-cookies (empty) → 0.1.0.0

raw patch · 10 files changed

+471/−0 lines, 10 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed

Dependencies added: base, base64-bytestring, bytestring, cryptonite, http-types, memory, protolude, random, split, wai

Files

LICENSE +21/−0
README.md +28/−0
Setup.hs +2/−0
keygensrc/Main.hs +57/−0
src/Cookie/Secure.hs +82/−0
src/Cookie/Secure/Middleware.hs +97/−0
src/Crypto/Encryption.hs +36/−0
src/Crypto/Verification.hs +93/−0
src/Extension/ByteString.hs +14/−0
wai-secure-cookies.cabal +41/−0

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 Habib Alamin++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.

+ README.md view

@@ -0,0 +1,28 @@+# wai-secure-cookies++I extracted a WAI middleware to automatically encrypt and sign cookies.++---++** WARNING **++I am not a cryptographer, and the crypto libraries in Haskell are not nearly as easy to use as what I'm used to in Ruby, so I wouldn't depend on this for a serious project until it's had some proper eyes on it.++---++# Usage++Populate the following environment variables in your WAI application process:++```+WAI\_COOKIE\_VALIDATION\_KEY # key to sign cookie names and values+WAI\_COOKIE\_ENCRYPTION\_KEY # key to encrypt cookie names and values+```++You can generate random keys with `waicookie-genkey`:++```+waicookie-genkey <key type> ...+key types: encryption+           validation+```

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ keygensrc/Main.hs view

@@ -0,0 +1,57 @@+module Main (main) where++import System.Environment (getArgs)+import System.IO (hPutStrLn, stderr)+import System.Exit (exitFailure)+import Control.Monad (unless)+import Data.List (intercalate)+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.ByteString.Lazy (ByteString)+import Data.ByteString.Builder (toLazyByteString, byteStringHex)+import Crypto.Random.Types (getRandomBytes)+import Crypto.Hash (hashBlockSize, SHA256)+import Crypto.Cipher.Types (BlockCipher(..))+import Crypto.Cipher.AES (AES256)++main :: IO ()+main = getArgs >>= mainWithArgs++mainWithArgs :: [String] -> IO ()+mainWithArgs [] = do+  hPutStrLn stderr $ "usage: waicookie-genkey <key type> ...\n\n" +++                     "key types: encryption\n" +++                     "           validation"+  exitFailure+mainWithArgs xs = do+  unless (null invalidKeyTypes) $ do+    hPutStrLn stderr $+      "Unrecognised key types: " ++ intercalate ", " invalidKeyTypes+    exitFailure++  printRandomKeys xs++  where+      invalidKeyTypes = filter (not . isValidKeyType) xs++isValidKeyType :: String -> Bool+isValidKeyType "encryption" = True+isValidKeyType "validation" = True+isValidKeyType _ = False++printRandomKeys :: [String] -> IO ()+printRandomKeys = mapM_ printRandomKey++printRandomKey :: String -> IO ()+-- I know, partial functions suck, but it's only a tiny program.+printRandomKey "encryption" = BS.putStrLn =<< getRandomEncryptionKey+printRandomKey "validation" = BS.putStrLn =<< getRandomValidationKey++getRandomValidationKey :: IO ByteString+getRandomValidationKey = toLazyByteString . byteStringHex <$> rawKey+  where+    rawKey = getRandomBytes $ hashBlockSize (undefined :: SHA256)++getRandomEncryptionKey :: IO ByteString+getRandomEncryptionKey = toLazyByteString . byteStringHex <$> rawKey+  where+    rawKey = getRandomBytes $ blockSize (undefined :: AES256)

@@ -0,0 +1,82 @@+module Cookie.Secure (encryptAndSign+                    , verifyAndDecrypt+                    , encryptAndSignIO+                    , encryptNullIVAndSignIO+                    , verifyAndDecryptIO) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Crypto.Error (CryptoFailable, maybeCryptoError, throwCryptoErrorIO)+import System.Random (getStdRandom, randomR)+import Data.Char (chr)+import Control.Monad (replicateM)+import System.Environment (getEnv)++import Crypto.Encryption (encrypt, decrypt)+import Crypto.Verification (sign+                          , verify+                          , serialize+                          , deserialize+                          , getSignable)++encryptAndSign+  :: String+  -> String+  -> String+  -> ByteString+  -> CryptoFailable ByteString+encryptAndSign iv encryptKey authKey message = serialize <$> signed+  where+    signed = sign authKey <$> encrypted+    encrypted = encrypt iv encryptKey message++-- OPTIMIZE: wrap result in Either errorType, instead of Maybe.+-- Ideally, wrap it in a CryptoFailable, but that does not take+-- any error type except CryptoError, which has no constructors+-- for any signing/verification failures (/deserialization).+verifyAndDecrypt :: String -> String -> ByteString -> Maybe ByteString+verifyAndDecrypt authKey encryptKey message =+  deserialize message >>= verifyAndDecryptDeserialized+    where+      verifyAndDecryptDeserialized signed = +        if verify authKey signed+        then maybeCryptoError $ decrypt encryptKey (getSignable signed)+        else Nothing++encryptAndSignIO :: ByteString -> IO ByteString+encryptAndSignIO message = do+  (iv, validationKey, encryptionKey) <- getIVAuthKeyEncryptKey++  throwCryptoErrorIO+    $ encryptAndSign iv encryptionKey validationKey message++-- OPTIMIZE: DRY this up.+encryptNullIVAndSignIO :: ByteString -> IO ByteString+encryptNullIVAndSignIO message = do+  -- This is currently ignored and a null IV used in its place, because we+  -- need a deterministic output for cookies to be removed or changed, and+  -- a random IV breaks that.+  (_, validationKey, encryptionKey) <- getIVAuthKeyEncryptKey++  throwCryptoErrorIO+    $ encryptAndSign nullStringIV encryptionKey validationKey message+    where+      nullStringIV = replicate 16 '\0'++verifyAndDecryptIO :: ByteString -> IO (Maybe ByteString)+verifyAndDecryptIO message = do+  (_, validationKey, encryptionKey) <- getIVAuthKeyEncryptKey++  return $ verifyAndDecrypt validationKey encryptionKey message++getIVAuthKeyEncryptKey :: IO (String, String, String)+getIVAuthKeyEncryptKey = (,,)+  -- The function takes a string for the IV, but the AES-256/CTR algorithm+  -- is just looking for bytes. Printability in ASCII, UTF-8, or any other+  -- encoding doesn't matter.+  <$> get16RandomBytes+  <*> getEnv "WAI_COOKIE_VALIDATION_KEY"+  <*> getEnv "WAI_COOKIE_ENCRYPTION_KEY"+    where+      get16RandomBytes =+        replicateM 16 . getStdRandom $ randomR (chr 0, chr 255)

@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}++module Cookie.Secure.Middleware (secureCookies) where++import Network.Wai (Middleware+                  , Request+                  , ResponseReceived+                  , responseLBS+                  , requestHeaders+                  , responseHeaders)+import Network.Wai.Internal (Response(..))+import Network.HTTP.Types.Header (Header+                                , RequestHeaders+                                , ResponseHeaders)+import Network.HTTP.Types.Status (status200)+import qualified Data.ByteString.Char8 as BS+import Data.Maybe (catMaybes)+import Cookie.Secure (encryptNullIVAndSignIO, verifyAndDecryptIO)+import Data.List.Split (splitOn)++secureCookies :: Middleware+secureCookies app request respondWith =+  verifyAndDecryptCookies request+  >>= flip app (encryptAndSignCookies respondWith)++verifyAndDecryptCookies :: Request -> IO Request+verifyAndDecryptCookies request =+  replaceRequestHeaders request+  <$> mapM verifyAndDecryptIfCookieHeader (requestHeaders request)++encryptAndSignCookies+  :: (Response -> IO ResponseReceived)+  -> Response -> IO ResponseReceived+encryptAndSignCookies respondWith response = do+  mapM encryptAndSignIfSetCookieHeader (responseHeaders response)+  >>= respondWith . replaceResponseHeaders response++encryptAndSignIfSetCookieHeader :: Header -> IO Header+encryptAndSignIfSetCookieHeader header =+  if fst header == "Set-Cookie"+  then encryptAndSignCookieHeader header+  else return header++encryptAndSignCookieHeader :: Header -> IO Header+encryptAndSignCookieHeader (name, value) = (,)+  <$> return name+  <*> encryptedSignedCookieHeaderValue+    where+      (cookie, metadata) = BS.break (== ';') value+      encryptedSignedCookieHeaderValue =+        flip BS.append metadata <$> encryptAndSignCookie cookie+      encryptAndSignCookie c =+        BS.intercalate "="+        -- OPTIMIZE: Use IV for value, but not name, so that the cookie+        -- can actually be deleted while keeping the value as secure as+        -- possible.+        <$> mapM encryptNullIVAndSignIO+        (map BS.pack (splitOn "=" (BS.unpack c)))++replaceRequestHeaders :: Request -> RequestHeaders -> Request+replaceRequestHeaders request newHeaders =+  request { requestHeaders = newHeaders }++-- OPTIMIZE: Response is imported from Network.Wai.Internal, which+-- interface is not guaranteed to be stable.+replaceResponseHeaders :: Response -> ResponseHeaders -> Response+replaceResponseHeaders+  (ResponseFile status headers filepath possibleFilepart) newHeaders =+    ResponseFile status newHeaders filepath possibleFilepart+replaceResponseHeaders (ResponseBuilder status headers builder) newHeaders =+  ResponseBuilder status newHeaders builder+replaceResponseHeaders (ResponseStream status headers body) newHeaders =+  ResponseStream status newHeaders body+replaceResponseHeaders (ResponseRaw toStreaming response) newHeaders =+  ResponseRaw toStreaming (replaceResponseHeaders response newHeaders)++verifyAndDecryptIfCookieHeader :: Header -> IO Header+verifyAndDecryptIfCookieHeader header =+  if fst header == "Cookie"+  then verifyAndDecryptCookieHeader header+  else return header++verifyAndDecryptCookieHeader :: Header -> IO Header+verifyAndDecryptCookieHeader (name, value) = (,)+  <$> return name+  <*> verifyAndDecryptCookieHeaderValue value+    where+      verifyAndDecryptCookieHeaderValue value =+        BS.intercalate "; "+        <$> mapM verifyAndDecryptCookie+        (splitOn "; " (BS.unpack value))+      verifyAndDecryptCookie cookie =+        -- OPTIMIZE: maybe silently dropping cookies which fail to verify+        -- or decrypt isn't the best idea?+        BS.intercalate "=" . catMaybes+        <$> mapM verifyAndDecryptIO+        (map BS.pack (splitOn "=" cookie))

+ src/Crypto/Encryption.hs view

@@ -0,0 +1,36 @@+module Crypto.Encryption (Encrypted(..)+                        , getIV+                        , getSecret+                        , encrypt+                        , decrypt) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Crypto.Error (CryptoFailable(..), CryptoError(..))+import Crypto.Cipher.AES (AES256)+import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), makeIV)++data Encrypted = Encrypted String ByteString deriving (Eq, Show)++encrypt :: String -> String -> ByteString -> CryptoFailable Encrypted+encrypt stringIV key secret =+  aes256Init key >>=+  \context -> case makeIV $ BS.pack stringIV of+    Nothing -> CryptoFailed CryptoError_IvSizeInvalid+    Just iv -> CryptoPassed+      . Encrypted stringIV+      . ctrCombine context iv+      $ secret++decrypt :: String -> Encrypted -> CryptoFailable ByteString+-- AES/CTR decrypt operation is identical to encrypt+decrypt key (Encrypted iv secret) = getSecret <$> encrypt iv key secret++getIV :: Encrypted -> String+getIV (Encrypted iv _) = iv++getSecret :: Encrypted -> ByteString+getSecret (Encrypted _ secret) = secret++aes256Init :: String -> CryptoFailable AES256+aes256Init = cipherInit . BS.pack

+ src/Crypto/Verification.hs view

@@ -0,0 +1,93 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module Crypto.Verification (Signed(..)+                          , getSignable+                          , sign+                          , verify+                          , serialize+                          , deserialize+                          , deserializeSignable) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Crypto.Hash.Algorithms (SHA256)+import Crypto.MAC.HMAC (HMAC(..), hmac)+import Crypto.Hash (Digest, digestFromByteString)+import Data.ByteArray.Encoding (Base(..)+                              , convertToBase+                              , convertFromBase)+import Protolude (rightToMaybe)+import Data.Tuple (swap)++import Crypto.Encryption (Encrypted(..), getIV, getSecret)+import qualified Extension.ByteString as EBS++data Signed signable =+  Signed signable (Digest SHA256) deriving (Show, Eq)++class Eq signable => Signable signable where+  sign :: String -> signable -> Signed signable++  verify :: String -> Signed signable -> Bool+  verify key signed@(Signed message _) = sign key message == signed++  getSignable :: Signed signable -> signable+  getSignable (Signed signable _) = signable++  serializeSignable :: signable -> ByteString++  deserializeSignable :: ByteString -> Maybe signable++  serialize :: Signed signable -> ByteString+  serialize (Signed signable digest) =+    convertToBase Base64URLUnpadded (serializeSignable signable)+    `BS.append` "|signature," `BS.append`+    BS.pack (show digest)++  deserialize :: ByteString -> Maybe (Signed signable)+  deserialize bs = Signed+    <$> (rightToMaybe message >>= deserializeSignable)+    <*> (rightToMaybe signature >>= digestFromByteString)+      where+        (encodedMessage, base16Signature) =+          EBS.stripPrefix "|signature,"+          <$> BS.span (/= '|') bs+        signature :: Either String ByteString+        signature = convertFromBase Base16 base16Signature+        message = convertFromBase Base64URLUnpadded encodedMessage++instance {-# OVERLAPPING #-} Signable String where+  sign key message = Signed message digest+    where+      digest = hmacGetDigest hmac'ed+      hmac'ed = hmac (BS.pack key) (BS.pack message) :: HMAC SHA256++  serializeSignable = convertToBase Base64URLUnpadded . BS.pack++  deserializeSignable bs = BS.unpack+    <$> rightToMaybe (convertFromBase Base64URLUnpadded bs)++instance Signable Encrypted where+  sign key message = Signed message digest+    where+      digest = hmacGetDigest hmac'ed+      hmac'ed =+        hmac (BS.pack key)+        (serializeSignable message) :: HMAC SHA256++  serializeSignable encrypted =+    "iv," `BS.append`+    convertToBase Base64URLUnpadded (BS.pack . getIV $ encrypted)+    `BS.append` "|" `BS.append`+    convertToBase Base64URLUnpadded (getSecret encrypted)++  deserializeSignable bs = Encrypted+    <$> (BS.unpack <$> rightToMaybe iv)+    <*> (rightToMaybe secret)+      where+        (base64Secret, base64IV) =+          EBS.stripPrefix "iv," . EBS.stripSuffix "|"+          <$> swap (BS.spanEnd (/= '|') bs)+        iv = convertFromBase Base64URLUnpadded base64IV+        secret = convertFromBase Base64URLUnpadded base64Secret

+ src/Extension/ByteString.hs view

@@ -0,0 +1,14 @@+module Extension.ByteString (stripPrefix, stripSuffix) where++import Data.ByteString (ByteString(..))+import qualified Data.ByteString.Char8 as BS+import Data.Maybe (fromMaybe)++stripPrefix :: ByteString -> ByteString -> ByteString+stripPrefix prefix = maybeOriginal $ BS.stripPrefix prefix++stripSuffix :: ByteString -> ByteString -> ByteString+stripSuffix suffix = maybeOriginal $ BS.stripSuffix suffix++maybeOriginal :: (a -> Maybe a) -> a -> a+maybeOriginal f g = fromMaybe g $ f g

+ wai-secure-cookies.cabal view

@@ -0,0 +1,41 @@+name:                wai-secure-cookies+version:             0.1.0.0+description:         WAI middleware to automatically encrypt and sign cookies+homepage:            https://github.com/habibalamin/wai-secure-cookies+license:             MIT+license-file:        LICENSE+author:              Habib Alamin+maintainer:          ha.alamin@gmail.com+copyright:           © حبيب الامين‪ 2017+category:            Web+build-type:          Simple+cabal-version:       >=1.10+extra-source-files:  README.md++library+  hs-source-dirs:      src+  default-language:    Haskell2010+  exposed-modules:     Cookie.Secure.Middleware+  other-modules:       Cookie.Secure+                     , Crypto.Encryption+                     , Crypto.Verification+                     , Extension.ByteString+  build-depends:       base >= 4.7 && < 5+                     , protolude >= 0.2 && < 0.3+                     , wai >= 3.2 && < 4+                     , cryptonite >= 0.24 && < 0.25+                     , bytestring >= 0.10 && < 0.11+                     , memory >= 0.14 && < 0.15+                     , random >= 1.1 && < 2+                     , split >= 0.2 && < 0.3+                     , http-types >= 0.9 && < 0.10++executable waicookie-genkey+  hs-source-dirs:      keygensrc+  default-language:    Haskell2010+  main-is:             Main.hs+  build-depends:       base >= 4.7 && < 5+                     , cryptonite >= 0.24 && < 0.25+                     , bytestring >= 0.10 && < 0.11+                     , base64-bytestring >= 1 && < 2+                     , memory >= 0.14 && < 0.15