{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Web.Rails.Session (
  -- * Decoding
    decode
  , decodeEither
  -- * Decrypting
  , decrypt
  -- * Utilities
  , csrfToken
  , sessionId
  , lookupString
  , lookupFixnum
  -- * Lifting weaker types into stronger types
  , Cookie
  , mkCookie
  , Salt
  , mkSalt
  , SecretKeyBase
  , mkSecretKeyBase
  , DecryptedData
  , unwrapDecryptedData
  ) 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

-- | Wrapper around data after it has been decrypted.
newtype DecryptedData =
  DecryptedData ByteString
  deriving (Int -> DecryptedData -> ShowS
[DecryptedData] -> ShowS
DecryptedData -> String
(Int -> DecryptedData -> ShowS)
-> (DecryptedData -> String)
-> ([DecryptedData] -> ShowS)
-> Show DecryptedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecryptedData] -> ShowS
$cshowList :: [DecryptedData] -> ShowS
show :: DecryptedData -> String
$cshow :: DecryptedData -> String
showsPrec :: Int -> DecryptedData -> ShowS
$cshowsPrec :: Int -> DecryptedData -> ShowS
Show, Eq DecryptedData
Eq DecryptedData
-> (DecryptedData -> DecryptedData -> Ordering)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> DecryptedData)
-> (DecryptedData -> DecryptedData -> DecryptedData)
-> Ord DecryptedData
DecryptedData -> DecryptedData -> Bool
DecryptedData -> DecryptedData -> Ordering
DecryptedData -> DecryptedData -> DecryptedData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DecryptedData -> DecryptedData -> DecryptedData
$cmin :: DecryptedData -> DecryptedData -> DecryptedData
max :: DecryptedData -> DecryptedData -> DecryptedData
$cmax :: DecryptedData -> DecryptedData -> DecryptedData
>= :: DecryptedData -> DecryptedData -> Bool
$c>= :: DecryptedData -> DecryptedData -> Bool
> :: DecryptedData -> DecryptedData -> Bool
$c> :: DecryptedData -> DecryptedData -> Bool
<= :: DecryptedData -> DecryptedData -> Bool
$c<= :: DecryptedData -> DecryptedData -> Bool
< :: DecryptedData -> DecryptedData -> Bool
$c< :: DecryptedData -> DecryptedData -> Bool
compare :: DecryptedData -> DecryptedData -> Ordering
$ccompare :: DecryptedData -> DecryptedData -> Ordering
$cp1Ord :: Eq DecryptedData
Ord, DecryptedData -> DecryptedData -> Bool
(DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool) -> Eq DecryptedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecryptedData -> DecryptedData -> Bool
$c/= :: DecryptedData -> DecryptedData -> Bool
== :: DecryptedData -> DecryptedData -> Bool
$c== :: DecryptedData -> DecryptedData -> Bool
Eq)

-- | Wrapper around data before it has been decrypted.
newtype EncryptedData =
  EncryptedData ByteString
  deriving (Int -> EncryptedData -> ShowS
[EncryptedData] -> ShowS
EncryptedData -> String
(Int -> EncryptedData -> ShowS)
-> (EncryptedData -> String)
-> ([EncryptedData] -> ShowS)
-> Show EncryptedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptedData] -> ShowS
$cshowList :: [EncryptedData] -> ShowS
show :: EncryptedData -> String
$cshow :: EncryptedData -> String
showsPrec :: Int -> EncryptedData -> ShowS
$cshowsPrec :: Int -> EncryptedData -> ShowS
Show, Eq EncryptedData
Eq EncryptedData
-> (EncryptedData -> EncryptedData -> Ordering)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> EncryptedData)
-> (EncryptedData -> EncryptedData -> EncryptedData)
-> Ord EncryptedData
EncryptedData -> EncryptedData -> Bool
EncryptedData -> EncryptedData -> Ordering
EncryptedData -> EncryptedData -> EncryptedData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EncryptedData -> EncryptedData -> EncryptedData
$cmin :: EncryptedData -> EncryptedData -> EncryptedData
max :: EncryptedData -> EncryptedData -> EncryptedData
$cmax :: EncryptedData -> EncryptedData -> EncryptedData
>= :: EncryptedData -> EncryptedData -> Bool
$c>= :: EncryptedData -> EncryptedData -> Bool
> :: EncryptedData -> EncryptedData -> Bool
$c> :: EncryptedData -> EncryptedData -> Bool
<= :: EncryptedData -> EncryptedData -> Bool
$c<= :: EncryptedData -> EncryptedData -> Bool
< :: EncryptedData -> EncryptedData -> Bool
$c< :: EncryptedData -> EncryptedData -> Bool
compare :: EncryptedData -> EncryptedData -> Ordering
$ccompare :: EncryptedData -> EncryptedData -> Ordering
$cp1Ord :: Eq EncryptedData
Ord, EncryptedData -> EncryptedData -> Bool
(EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool) -> Eq EncryptedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptedData -> EncryptedData -> Bool
$c/= :: EncryptedData -> EncryptedData -> Bool
== :: EncryptedData -> EncryptedData -> Bool
$c== :: EncryptedData -> EncryptedData -> Bool
Eq)

