Merge pull request #21 from iconnect/adinapoli/issue-20

Expose some helper types
iconnect · Aug 22, 2024 · 7f1f61b · 7f1f61b
2 parents 178e6db + ce448fb
commit 7f1f61b
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 5 deletions.
diff --git a/rails-session.cabal b/rails-session.cabal
@@ -1,5 +1,5 @@
 name:                rails-session
-version:             0.1.4.0
+version:             0.1.4.1
 synopsis:            Decrypt Ruby on Rails sessions in Haskell
 description:         Please see README.md
 homepage:            http://github.com/iconnect/rails-session#readme
@@ -35,6 +35,8 @@ library
                      , containers
                      , crypton           >= 1.0.0
                      , http-types        >= 0.8.6
+                     , lens
+                     , lens-aeson
                      , memory
                      , pbkdf             >= 1.1.1.1
                      , ruby-marshal      >= 0.1.1

diff --git a/src/Web/Rails7/Session.hs b/src/Web/Rails7/Session.hs
@@ -7,14 +7,24 @@ module Web.Rails7.Session (
     decode
   , decodeEither
   , DecodingError(..)
+  -- * Decoding syntactic sugar and facilities
+  , RailsDecryptedCookie(..)
+  , DecryptedCookieData(..)
+  , parseCookieData
   -- * Decrypting
   , decrypt
   ) where
 
 import Control.Applicative ((<$>))
+import Control.Lens
 import Control.Monad
+import Crypto.Cipher.AES (AES256)
+import Crypto.Cipher.AESGCMSIV qualified as AESGCM
+import Crypto.Cipher.Types (cbcDecrypt, cipherInit, makeIV, aeadInit, AEADMode (..), aeadSimpleDecrypt, AuthTag(..))
+import Crypto.Error (CryptoFailable(CryptoFailed, CryptoPassed))
 import Crypto.PBKDF.ByteString (sha1PBKDF2, sha256PBKDF2)
 import Data.Aeson qualified as JSON
+import Data.Aeson.Lens
 import Data.Bifunctor
 import Data.ByteArray qualified as BA
 import Data.ByteString (ByteString)
@@ -28,15 +38,32 @@ import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Monoid ((<>))
 import Data.Ruby.Marshal (RubyObject(..), RubyStringEncoding(..))
 import Data.String.Conv (toS)
+import Data.Text.Encoding qualified as TE
 import Data.Vector qualified as Vec
 import Network.HTTP.Types (urlDecode)
 import Prelude (Bool(..), Eq, Int, Ord, Show, String, ($!), (.) , (==), const, error, fst, show, snd)
 import Prelude hiding (lookup)
 import Web.Rails.Session.Types
-import Crypto.Cipher.AES (AES256)
-import Crypto.Cipher.AESGCMSIV qualified as AESGCM
-import Crypto.Cipher.Types (cbcDecrypt, cipherInit, makeIV, aeadInit, AEADMode (..), aeadSimpleDecrypt, AuthTag(..))
-import Crypto.Error (CryptoFailable(CryptoFailed, CryptoPassed))
+import qualified Data.Aeson.Types as JSON
+
+newtype RailsDecryptedCookie
+  = RailsDecryptedCookie
+  { _rails :: DecryptedCookieData }
+  deriving Show
+
+-- | NOTE(adn) decoding only the fields we need.
+newtype DecryptedCookieData
+  = DecryptedCookieData
+  { dcd_message :: JSON.Value
+  }
+  deriving Show
+
+instance JSON.FromJSON RailsDecryptedCookie where
+  parseJSON = JSON.withObject "RailsDecryptedCookie" $ \o -> do
+    (payload :: JSON.Value) <- o JSON..: "_rails"
+    case JSON.eitherDecode (BL.fromStrict $ B64.decodeLenient $ TE.encodeUtf8 $ payload ^. key "message" . _String) of
+      Left e        -> fail e
+      Right msgBlob -> pure $ RailsDecryptedCookie $ DecryptedCookieData msgBlob
 
 data DecodingError
   = InvalidCookieFormat
@@ -59,6 +86,13 @@ decode :: Maybe Salt
 decode mbSalt secretKeyBase cookie =
   either (const Nothing) Just (decodeEither mbSalt secretKeyBase cookie)
 
+parseCookieData :: JSON.Value -> Either String DecryptedCookieData
+parseCookieData jsonBlob = case JSON.parseEither JSON.parseJSON jsonBlob of
+  Left e
+    -> Left e
+  Right (RailsDecryptedCookie payload)
+    -> Right payload
+
 -- | Decode a cookie encrypted by Rails and retain some error information on failure.
 decodeEither :: Maybe Salt
              -> SecretKeyBase