{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Web.Rails.Session (
decode
, decodeEither
, decrypt
, csrfToken
, sessionId
, lookupString
, lookupFixnum
, 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)
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)
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)
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)
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)
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)
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)
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)
mkCookie :: ByteString -> Cookie
mkCookie :: ByteString -> Cookie
mkCookie = ByteString -> Cookie
Cookie
mkSalt :: ByteString -> Salt
mkSalt :: ByteString -> Salt
mkSalt = ByteString -> Salt
Salt
mkSecretKeyBase :: ByteString -> SecretKeyBase
mkSecretKeyBase :: ByteString -> SecretKeyBase
mkSecretKeyBase = ByteString -> SecretKeyBase
SecretKeyBase
unwrapDecryptedData :: DecryptedData -> ByteString
unwrapDecryptedData :: DecryptedData -> ByteString
unwrapDecryptedData (DecryptedData ByteString
deData) =
ByteString
deData
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)
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
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"
csrfToken :: RubyObject -> Maybe ByteString
csrfToken :: RubyObject -> Maybe ByteString
csrfToken = ByteString -> RubyStringEncoding -> RubyObject -> Maybe ByteString
lookupString ByteString
"_csrf_token" RubyStringEncoding
US_ASCII
sessionId :: RubyObject -> Maybe ByteString
sessionId :: RubyObject -> Maybe ByteString
sessionId = ByteString -> RubyStringEncoding -> RubyObject -> Maybe ByteString
lookupString ByteString
"session_id" RubyStringEncoding
UTF_8
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
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
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 :: 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 :: 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