-- | Wrapper around initialisation vector.
newtype InitVector =
  InitVector ByteString
  deriving (Int -> InitVector -> ShowS
[InitVector] -> ShowS
InitVector -> String
(Int -> InitVector -> ShowS)
-> (InitVector -> String)
-> ([InitVector] -> ShowS)
-> Show InitVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitVector] -> ShowS
$cshowList :: [InitVector] -> ShowS
show :: InitVector -> String
$cshow :: InitVector -> String
showsPrec :: Int -> InitVector -> ShowS
$cshowsPrec :: Int -> InitVector -> ShowS
Show, Eq InitVector
Eq InitVector
-> (InitVector -> InitVector -> Ordering)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> InitVector)
-> (InitVector -> InitVector -> InitVector)
-> Ord InitVector
InitVector -> InitVector -> Bool
InitVector -> InitVector -> Ordering
InitVector -> InitVector -> InitVector
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InitVector -> InitVector -> InitVector
$cmin :: InitVector -> InitVector -> InitVector
max :: InitVector -> InitVector -> InitVector
$cmax :: InitVector -> InitVector -> InitVector
>= :: InitVector -> InitVector -> Bool
$c>= :: InitVector -> InitVector -> Bool
> :: InitVector -> InitVector -> Bool
$c> :: InitVector -> InitVector -> Bool
<= :: InitVector -> InitVector -> Bool
$c<= :: InitVector -> InitVector -> Bool
< :: InitVector -> InitVector -> Bool
$c< :: InitVector -> InitVector -> Bool
compare :: InitVector -> InitVector -> Ordering
$ccompare :: InitVector -> InitVector -> Ordering
$cp1Ord :: Eq InitVector
Ord, InitVector -> InitVector -> Bool
(InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool) -> Eq InitVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitVector -> InitVector -> Bool
$c/= :: InitVector -> InitVector -> Bool
== :: InitVector -> InitVector -> Bool
$c== :: InitVector -> InitVector -> Bool
Eq)

-- | Wrapper around raw cookie.
newtype Cookie =
  Cookie ByteString
  deriving (Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cookie] -> ShowS
$cshowList :: [Cookie] -> ShowS
show :: Cookie -> String
$cshow :: Cookie -> String
showsPrec :: Int -> Cookie -> ShowS
$cshowsPrec :: Int -> Cookie -> ShowS
Show, Eq Cookie
Eq Cookie
-> (Cookie -> Cookie -> Ordering)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Cookie)
-> (Cookie -> Cookie -> Cookie)
-> Ord Cookie
Cookie -> Cookie -> Bool
Cookie -> Cookie -> Ordering
Cookie -> Cookie -> Cookie
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cookie -> Cookie -> Cookie
$cmin :: Cookie -> Cookie -> Cookie
max :: Cookie -> Cookie -> Cookie
$cmax :: Cookie -> Cookie -> Cookie
>= :: Cookie -> Cookie -> Bool
$c>= :: Cookie -> Cookie -> Bool
> :: Cookie -> Cookie -> Bool
$c> :: Cookie -> Cookie -> Bool
<= :: Cookie -> Cookie -> Bool
$c<= :: Cookie -> Cookie -> Bool
< :: Cookie -> Cookie -> Bool
$c< :: Cookie -> Cookie -> Bool
compare :: Cookie -> Cookie -> Ordering
$ccompare :: Cookie -> Cookie -> Ordering
$cp1Ord :: Eq Cookie
Ord, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c== :: Cookie -> Cookie -> Bool
Eq)

