hs-php-session 0.0.9.1 → 0.0.9.2

raw patch · 4 files changed

+202/−85 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Data/PHPSession.hs +106/−64
• Data/PHPSession/Types.hs +59/−1
• Test/General.hs +36/−19
• hs-php-session.cabal +1/−1

@@ -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. --

@@ -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+  

@@ -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

@@ -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