diff --git a/Data/PHPSession.hs b/Data/PHPSession.hs --- a/Data/PHPSession.hs +++ b/Data/PHPSession.hs @@ -14,12 +14,15 @@ module Data.PHPSession ( -- * Decode from 'ByteString' decodePHPSession, + decodePHPSessionEither, decodePHPSessionValue, + decodePHPSessionValueEither, -- * Encode to 'ByteString' encodePHPSession, encodePHPSessionValue, -- * Decode only part of a 'ByteString' decodePartialPHPSessionValue, + decodePartialPHPSessionValueEither, -- * PHP session types PHPSessionVariableList, PHPSessionClassName (..), @@ -35,25 +38,36 @@ import qualified Data.Char as C import Data.List (foldl') --- import qualified Text.Regex.Posix as TR --- | Decodes a 'ByteString' containing a serialization of a list of session variables + +-- | Decodes a 'LBS.ByteString' containing a serialization of a list of session variables -- using the \"php\" session serialization format into a 'PHPSessionVariableList' +-- decodePHPSession :: LBS.ByteString -> Maybe PHPSessionVariableList decodePHPSession input = - case decodePHPSessionEachTopLevel input [] of - Nothing -> Nothing - Just (everything,"") -> Just everything - Just (_, _) -> Nothing + case decodePHPSessionEither input of + Left _ -> Nothing + Right result -> Just result + +-- | A version of 'decodePHPSession' that returns a 'PHPSessionDecodingError' when +-- decoding the 'LBS.ByteString' fails. +-- +decodePHPSessionEither :: LBS.ByteString -> Either PHPSessionDecodingError PHPSessionVariableList +decodePHPSessionEither input = + case decodePHPSessionEachTopLevelEither input [] of + Left err -> Left err + Right (everything,"") -> Right everything + Right (a, b) -> Left (PHPSessionNotFullyDecoded a b) + where - decodePHPSessionEachTopLevel input lst = + decodePHPSessionEachTopLevelEither input lst = case input of - "" -> Just (reverse lst,"") + "" -> Right (reverse lst,"") _ -> do (name, rest) <- decodePHPSessionTopLevelVarName input - (sym, rest') <- decodePartialPHPSessionValue rest - decodePHPSessionEachTopLevel rest' ((name, sym):lst) + (sym, rest') <- decodePartialPHPSessionValueEither rest + decodePHPSessionEachTopLevelEither rest' ((name, sym):lst) decodePHPSessionTopLevelVarName input = do (varname,n1) <- get_name_until_vertbar input @@ -61,8 +75,11 @@ return (varname, n2) get_name_until_vertbar input = case LBS.takeWhile (/= '|') input of - l -> Just (l, LBS.drop (LBS.length l) input) - get_vertbar input = case LBS.take 1 input of "|" -> Just ("|", LBS.drop 1 input); _ -> Nothing + l -> Right (l, LBS.drop (LBS.length l) input) + get_vertbar input = + case LBS.take 1 input of + "|" -> Right ("|", LBS.drop 1 input) + _ -> Left $ PHPSessionCouldntDecodePast input -- Not exported and used by decodePartialPHPSessionValue @@ -79,7 +96,7 @@ decodePartialPHPSessionValuesNested rest (sym:lst) --- | Decodes a 'ByteString' containing a session serialization of a value into a +-- | Decodes a 'LBS.ByteString' containing a session serialization of a value into a -- 'PHPSessionValue'. The format being decoded is similar if not probably the same -- format used by PHP's serialize/unserialize functions. -- 'Nothing' is returned if the input bytestring could not be parsed correctly. @@ -90,8 +107,18 @@ Nothing -> Nothing Just (everything,"") -> Just everything Just (_, _) -> Nothing + +-- | A version of 'decodePHPSessionValue' that returns 'PHPSessionDecodingError' +-- when decoding the 'LBS.ByteString' fails. +-- +decodePHPSessionValueEither :: LBS.ByteString -> Either PHPSessionDecodingError PHPSessionValue +decodePHPSessionValueEither input = + case decodePartialPHPSessionValueEither input of + Left err -> Left err + Right (everything,"") -> Right everything + Right (a, b) -> Left (PHPSessionValueNotFullyDecoded a b) --- | Decodes as much of a 'ByteString' as needed into a 'PHPSessionValue' and returns +-- | Decodes as much of a 'LBS.ByteString' as needed into a 'PHPSessionValue' and returns -- the rest of the string. Decoding ends at either the end of the string or when the -- extent of the current nested structure is met when an extra closing curly brace is -- encountered. The format being decoded is similar if not probably the same @@ -99,111 +126,126 @@ -- 'Nothing' is returned if the input bytestring could not be parsed correctly. -- decodePartialPHPSessionValue :: LBS.ByteString -> Maybe (PHPSessionValue, LBS.ByteString) -decodePartialPHPSessionValue "" = Nothing decodePartialPHPSessionValue input = + decodePartialPHPSessionValueCommon input + (\a -> Just a) -- Successfully decoded + (\a -> Nothing) -- Could not decode + +-- | A version of 'decodePartialPHPSessionValue' that uses Either, on decoding error a +-- 'PHPSessionDecodingError' is returned. +-- +decodePartialPHPSessionValueEither :: LBS.ByteString -> Either PHPSessionDecodingError (PHPSessionValue, LBS.ByteString) +decodePartialPHPSessionValueEither input = + decodePartialPHPSessionValueCommon input + (\a -> Right a) -- Successfully decoded + (\b -> Left b) -- Could not decode + +decodePartialPHPSessionValueCommon :: + LBS.ByteString + -> ((PHPSessionValue, LBS.ByteString) -> dtype) + -> (PHPSessionDecodingError -> dtype) + -> dtype +decodePartialPHPSessionValueCommon "" done couldntDecode = + couldntDecode PHPSessionStringEmpty +decodePartialPHPSessionValueCommon input done couldntDecode = let sertype = LBS.take 1 input rest = LBS.drop 1 input in case sertype of -- "Object implementing Serializeable" (C) -- ex: hi|C:9:"ClassName":5:{harr}} - "C" -> do - (_classnamelen,cls',numrest) <- - dec_colon_integer_colon_dquote_classname_dquote_colon rest - --case rest TR.=~ (":[0-9]+:\"[A-Za-z0-9_]+\":" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of - -- ("",cls,numrest) -> - case LBS.span (/=':') numrest of + "C" -> + case do + (_classnamelen,cls',numrest) <- + dec_colon_integer_colon_dquote_classname_dquote_colon rest + case LBS.span (/=':') numrest of (num, colrest) -> - -- let [_,cls',_] = LBS.split '"' cls let num' = read (LBS.unpack num) (dat,rest') = LBS.splitAt num' $ LBS.drop 2 colrest rest'' = LBS.drop 1 rest' in Just (PHPSessionValueObjectSerializeable (PHPSessionClassName cls') dat, rest'') + of + Nothing -> couldntDecode (PHPSessionCouldntDecodeSerializablePast rest) + Just ok -> done ok -- Object (O) ex: hi|O:9:"ClassName":2:{s:4:"blah";i:1;s:3:"str";s:6:"string";} - "O" -> do - (_,cls',attrest) <- - dec_colon_integer_colon_dquote_classname_dquote rest - -- case rest TR.=~ (":[0-9]+:\"[A-Za-z0-9_]+\"" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of - let (l,rest') = decodePartialPHPSessionAttr attrest [] + "O" -> + case dec_colon_integer_colon_dquote_classname_dquote rest of + Nothing -> couldntDecode (PHPSessionCouldntDecodeObjectPast rest) + Just (_,cls',attrest) -> + let (l,rest') = decodePartialPHPSessionAttr attrest [] in case l of - Nothing -> Nothing -- , input) - Just [PHPSessionAttrInt _, PHPSessionAttrNested vals] -> + Left err -> couldntDecode err + Right [PHPSessionAttrInt _, PHPSessionAttrNested vals] -> let (al, bl) = L.partition (odd . snd) (zip vals [1..]) arlst = map (\[a,b] -> (a,b)) $ L.transpose [ map (\(a,_)->a) al, map (\(a,_)->a) bl ] - in Just ((PHPSessionValueObject (PHPSessionClassName cls') arlst),rest') + in done ((PHPSessionValueObject (PHPSessionClassName cls') arlst),rest') -- String (s) ex: hi|s:6:"string"; "s" -> do - (len, strrest) <- dec_colon_integer_colon_dquote rest - --case rest TR.=~ (":[0-9]+:\"" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of - -- ("",strlen,strrest) -> - -- let [_,len,_] = LBS.split ':' strlen - let len' = read (LBS.unpack len) - (str,rest') = LBS.splitAt len' $ strrest - rest'' = LBS.drop 2 rest' - in Just (PHPSessionValueString str,rest'') + case dec_colon_integer_colon_dquote rest of + Nothing -> couldntDecode (PHPSessionCouldntDecodeStringPast rest) + Just (len, strrest) -> + let len' = read (LBS.unpack len) + (str,rest') = LBS.splitAt len' $ strrest + rest'' = LBS.drop 2 rest' + in done (PHPSessionValueString str,rest'') _ -> let (l,rest') = decodePartialPHPSessionAttr rest [] in case (sertype, l) of -- Array (a) ex: hi|a:3:{i:0;i:1;i:1;i:2;i:2;s:3:"abc";} - ("a",Just [PHPSessionAttrInt _, PHPSessionAttrNested vals]) -> + ("a",Right [PHPSessionAttrInt _, PHPSessionAttrNested vals]) -> let (al, bl) = L.partition (odd . snd) (zip vals [1..]) arlst = map (\[a,b] -> (a,b)) $ L.transpose [ map (\(a,_)->a) al, map (\(a,_)->a) bl ] - in Just (PHPSessionValueArray arlst, rest') + in done (PHPSessionValueArray arlst, rest') -- Boolean (b) ex: hi|b:0; = FALSE -- hi|b:1; = TRUE - ("b",Just [PHPSessionAttrInt 1]) -> Just (PHPSessionValueBool True,rest') - ("b",Just [PHPSessionAttrInt 0]) -> Just (PHPSessionValueBool False,rest') + ("b",Right [PHPSessionAttrInt 1]) -> done (PHPSessionValueBool True,rest') + ("b",Right [PHPSessionAttrInt 0]) -> done (PHPSessionValueBool False,rest') -- Float (d) ex: hi|d:0.1000000000000000055511151231257827021181583404541015625; - ("d",Just [PHPSessionAttrFloat num]) -> Just ((PHPSessionValueFloat $ Right num),rest') - ("d",Just [PHPSessionAttrInt num]) -> Just ((PHPSessionValueFloat $ Left num),rest') + ("d",Right [PHPSessionAttrFloat num]) -> done ((PHPSessionValueFloat $ Right num),rest') + ("d",Right [PHPSessionAttrInt num]) -> done ((PHPSessionValueFloat $ Left num),rest') -- Integer (i) ex: hi|i:26; - ("i",Just [PHPSessionAttrInt num]) -> Just (PHPSessionValueInt num,rest') + ("i",Right [PHPSessionAttrInt num]) -> done (PHPSessionValueInt num,rest') -- Null (N) ex: hi|N; - ("N",Just []) -> Just (PHPSessionValueNull,rest') + ("N",Right []) -> done (PHPSessionValueNull,rest') -- Recursive values and references (r), (R), TODO: PHP 6 encoded String (S) _ -> case l of - Just l' -> Just ((PHPSessionValueMisc sertype l'),rest') - Nothing -> Nothing -- , input) + Right l' -> done ((PHPSessionValueMisc sertype l'),rest') + Left err -> couldntDecode err where - decodePartialPHPSessionAttr :: LBS.ByteString -> [PHPSessionAttr] -> (Maybe [PHPSessionAttr],LBS.ByteString) + decodePartialPHPSessionAttr :: LBS.ByteString -> [PHPSessionAttr] -> (Either PHPSessionDecodingError [PHPSessionAttr],LBS.ByteString) decodePartialPHPSessionAttr input l = case LBS.take 1 input of ";" -> - (Just $ reverse l,LBS.drop 1 input) + (Right $ reverse l,LBS.drop 1 input) _ -> case dec_colon_and_number input of Just (num,rest) -> - --case input TR.=~ (":[-0-9.]+" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of - -- ("",num,rest) -> - let num' = LBS.unpack $ num -- LBS.drop 1 + let num' = LBS.unpack num in case LBS.elem '.' num of True -> - decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ read $ num'):l) + decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ read num'):l) False -> - decodePartialPHPSessionAttr rest ((PHPSessionAttrInt $ read $ num'):l) + decodePartialPHPSessionAttr rest ((PHPSessionAttrInt $ read num'):l) Nothing -> case dec_colon_and_open_curly input of Just (":{", rest) -> - -- case input TR.=~ (":{" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of - -- ("",":{",rest) -> - let Just (sub,rest') = decodePartialPHPSessionValuesNested rest [] - in (Just $ reverse (PHPSessionAttrNested sub:l),rest') + let Just (sub,rest') = decodePartialPHPSessionValuesNested rest [] + in (Right $ reverse (PHPSessionAttrNested sub:l),rest') Nothing -> case dec_colon_uppercase_letters input of Just ("NAN", rest) -> decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ 0/0):l) Just ("INF", rest) -> decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ 1/0):l) Just ("-INF", rest) -> decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ -1/0):l) Nothing -> - error $ show input - -- (Nothing, input) - -- error "No good" + (Left $ PHPSessionCouldntDecodePast input, input) + dec_colon_integer_colon_dquote_classname_dquote_colon input = do (_0,n0) <- dec_get_colon input (len,n1) <- dec_get_integer n0 @@ -278,7 +320,7 @@ dec_get_dash input = case LBS.take 1 input of "-" -> Just ("-", LBS.drop 1 input); _ -> Nothing dec_get_dot input = case LBS.take 1 input of "." -> Just (".", LBS.drop 1 input); _ -> Nothing --- | Encode a 'PHPSessionVariableList' into a 'ByteString' containing the serialization +-- | Encode a 'PHPSessionVariableList' into a 'LBS.ByteString' containing the serialization -- of a list of session variables using the \"php\" session serialization format. encodePHPSession :: PHPSessionVariableList -> LBS.ByteString encodePHPSession lst = @@ -294,7 +336,7 @@ encodePHPSessionVarName name = LBS.concat [name, "|"] --- | Encode a 'PHPSessionValue' into a 'ByteString' containing the serialization of a +-- | Encode a 'PHPSessionValue' into a 'LBS.ByteString' containing the serialization of a -- PHP value. The format being encoded into is similar if not probably the same -- format used by PHP's serialize/unserialize functions. -- diff --git a/Data/PHPSession/Types.hs b/Data/PHPSession/Types.hs --- a/Data/PHPSession/Types.hs +++ b/Data/PHPSession/Types.hs @@ -15,7 +15,8 @@ PHPSessionVariableList, PHPSessionClassName (..), PHPSessionValue (..), - PHPSessionAttr (..) + PHPSessionAttr (..), + PHPSessionDecodingError (..) ) where import qualified Data.ByteString.Lazy.Char8 as LBS @@ -127,3 +128,60 @@ PHPSessionAttrNested a == PHPSessionAttrNested b = a == b _ == _ = False + +-- | 'PHPSessionDecodingError' are error types that can be returned if decoding +-- did not succeed. They are returned by the 'Either' versions of the decoding +-- functions. +-- +-- * 'PHPSessionStringEmpty' is given if the decoder got an empty byte sequence. +-- +-- * 'PHPSessionCouldntDecodeSerializablePast' is given if the decoding does not +-- succeed while in the particular byte sequence for a class that implements +-- Serializable. +-- +-- * 'PHPSessionCouldntDecodeObjectPast' is given if the decoding does not succeed +-- while in the particular byte sequence for a PHP object value. +-- +-- * 'PHPSessionCouldntDecodeStringPast' is given if the decoding does not succeed +-- while in the particular byte sequence for a PHP string. +-- +-- * 'PHPSessionCouldntDecodePast' is given if the decoding does not succeed while +-- decoding common byte sequences which are composed mainly of 'PHPSessionAttr' +-- forms. +-- +-- * 'PHPSessionValueNotFullyDecoded' is given if the byte sequence is not fully +-- decoded to a 'PHPSessionValue' when using decodePHPSessionValue or +-- decodePHPSessionValueEither. +-- +-- * 'PHPSessionNotFullyDecoded' is given.if the byte sequence is not fully +-- decoded to a 'PHPSessionVariableList' when using decodePHPSession or +-- decodePHPSessionEither. +-- +data PHPSessionDecodingError = + PHPSessionStringEmpty | + PHPSessionCouldntDecodeSerializablePast LBS.ByteString | + PHPSessionCouldntDecodeObjectPast LBS.ByteString | + PHPSessionCouldntDecodeStringPast LBS.ByteString | + PHPSessionCouldntDecodePast LBS.ByteString | + PHPSessionValueNotFullyDecoded PHPSessionValue LBS.ByteString | + PHPSessionNotFullyDecoded PHPSessionVariableList LBS.ByteString + +instance Show PHPSessionDecodingError where + show (PHPSessionStringEmpty) = "PHPSessionStringEmpty" + show (PHPSessionCouldntDecodeSerializablePast str) = "PHPSessionCouldntDecodeSerializablePast " ++ show str + show (PHPSessionCouldntDecodeObjectPast str) = "PHPSessionCouldntDecodeObjectPast " ++ show str + show (PHPSessionCouldntDecodeStringPast str) = "PHPSessionCouldntDecodeStringPast " ++ show str + show (PHPSessionCouldntDecodePast str) = "PHPSessionCouldntDecodePast " ++ show str + show (PHPSessionValueNotFullyDecoded val str) = "PHPSessionNotFullyDecoded " ++ show val ++ " ... " ++ show str + show (PHPSessionNotFullyDecoded val str) = "PHPSessionNotFullyDecoded " ++ show val ++ " ... " ++ show str + +instance Eq PHPSessionDecodingError where + PHPSessionStringEmpty == PHPSessionStringEmpty = True + PHPSessionCouldntDecodeSerializablePast str == PHPSessionCouldntDecodeSerializablePast str' = str == str' + PHPSessionCouldntDecodeObjectPast str == PHPSessionCouldntDecodeObjectPast str' = str == str' + PHPSessionCouldntDecodeStringPast str == PHPSessionCouldntDecodeStringPast str' = str == str' + PHPSessionCouldntDecodePast str == PHPSessionCouldntDecodePast str' = str == str' + PHPSessionValueNotFullyDecoded a b == PHPSessionValueNotFullyDecoded a' b' = a == a' && b == b' + PHPSessionNotFullyDecoded a b == PHPSessionNotFullyDecoded a' b' = a == a' && b == b' + _ == _ = False + diff --git a/Test/General.hs b/Test/General.hs --- a/Test/General.hs +++ b/Test/General.hs @@ -9,30 +9,47 @@ -- {-# LANGUAGE OverloadedStrings #-} -module Test.General where +module Test.General (testcases, testcasesWith) where import Data.PHPSession import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.List as L --- import qualified Text.Regex.Posix as TR import Data.List (foldl') +import System.IO -testcases :: Bool -testcases = - let test1 = "v1|s:94:\" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}\";v2|a:3:{i:0;i:10;i:1;i:9;i:2;s:5:\"eight\";}v3|C:9:\"ClassName\":94:{ !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}}v4|b:1;v5|i:10;v6|d:5.5;v7|N;" - test2 = "v1|a:3:{i:0;i:10;i:1;i:9;i:2;a:3:{i:0;i:8;i:1;i:7;i:2;a:3:{i:0;i:6;i:1;s:4:\"five\";i:2;d:4;}}}v2|O:9:\"ClassName\":2:{s:4:\"blah\";i:1;s:3:\"str\";s:94:\" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}\";}" - test3 = "v1|s:256:\"00000000000000000000000000000000 !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\";" - test4 = "teststr1|s:0:\"\";test_array|a:1:{i:0;a:2:{s:4:\"ABCD\";s:9:\"987654321\";s:0:\"\";b:1;}}test_int|i:1;teststr2|s:4:\"1234\";" - test5 = "testfloat1|d:1.00001121;testfloat2|d:NAN;testfloat3|d:INF;testfloat4|d:-INF;" - tresults = map (\test -> case decodePHPSession test of - Nothing -> False - Just dec -> let result = encodePHPSession dec in - if result == test - then True - else error $ "Not same: " ++ LBS.unpack test ++ " and " ++ LBS.unpack result) - [test1,test2,test3,test4,test5] - fresults = map (\test -> case decodePHPSession test of Nothing -> False; Just dec -> let result = encodePHPSession dec in result == test) - [] - in and tresults && ((or fresults) /= True) +test1 = "v1|s:94:\" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}\";v2|a:3:{i:0;i:10;i:1;i:9;i:2;s:5:\"eight\";}v3|C:9:\"ClassName\":94:{ !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}}v4|b:1;v5|i:10;v6|d:5.5;v7|N;" +test2 = "v1|a:3:{i:0;i:10;i:1;i:9;i:2;a:3:{i:0;i:8;i:1;i:7;i:2;a:3:{i:0;i:6;i:1;s:4:\"five\";i:2;d:4;}}}v2|O:9:\"ClassName\":2:{s:4:\"blah\";i:1;s:3:\"str\";s:94:\" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}\";}" +test3 = "v1|s:256:\"00000000000000000000000000000000 !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\";" +test4 = "teststr1|s:0:\"\";test_array|a:1:{i:0;a:2:{s:4:\"ABCD\";s:9:\"987654321\";s:0:\"\";b:1;}}test_int|i:1;teststr2|s:4:\"1234\";" +test5 = "testfloat1|d:1.00001121;testfloat2|d:NAN;testfloat3|d:INF;testfloat4|d:-INF;" + +testcases :: IO Bool +testcases = do + testcasesWith (\message -> hPutStrLn stderr message) + +testcasesWith :: (String -> IO ()) -> IO Bool +testcasesWith issue = do + let tresults = map testDecodeAndReencode [test1,test2,test3,test4,test5] + fresults = map testDecodeOnly [] + tresults' <- mapM issueIfDidntDecodedAndReencoded tresults + fresults' <- mapM issueIfDecodedAndReencodedWhenItShouldnt fresults + return $ and tresults' && ((or fresults') /= True) + where + issueIfDidntDecodedAndReencoded a = + case a of + Left message -> issue message >> return False + Right b -> return b + issueIfDecodedAndReencodedWhenItShouldnt a = + case a of + Right decoded -> (issue $ "Decoded when it shouldnt " ++ (show decoded)) >> return False + Left b -> return True + testDecodeAndReencode test = + case decodePHPSessionEither test of + Left err -> Left (show err) + Right dec -> let result = encodePHPSession dec in + if result == test + then Right True + else Left $ "Not same: " ++ LBS.unpack test ++ " and " ++ LBS.unpack result + testDecodeOnly test = decodePHPSessionEither test diff --git a/hs-php-session.cabal b/hs-php-session.cabal --- a/hs-php-session.cabal +++ b/hs-php-session.cabal @@ -1,5 +1,5 @@ name: hs-php-session -version: 0.0.9.1 +version: 0.0.9.2 synopsis: PHP session and values serialization description: A library for encoding and decoding serialized PHP sessions in the format