-- | Wrapper around salt.
newtype Salt =
  Salt ByteString
  deriving (Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> String
(Int -> Salt -> ShowS)
-> (Salt -> String) -> ([Salt] -> ShowS) -> Show Salt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Salt] -> ShowS
$cshowList :: [Salt] -> ShowS
show :: Salt -> String
$cshow :: Salt -> String
showsPrec :: Int -> Salt -> ShowS
$cshowsPrec :: Int -> Salt -> ShowS
Show, Eq Salt
Eq Salt
-> (Salt -> Salt -> Ordering)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> Ord Salt
Salt -> Salt -> Bool
Salt -> Salt -> Ordering
Salt -> Salt -> Salt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Salt -> Salt -> Salt
$cmin :: Salt -> Salt -> Salt
max :: Salt -> Salt -> Salt
$cmax :: Salt -> Salt -> Salt
>= :: Salt -> Salt -> Bool
$c>= :: Salt -> Salt -> Bool
> :: Salt -> Salt -> Bool
$c> :: Salt -> Salt -> Bool
<= :: Salt -> Salt -> Bool
$c<= :: Salt -> Salt -> Bool
< :: Salt -> Salt -> Bool
$c< :: Salt -> Salt -> Bool
compare :: Salt -> Salt -> Ordering
$ccompare :: Salt -> Salt -> Ordering
$cp1Ord :: Eq Salt
Ord, Salt -> Salt -> Bool
(Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c== :: Salt -> Salt -> Bool
Eq)

-- | Wrapper around secret.
newtype SecretKey =
  SecretKey ByteString
  deriving (Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKey] -> ShowS
$cshowList :: [SecretKey] -> ShowS
show :: SecretKey -> String
$cshow :: SecretKey -> String
showsPrec :: Int -> SecretKey -> ShowS
$cshowsPrec :: Int -> SecretKey -> ShowS
Show, Eq SecretKey
Eq SecretKey
-> (SecretKey -> SecretKey -> Ordering)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> SecretKey)
-> (SecretKey -> SecretKey -> SecretKey)
-> Ord SecretKey
SecretKey -> SecretKey -> Bool
SecretKey -> SecretKey -> Ordering
SecretKey -> SecretKey -> SecretKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SecretKey -> SecretKey -> SecretKey
$cmin :: SecretKey -> SecretKey -> SecretKey
max :: SecretKey -> SecretKey -> SecretKey
$cmax :: SecretKey -> SecretKey -> SecretKey
>= :: SecretKey -> SecretKey -> Bool
$c>= :: SecretKey -> SecretKey -> Bool
> :: SecretKey -> SecretKey -> Bool
$c> :: SecretKey -> SecretKey -> Bool
<= :: SecretKey -> SecretKey -> Bool
$c<= :: SecretKey -> SecretKey -> Bool
< :: SecretKey -> SecretKey -> Bool
$c< :: SecretKey -> SecretKey -> Bool
compare :: SecretKey -> SecretKey -> Ordering
$ccompare :: SecretKey -> SecretKey -> Ordering
$cp1Ord :: Eq SecretKey
Ord, SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c== :: SecretKey -> SecretKey -> Bool
Eq)

