diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016-2017 Philip Cunningham & Alfredo di Napoli + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/rails-session.cabal b/rails-session.cabal new file mode 100644 --- /dev/null +++ b/rails-session.cabal @@ -0,0 +1,51 @@ +name: rails-session +version: 0.1.0.0 +synopsis: Decrypt Ruby on Rails sessions in Haskell +description: Please see README.md +homepage: http://github.com/iconnect/rails-session#readme +license: BSD3 +license-file: LICENSE +author: Philip Cunningham & Alfredo di Napoli +maintainer: philip@irisconnect.co.uk +copyright: 2016-2017 Philip Cunningham & Alfredo di Napoli +category: Web +build-type: Simple +cabal-version: >=1.10 + +Source-repository head + type: git + location: https://github.com/iconnect/rails-session + +library + hs-source-dirs: src + exposed-modules: Web.Rails.Session + build-depends: base >= 4.7 && < 5 + , base-compat >= 0.8.2 + , base64-bytestring >= 1.0.0.1 + , bytestring >= 0.10.6.0 + , cryptonite >= 0.6 + , http-types >= 0.8.6 + , pbkdf >= 1.1.1.1 + , ruby-marshal >= 0.1.1 + , string-conv >= 0.1 + , vector >= 0.10.12.3 + default-language: Haskell2010 + +test-suite specs + ghc-options: -Wall + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , bytestring + , rails-session + , ruby-marshal + , tasty + , tasty-hspec + , vector + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/iconnect/haskell-oss/rails-interop diff --git a/src/Web/Rails/Session.hs b/src/Web/Rails/Session.hs new file mode 100644 --- /dev/null +++ b/src/Web/Rails/Session.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Web.Rails.Session ( + -- * Decoding + decode + , decodeEither + -- * Decrypting + , decrypt + -- * Utilities + , lookupString + , lookupFixnum + -- * Lifting weaker types into stronger types + , Cookie + , mkCookie + , Salt + , mkSalt + , SecretKeyBase + , mkSecretKeyBase + ) where + +import Control.Applicative ((<$>)) +import "cryptonite" Crypto.Cipher.AES (AES256) +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 Data.Either (Either(..), either) +import Data.Function.Compat ((&)) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Monoid ((<>)) +import Data.Ruby.Marshal (RubyObject(..), RubyStringEncoding(..)) +import qualified Data.Ruby.Marshal as Ruby +import Data.String.Conv (toS) +import qualified Data.Vector as Vec +import Network.HTTP.Types (urlDecode) +import Prelude (Bool(..), Eq, Int, Ord, Show, String, ($!), (.) + , (==), const, error, fst, show, snd) + +-- TYPES + +newtype DecryptedData = + DecryptedData ByteString + deriving (Show, Ord, Eq) + +newtype EncryptedData = + EncryptedData ByteString + deriving (Show, Ord, Eq) + +newtype InitVector = + InitVector ByteString + deriving (Show, Ord, Eq) + +newtype Cookie = + Cookie ByteString + deriving (Show, Ord, Eq) + +newtype Salt = + Salt ByteString + deriving (Show, Ord, Eq) + +newtype SecretKey = + SecretKey ByteString + deriving (Show, Ord, Eq) + +newtype SecretKeyBase = + SecretKeyBase ByteString + deriving (Show, Ord, Eq) + +-- SMART CONSTRUCTORS + +mkCookie :: ByteString -> Cookie +mkCookie = Cookie + +mkSalt :: ByteString -> Salt +mkSalt = Salt + +mkSecretKeyBase :: ByteString -> SecretKeyBase +mkSecretKeyBase = SecretKeyBase + +-- EXPORTS + +-- | Decode a cookie encrypted by Rails. +decode :: Maybe Salt -> SecretKeyBase -> Cookie -> Maybe RubyObject +decode mbSalt secretKeyBase cookie = + either (const Nothing) Just (decodeEither mbSalt secretKeyBase cookie) + +-- | Decode a cookie encrypted by Rails and retain some error information on failure. +decodeEither :: Maybe Salt + -> SecretKeyBase + -> Cookie + -> Either String RubyObject +decodeEither mbSalt secretKeyBase cookie = do + case decrypt mbSalt secretKeyBase cookie of + Left errorMessage -> + Left errorMessage + Right (DecryptedData deData) -> + Ruby.decodeEither deData + +-- | Decrypts a cookie encrypted by Rails. Use this if you are using a +-- serialisation format other than Ruby's Marshal format. +decrypt :: Maybe Salt + -> SecretKeyBase + -> Cookie + -> Either String DecryptedData +decrypt mbSalt secretKeyBase cookie = + let salt = fromMaybe (Salt "encrypted cookie") mbSalt + (SecretKey secret) = generateSecret salt secretKeyBase + key = BS.take 32 secret + (EncryptedData encData, InitVector initVec) = prepare cookie + in case makeIV initVec of + Nothing -> + Left $! "Failed to build init. vector for: " <> show initVec + Just initVec' -> + case (cipherInit key :: CryptoFailable AES256) of + CryptoFailed errorMessage -> + Left (show errorMessage) + CryptoPassed cipher -> + Right . DecryptedData $! cbcDecrypt cipher initVec' encData + +-- | Lookup integer for a given key. +lookupFixnum :: ByteString -> RubyStringEncoding -> RubyObject -> Maybe Int +lookupFixnum k enc m = + case lookup (RIVar (RString k, enc)) m of + Just (RFixnum v) -> + Just v + _ -> + Nothing + +-- | Lookup string for a given key and throw away encoding information. +lookupString :: ByteString + -> RubyStringEncoding + -> RubyObject + -> Maybe ByteString +lookupString k enc m = + case lookup (RIVar (RString k, enc)) m of + Just (RIVar (RString v, _)) -> + Just v + _ -> + Nothing + +-- UTIL + +-- | Generate secret key using same cryptographic routines as Rails. +generateSecret :: Salt -> SecretKeyBase -> SecretKey +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))) + where + base64decode :: ByteString -> ByteString + base64decode = B64.decodeLenient + + separator :: ByteString + separator = "--" + + split :: ByteString -> (ByteString, ByteString) + split = BS.breakSubstring separator + +-- | Lookup value for a given key. +lookup :: RubyObject -> RubyObject -> Maybe RubyObject +lookup key (RHash vec) = snd <$> Vec.find (\element -> fst element == key) vec +lookup _ _ = Nothing diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +import Data.ByteString (ByteString) +import Data.Either (isRight) +import Data.Ruby.Marshal hiding (decodeEither) +import Data.Vector (fromList) +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.Hspec (describe, it, shouldBe, shouldSatisfy, testSpec, Spec) +import Web.Rails.Session + +main :: IO () +main = do + x <- testSpec "Web.Rails.Session" specs + defaultMain (testGroup "All the Specs" [x]) + +specs :: Spec +specs = do + 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 + + describe "decrypt" $ do + it "should be a Right(..)" $ do + let result = decrypt Nothing secret cookie + result `shouldSatisfy` isRight + + describe "lookupString" $ do + it "should look up the '_csrf_token'" $ do + case decodeEither Nothing secret cookie of + Left _ -> error "lookup failed" + Right result -> + lookupString "_csrf_token" US_ASCII result `shouldBe` + Just csrfToken + + it "should look up the 'session_id'" $ do + case decodeEither Nothing secret cookie of + Left _ -> error "lookup failed" + Right result -> + lookupString "session_id" UTF_8 result `shouldBe` + Just sessionId + + it "should look up the 'token'" $ do + case decodeEither Nothing secret cookie of + Left _ -> error "lookup failed" + Right result -> + lookupString "token" US_ASCII result `shouldBe` + Just authToken + +-- CONFIG + +secret :: SecretKeyBase +secret = mkSecretKeyBase "development_secret_token" + +-- VALUES + +authToken :: ByteString +authToken = "GT1EYH9X8OXYqup4HwnQIvfnh59TqNys1IvukVXpXR8=" + +sessionId :: ByteString +sessionId = "912a0abcf3d64e0d9d2bdb601b9e8224" + +csrfToken :: ByteString +csrfToken = "c9kRzi8L7oj2MPI/QlqYpQ79WR6YfKTDob6PGl9V2pg=" + +-- SESSIONS + +cookie :: Cookie +cookie = + mkCookie $ + "T3NpYnRsWGJsZ25qL0R4MFlZdE9wZVBrZXc3VnFHMHhYMFgvemlVUjlTekZKbERXbVd2Mkwra0xxTmNOYnZaWktBQWo3T25RV3VPRkR6RU9BQ3dub2FSWExlZmZ1RUxVWG9vZjRTbWphRzBFSW5nMVJOSklPTVRPRGxKN0tvdGxhZzVlZktLTmhxc0V1a1FCWHpwNVJGTjdON0JCbjZQWHM0R1M1SWIzeUkzalhVNWdVbnd2Z2E5RlBMSXcvR0tNSHVOZ0NiK1RBTzVxcCtMK3hJa1daYW13allNb1NyN3pOUTFBQ0tRcFNEdUVJelVMZE8rVXhwM3RhcHFONWRwby9kRStNNkRUVXNQTDNKcjF0ZWpGTUE9PS0tb3NGeEJiZ1dLeFFKcFV0WXgyUytnZz09--e996601dbf39ff5ffbf6e2f23f6ddf78c5179baa" + +rubySession :: RubyObject +rubySession = + RHash + (fromList + [ ( RIVar (RString "session_id", UTF_8) + , RIVar (RString sessionId, UTF_8)) + , ( RIVar (RString "_csrf_token", US_ASCII) + , RIVar + (RString csrfToken, US_ASCII)) + , ( RIVar (RString "token", US_ASCII) + , RIVar (RString authToken, UTF_8)) + ])