Verify the signature

rails-session.cabal

@@ -25,6 +25,7 @@ library
                      , base64-bytestring >= 1.0.0.1
                      , bytestring        >= 0.10.6.0
                      , cryptonite        >= 0.6
+                     , memory            >= 0.14
                      , http-types        >= 0.8.6
                      , pbkdf             >= 1.1.1.1
                      , ruby-marshal      >= 0.1.1

src/Web/Rails/Session.hs

@@ -27,12 +27,16 @@ module Web.Rails.Session (
 
 import              Control.Applicative ((<$>))
 import "cryptonite" Crypto.Cipher.AES (AES256)
+import "cryptonite" Crypto.MAC.HMAC (HMAC, hmac)
+import "cryptonite" Crypto.Hash.Algorithms (SHA1)
 import "cryptonite" Crypto.Cipher.Types (cbcDecrypt, cipherInit, makeIV)
 import "cryptonite" Crypto.Error (CryptoFailable(CryptoFailed, CryptoPassed))
 import              Crypto.PBKDF.ByteString (sha1PBKDF2)
 import              Data.ByteString (ByteString)
 import qualified    Data.ByteString as BS
 import qualified    Data.ByteString.Base64 as B64
+import qualified    Data.ByteArray as BA
+import qualified    Data.ByteArray.Encoding as BA
 import              Data.Either (Either(..), either)
 import              Data.Function.Compat ((&))
 import              Data.Maybe (Maybe(..), fromMaybe)
@@ -82,6 +86,11 @@ newtype SecretKeyBase =
   SecretKeyBase ByteString
   deriving (Show, Ord, Eq)
 
+-- | Wrapper around raw signature.
+newtype Signature =
+  Signature ByteString
+  deriving (Show, Ord, Eq)
+
 -- SMART CONSTRUCTORS
 
 -- | Lift a cookie into a richer type.
@@ -130,20 +139,21 @@ decrypt :: Maybe Salt
         -> SecretKeyBase
         -> Cookie
         -> Either String DecryptedData
-decrypt mbSalt secretKeyBase cookie =
+decrypt mbSalt secretKeyBase cookie = do
   let salt = fromMaybe defaultSalt mbSalt
       (SecretKey secret) = generateSecret salt secretKeyBase
-      (EncryptedData encData, InitVector initVec) = prepare cookie
-  in case makeIV initVec of
-       Nothing ->
-         Left $! "Failed to build init. vector for: " <> show initVec
-       Just initVec' -> do
-         let key = BS.take 32 secret
-         case (cipherInit key :: CryptoFailable AES256) of
-           CryptoFailed errorMessage ->
-             Left (show errorMessage)
-           CryptoPassed cipher ->
-             Right . DecryptedData $! cbcDecrypt cipher initVec' encData
+  (EncryptedData encData, InitVector initVec) <- prepare cookie secretKeyBase
+
+  case makeIV initVec of
+    Nothing ->
+      Left $! "Failed to build init. vector for: " <> show initVec
+    Just initVec' -> do
+      let key = BS.take 32 secret
+      case (cipherInit key :: CryptoFailable AES256) of
+        CryptoFailed errorMessage ->
+          Left (show errorMessage)
+        CryptoPassed cipher ->
+          Right . DecryptedData $! cbcDecrypt cipher initVec' encData
   where
     defaultSalt :: Salt
     defaultSalt = Salt "encrypted cookie"
@@ -187,13 +197,25 @@ generateSecret (Salt salt) (SecretKeyBase secret) =
   SecretKey $! sha1PBKDF2 secret salt 1000 64
 
 -- | Prepare a cookie for decryption.
-prepare :: Cookie -> (EncryptedData, InitVector)
-prepare (Cookie cookie) =
-  urlDecode True cookie
-  & (fst . split)
-  & base64decode
-  & split
-  & (\(x, y) -> (EncryptedData (base64decode x), InitVector (base64decode y)))
+prepare :: Cookie -> SecretKeyBase -> Either String (EncryptedData, InitVector)
+prepare (Cookie cookie) secretKeyBase = do
+  let (signedBase64, signatureBase16) = split (urlDecode True cookie)
+      (SecretKey secret) = generateSecret salt secretKeyBase
+
+  signature :: ByteString <- BA.convertFromBase BA.Base16 signatureBase16
+
+  let digest :: HMAC SHA1
+      digest = hmac secret signedBase64
+
+  verified <- 
+    if BA.constEq digest signature
+      then Right (base64decode signedBase64)
+      else Left ("Invalid HMAC " <> show (BA.convertToBase BA.Base16 digest :: ByteString)
+          <> " " <> show signatureBase16)
+
+  let (encryptedDataBase64, ivBase64) = split verified
+  Right ( EncryptedData (base64decode encryptedDataBase64)
+        , InitVector (base64decode ivBase64) )
   where
     base64decode :: ByteString -> ByteString
     base64decode = B64.decodeLenient
@@ -202,7 +224,11 @@ prepare (Cookie cookie) =
     separator = "--"
 
     split :: ByteString -> (ByteString, ByteString)
-    split = BS.breakSubstring separator
+    split s = let (l, r) = BS.breakSubstring separator s
+              in (l, BS.drop (BS.length separator) r)
+
+    salt :: Salt
+    salt = Salt "signed encrypted cookie"
 
 -- | Lookup value for a given key.
 lookup :: RubyObject -> RubyObject -> Maybe RubyObject

test/Spec.hs

@@ -3,13 +3,13 @@
 
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
-import           Data.Either (isRight)
+import           Data.Either (isRight, isLeft)
 import           Data.Monoid ((<>))
 import           Data.Ruby.Marshal hiding (decodeEither)
 import           Data.Vector (fromList)
 import           System.IO.Unsafe (unsafePerformIO)
 import           Test.Tasty (defaultMain, testGroup)
-import           Test.Tasty.Hspec (describe, it, shouldBe, shouldSatisfy, testSpec, Spec)
+import           Test.Tasty.Hspec (describe, context, it, shouldBe, shouldSatisfy, testSpec, Spec)
 import           Web.Rails.Session
 
 -- SPECS
@@ -21,23 +21,36 @@ main = do
 
 specsFor :: Rails -> Spec
 specsFor rails = do
-  let cookie = unsafeReadCookie rails
+  let cookie = unsafeReadCookie rails Valid
+      invalidSignatureCookie = unsafeReadCookie rails InvalidSignature
 
   describe "decode" $ do
-    it "should be a Right(..)" $ do
-      let result = decodeEither Nothing secret cookie
-      result `shouldSatisfy` isRight
-
-    it "should be a fully-formed Ruby object" $ do
-      case decodeEither Nothing secret cookie of
-        Left _ -> error "decode failed"
-        Right result -> do
-          result `shouldBe` rubySession
+    context "valid cookie" $ do
+      it "should be a Right(..)" $ do
+        let result = decodeEither Nothing secret cookie
+        result `shouldSatisfy` isRight
+
+      it "should be a fully-formed Ruby object" $ do
+        case decodeEither Nothing secret cookie of
+          Left _ -> error "decode failed"
+          Right result -> do
+            result `shouldBe` rubySession
+
+    context "invalid signature" $ do
+      it "should be a Left(..)" $ do
+        let result = decodeEither Nothing secret invalidSignatureCookie
+        result `shouldSatisfy` isLeft
 
   describe "decrypt" $ do
-    it "should be a Right(..)" $ do
-      let result = decrypt Nothing secret cookie
-      result `shouldSatisfy` isRight
+    context "valid cookie" $ do
+      it "should be a Right(..)" $ do
+        let result = decrypt Nothing secret cookie
+        result `shouldSatisfy` isRight
+
+    context "invalid signature" $ do
+      it "should be a Left(..)" $ do
+        let result = decrypt Nothing secret invalidSignatureCookie
+        result `shouldSatisfy` isLeft
 
   describe "csrfToken" $ do
     it "should look up the '_csrf_token'" $ do
@@ -92,9 +105,12 @@ example path = do
 
 data Rails = Rails4 deriving (Show)
 
-unsafeReadCookie :: Rails -> Cookie
-unsafeReadCookie rails = unsafePerformIO $
-  BS.readFile ("test/" <> (show rails)) >>= pure . mkCookie
+data CookieVariant = Valid | InvalidSignature deriving (Show)
+
+unsafeReadCookie :: Rails -> CookieVariant -> Cookie
+unsafeReadCookie rails cookieVariant = unsafePerformIO $
+  mkCookie <$>
+  BS.readFile ("test/cookies/" <> show rails <> "-" <> show cookieVariant)
 
 -- CONFIG
 

test/cookies/Rails4-InvalidSignature

@@ -0,0 +1 @@
+T2NpYnRsWGJsZ25qL0R4MFlZdE9wZVBrZXc3VnFHMHhYMFgvemlVUjlTekZKbERXbVd2Mkwra0xxTmNOYnZaWktBQWo3T25RV3VPRkR6RU9BQ3dub2FSWExlZmZ1RUxVWG9vZjRTbWphRzBFSW5nMVJOSklPTVRPRGxKN0tvdGxhZzVlZktLTmhxc0V1a1FCWHpwNVJGTjdON0JCbjZQWHM0R1M1SWIzeUkzalhVNWdVbnd2Z2E5RlBMSXcvR0tNSHVOZ0NiK1RBTzVxcCtMK3hJa1daYW13allNb1NyN3pOUTFBQ0tRcFNEdUVJelVMZE8rVXhwM3RhcHFONWRwby9kRStNNkRUVXNQTDNKcjF0ZWpGTUE9PS0tb3NGeEJiZ1dLeFFKcFV0WXgyUytnZz09--e996601dbf39ff5ffbf6e2f23f6ddf78c5179baa