-- | Wrapper around secret key base.
newtype SecretKeyBase =
  SecretKeyBase ByteString
  deriving (Int -> SecretKeyBase -> ShowS
[SecretKeyBase] -> ShowS
SecretKeyBase -> String
(Int -> SecretKeyBase -> ShowS)
-> (SecretKeyBase -> String)
-> ([SecretKeyBase] -> ShowS)
-> Show SecretKeyBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKeyBase] -> ShowS
$cshowList :: [SecretKeyBase] -> ShowS
show :: SecretKeyBase -> String
$cshow :: SecretKeyBase -> String
showsPrec :: Int -> SecretKeyBase -> ShowS
$cshowsPrec :: Int -> SecretKeyBase -> ShowS
Show, Eq SecretKeyBase
Eq SecretKeyBase
-> (SecretKeyBase -> SecretKeyBase -> Ordering)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> SecretKeyBase)
-> (SecretKeyBase -> SecretKeyBase -> SecretKeyBase)
-> Ord SecretKeyBase
SecretKeyBase -> SecretKeyBase -> Bool
SecretKeyBase -> SecretKeyBase -> Ordering
SecretKeyBase -> SecretKeyBase -> SecretKeyBase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
$cmin :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
max :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
$cmax :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
>= :: SecretKeyBase -> SecretKeyBase -> Bool
$c>= :: SecretKeyBase -> SecretKeyBase -> Bool
> :: SecretKeyBase -> SecretKeyBase -> Bool
$c> :: SecretKeyBase -> SecretKeyBase -> Bool
<= :: SecretKeyBase -> SecretKeyBase -> Bool
$c<= :: SecretKeyBase -> SecretKeyBase -> Bool
< :: SecretKeyBase -> SecretKeyBase -> Bool
$c< :: SecretKeyBase -> SecretKeyBase -> Bool
compare :: SecretKeyBase -> SecretKeyBase -> Ordering
$ccompare :: SecretKeyBase -> SecretKeyBase -> Ordering
$cp1Ord :: Eq SecretKeyBase
Ord, SecretKeyBase -> SecretKeyBase -> Bool
(SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool) -> Eq SecretKeyBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKeyBase -> SecretKeyBase -> Bool
$c/= :: SecretKeyBase -> SecretKeyBase -> Bool
== :: SecretKeyBase -> SecretKeyBase -> Bool
$c== :: SecretKeyBase -> SecretKeyBase -> Bool
Eq)

-- SMART CONSTRUCTORS

-- | Lift a cookie into a richer type.
mkCookie :: ByteString -> Cookie
mkCookie :: ByteString -> Cookie
mkCookie = ByteString -> Cookie
Cookie

-- | Lift salt into a richer type.
mkSalt :: ByteString -> Salt
mkSalt :: ByteString -> Salt
mkSalt = ByteString -> Salt
Salt

-- | Lifts secret into a richer type.
mkSecretKeyBase :: ByteString -> SecretKeyBase
mkSecretKeyBase :: ByteString -> SecretKeyBase
mkSecretKeyBase = ByteString -> SecretKeyBase
SecretKeyBase

-- SMART DESTRUCTORS

unwrapDecryptedData :: DecryptedData -> ByteString
unwrapDecryptedData :: DecryptedData -> ByteString
unwrapDecryptedData (DecryptedData ByteString
deData) =
  ByteString
deData

-- EXPORTS

-- | Decode a cookie encrypted by Rails.
decode :: Maybe Salt
       -> SecretKeyBase
       -> Cookie
       -> Maybe RubyObject
decode :: Maybe Salt -> SecretKeyBase -> Cookie -> Maybe RubyObject
decode Maybe Salt
mbSalt SecretKeyBase
secretKeyBase Cookie
cookie =
  (String -> Maybe RubyObject)
-> (RubyObject -> Maybe RubyObject)
-> Either String RubyObject
-> Maybe RubyObject
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe RubyObject -> String -> Maybe RubyObject
forall a b. a -> b -> a
const Maybe RubyObject
forall a. Maybe a
Nothing) RubyObject -> Maybe RubyObject
forall a. a -> Maybe a
Just (Maybe Salt -> SecretKeyBase -> Cookie -> Either String RubyObject
decodeEither Maybe Salt
mbSalt SecretKeyBase
secretKeyBase Cookie
cookie)

-- | Decode a cookie encrypted by Rails and retain some error information on failure.
decodeEither :: Maybe Salt
             -> SecretKeyBase
             -> Cookie
             -> Either String RubyObject
decodeEither :: Maybe Salt -> SecretKeyBase -> Cookie -> Either String RubyObject
decodeEither Maybe Salt
mbSalt SecretKeyBase
secretKeyBase Cookie
cookie = do
  case Maybe Salt
-> SecretKeyBase -> Cookie -> Either String DecryptedData
decrypt Maybe Salt
mbSalt SecretKeyBase
secretKeyBase Cookie
cookie of
    Left String
errorMessage ->
      String -> Either String RubyObject
forall a b. a -> Either a b
Left String
errorMessage
    Right (DecryptedData ByteString
deData) ->
      ByteString -> Either String RubyObject
Ruby.decodeEither ByteString
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 :: Maybe Salt
-> SecretKeyBase -> Cookie -> Either String DecryptedData
decrypt Maybe Salt
mbSalt SecretKeyBase
secretKeyBase Cookie
cookie =
  let salt :: Salt
salt = Salt -> Maybe Salt -> Salt
forall a. a -> Maybe a -> a
fromMaybe Salt
defaultSalt Maybe Salt
mbSalt
      (SecretKey ByteString
secret) = Salt -> SecretKeyBase -> SecretKey
generateSecret Salt
salt SecretKeyBase
secretKeyBase
      (EncryptedData ByteString
encData, InitVector ByteString
initVec) = Cookie -> (EncryptedData, InitVector)
prepare Cookie
cookie
  in case ByteString -> Maybe (IV AES256)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
initVec of
       Maybe (IV AES256)
Nothing ->
         String -> Either String DecryptedData
forall a b. a -> Either a b
Left (String -> Either String DecryptedData)
-> String -> Either String DecryptedData
forall a b. (a -> b) -> a -> b
$! String
"Failed to build init. vector for: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
initVec
       Just IV AES256
initVec' -> do
         let key :: ByteString
key = Int -> ByteString -> ByteString
BS.take Int
32 ByteString
secret
         case (ByteString -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
key :: CryptoFailable AES256) of
           CryptoFailed CryptoError
errorMessage ->
             String -> Either String DecryptedData
forall a b. a -> Either a b
Left (CryptoError -> String
forall a. Show a => a -> String
show CryptoError
errorMessage)
           CryptoPassed AES256
cipher ->
             DecryptedData -> Either String DecryptedData
forall a b. b -> Either a b
Right (DecryptedData -> Either String DecryptedData)
-> (ByteString -> DecryptedData)
-> ByteString
-> Either String DecryptedData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DecryptedData
DecryptedData (ByteString -> Either String DecryptedData)
-> ByteString -> Either String DecryptedData
forall a b. (a -> b) -> a -> b
$! AES256 -> IV AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt AES256
cipher IV AES256
initVec' ByteString
encData
  where
    defaultSalt :: Salt
    defaultSalt :: Salt
defaultSalt = ByteString -> Salt
Salt ByteString
"encrypted cookie"

-- UTIL

-- | Helper function for looking up the csrf token in a cooie.
csrfToken :: RubyObject -> Maybe ByteString
csrfToken :: RubyObject -> Maybe ByteString
csrfToken = ByteString -> RubyStringEncoding -> RubyObject -> Maybe ByteString
lookupString ByteString
"_csrf_token" RubyStringEncoding
US_ASCII

-- | Helper function for looking up the session id in a cookie.
sessionId :: RubyObject -> Maybe ByteString
sessionId :: RubyObject -> Maybe ByteString
sessionId = ByteString -> RubyStringEncoding -> RubyObject -> Maybe ByteString
lookupString ByteString
"session_id" RubyStringEncoding
UTF_8

-- | Lookup integer for a given key.
lookupFixnum :: ByteString -> RubyStringEncoding -> RubyObject -> Maybe Int
lookupFixnum :: ByteString -> RubyStringEncoding -> RubyObject -> Maybe Int
lookupFixnum ByteString
key RubyStringEncoding
enc RubyObject
rubyObject =
  case RubyObject -> RubyObject -> Maybe RubyObject
lookup ((RubyObject, RubyStringEncoding) -> RubyObject
RIVar (ByteString -> RubyObject
RString ByteString
key, RubyStringEncoding
enc)) RubyObject
rubyObject of
    Just (RFixnum Int
val) ->
      Int -> Maybe Int
forall a. a -> Maybe a
Just Int
val
    Maybe RubyObject
_ ->
      Maybe Int
forall a. Maybe a
Nothing

-- | Lookup string for a given key and throw away encoding information.
lookupString :: ByteString
             -> RubyStringEncoding
             -> RubyObject
             -> Maybe ByteString
lookupString :: ByteString -> RubyStringEncoding -> RubyObject -> Maybe ByteString
lookupString ByteString
key RubyStringEncoding
enc RubyObject
rubyObject =
  case RubyObject -> RubyObject -> Maybe RubyObject
lookup ((RubyObject, RubyStringEncoding) -> RubyObject
RIVar (ByteString -> RubyObject
RString ByteString
key, RubyStringEncoding
enc)) RubyObject
rubyObject of
    Just (RIVar (RString ByteString
val, RubyStringEncoding
_)) ->
      ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
val
    Maybe RubyObject
_ ->
      Maybe ByteString
forall a. Maybe a
Nothing

-- PRIVATE

-- | Generate secret key using same cryptographic routines as Rails.
generateSecret :: Salt -> SecretKeyBase -> SecretKey
generateSecret :: Salt -> SecretKeyBase -> SecretKey
generateSecret (Salt ByteString
salt) (SecretKeyBase ByteString
secret) =
  ByteString -> SecretKey
SecretKey (ByteString -> SecretKey) -> ByteString -> SecretKey
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> Int -> Int -> ByteString
sha1PBKDF2 ByteString
secret ByteString
salt Int
1000 Int
64

-- | Prepare a cookie for decryption.
prepare :: Cookie -> (EncryptedData, InitVector)
prepare :: Cookie -> (EncryptedData, InitVector)
prepare (Cookie ByteString
cookie) =
  Bool -> ByteString -> ByteString
urlDecode Bool
True ByteString
cookie
  ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ((ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
split)
  ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
base64decode
  ByteString
-> (ByteString -> (ByteString, ByteString))
-> (ByteString, ByteString)
forall a b. a -> (a -> b) -> b
& ByteString -> (ByteString, ByteString)
split
  (ByteString, ByteString)
-> ((ByteString, ByteString) -> (EncryptedData, InitVector))
-> (EncryptedData, InitVector)
forall a b. a -> (a -> b) -> b
& (\(ByteString
x, ByteString
y) -> (ByteString -> EncryptedData
EncryptedData (ByteString -> ByteString
base64decode ByteString
x), ByteString -> InitVector
InitVector (ByteString -> ByteString
base64decode ByteString
y)))
  where
    base64decode :: ByteString -> ByteString
    base64decode :: ByteString -> ByteString
base64decode = ByteString -> ByteString
B64.decodeLenient

    separator :: ByteString
    separator :: ByteString
separator = ByteString
"--"

    split :: ByteString -> (ByteString, ByteString)
    split :: ByteString -> (ByteString, ByteString)
split = ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
separator

-- | Lookup value for a given key.
lookup :: RubyObject -> RubyObject -> Maybe RubyObject
lookup :: RubyObject -> RubyObject -> Maybe RubyObject
lookup RubyObject
key (RHash Vector (RubyObject, RubyObject)
vec) = (RubyObject, RubyObject) -> RubyObject
forall a b. (a, b) -> b
snd ((RubyObject, RubyObject) -> RubyObject)
-> Maybe (RubyObject, RubyObject) -> Maybe RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((RubyObject, RubyObject) -> Bool)
-> Vector (RubyObject, RubyObject)
-> Maybe (RubyObject, RubyObject)
forall a. (a -> Bool) -> Vector a -> Maybe a
Vec.find (\(RubyObject, RubyObject)
element -> (RubyObject, RubyObject) -> RubyObject
forall a b. (a, b) -> a
fst (RubyObject, RubyObject)
element RubyObject -> RubyObject -> Bool
forall a. Eq a => a -> a -> Bool
== RubyObject
key) Vector (RubyObject, RubyObject)
vec
lookup RubyObject
_ RubyObject
_ = Maybe RubyObject
forall a. Maybe a
Nothing