packages feed

ruby-marshal (empty) → 0.0.1

raw patch · 8 files changed

+519/−0 lines, 8 filesdep +basedep +bytestringdep +cerealsetup-changed

Dependencies added: base, bytestring, cereal, containers, hspec, mtl, string-conv, vector

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Philip Cunningham++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ruby-marshal.cabal view
@@ -0,0 +1,66 @@+name:          ruby-marshal+version:       0.0.1+synopsis:      Parse a subset of Ruby objects serialised with Marshal.dump.+description:   Parse a subset of Ruby objects serialised with Marshal.dump.+homepage:      https://github.com/filib/ruby-marshal+license:       MIT+license-file:  LICENSE+author:        Philip Cunningham+maintainer:    hello@filib.io+category:      Data+build-type:    Simple+tested-with:   GHC == 7.8, GHC == 7.10+cabal-version: >= 1.10++Source-repository head+  type: git+  location: https://github.com/filib/ruby-marshal++flag developer+  default: False++library+  if flag(developer)+    ghc-options:+      -fprof-auto+      -rtsopts+  hs-source-dirs:+    src+  build-depends:+      base        >= 4.7 && < 5+    , cereal      >= 0.3.5.0 && < 0.5.0.0+    , bytestring  >= 0.9.0+    , containers  >= 0.5.0+    , string-conv >= 0.1+    , mtl         >= 2.2+    , vector      >= 0.10.0+  default-language:+    Haskell2010+  exposed-modules:+      Data.Ruby.Marshal+    , Data.Ruby.Marshal.Get+    , Data.Ruby.Marshal.Types+    , Data.Ruby.Marshal.Internal.Int++test-suite spec+  ghc-options:+    -Wall+  hs-source-dirs:+    src, test+  build-depends:+      base        >= 4.7 && < 5+    , cereal      >= 0.3.5.0 && < 0.5.0.0+    , bytestring  >= 0.9.0+    , containers  >= 0.5.0.0+    , hspec+    , mtl         >= 2.2+    , string-conv >= 0.1+    , vector      >= 0.10.0+  default-language:+    Haskell2010+  other-modules:+    Spec+  main-is:+    Spec.hs+  type:+    exitcode-stdio-1.0
+ src/Data/Ruby/Marshal.hs view
@@ -0,0 +1,55 @@+--------------------------------------------------------------------+-- |+-- Module    : Data.Ruby.Marshal+-- Copyright : (c) Philip Cunningham, 2015+-- License   : MIT+--+-- Maintainer:  hello@filib.io+-- Stability :  experimental+-- Portability: portable+--+-- Simple interface to deserialise Ruby Marshal binary.+--+--------------------------------------------------------------------++module Data.Ruby.Marshal (+  -- * Simple interface to deserialise Ruby Marshal binary+    decode+  , decodeEither+  -- * Re-exported modules+  , module Data.Ruby.Marshal.Get+  , module Data.Ruby.Marshal.Types+) where++import Data.Ruby.Marshal.Get+import Data.Ruby.Marshal.Types (Cache(..), RubyObject(..), Marshal(..))++import Control.Monad.State (evalStateT)+import Data.Serialize      (runGet)++import qualified Data.ByteString as BS+import qualified Data.Vector     as V++-- | Deserialises a subset of Ruby objects serialised with Marshal, Ruby's+-- built-in binary serialisation format.+decode :: BS.ByteString+       -- ^ Serialised Ruby object+       -> Maybe RubyObject+       -- ^ De-serialisation result+decode = hush . decodeEither++-- | Deserialises a subset of Ruby objects serialised with Marshal, Ruby's+-- built-in binary serialisation format.+decodeEither :: BS.ByteString+             -- ^ Serialised Ruby object+             -> Either String RubyObject+             -- ^ Error message or de-serialisation result+decodeEither = runGet (evalStateT (runMarshal getRubyObject) emptyCache)++-- | Constructs an empty cache to store symbols and objects.+emptyCache :: Cache+emptyCache = Cache { _symbols = V.empty, _objects = V.empty }++-- | Converts an Either to a Maybe.+hush :: Either a b -> Maybe b+hush = either (const Nothing) Just
+ src/Data/Ruby/Marshal/Get.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}++--------------------------------------------------------------------+-- |+-- Module    : Data.Ruby.Marshal.Get+-- Copyright : (c) Philip Cunningham, 2015+-- License   : MIT+--+-- Maintainer:  hello@filib.io+-- Stability :  experimental+-- Portability: portable+--+-- Ruby Marshal deserialiser using @Data.Serialize@.+--+--------------------------------------------------------------------++module Data.Ruby.Marshal.Get (+    getMarshalVersion+  , getRubyObject+  , getNil+  , getBool+  , getArray+  , getFixnum+  , getFloat+  , getHash+  , getIVar+  , getObjectLink+  , getString+  , getSymbol+  , getSymlink+) where++import Control.Applicative+import Data.Ruby.Marshal.Internal.Int+import Data.Ruby.Marshal.Types++import Control.Monad       (guard, liftM2, replicateM)+import Control.Monad.State (get, gets, put)+import Data.Serialize.Get  (Get, getBytes, getTwoOf, label)+import Data.String.Conv    (toS)+import Text.Read           (readMaybe)++import qualified Data.ByteString as BS+import qualified Data.Map.Strict as DM+import qualified Data.Vector     as V++import Prelude hiding (length)++--------------------------------------------------------------------+-- Top-level functions.++-- | Deserialises Marshal version.+getMarshalVersion :: Marshal (Word8, Word8)+getMarshalVersion = marshalLabel "Marshal Version" $+  getTwoOf getWord8 getWord8++-- | Deserialises a subset of Ruby objects.+getRubyObject :: Marshal RubyObject+getRubyObject = getMarshalVersion >> go+  where+    go :: Marshal RubyObject+    go = liftMarshal getWord8 >>= \case+      NilC        -> return RNil+      TrueC       -> return $ RBool True+      FalseC      -> return $ RBool False+      ArrayC      -> RArray  <$> getArray go+      FixnumC     -> RFixnum <$> getFixnum+      FloatC      -> RFloat  <$> getFloat+      HashC       -> RHash   <$> getHash go go+      IVarC       -> RIVar   <$> getIVar go+      ObjectLinkC -> RIVar   <$> getObjectLink+      StringC     -> RString <$> getString+      SymbolC     -> RSymbol <$> getSymbol+      SymlinkC    -> RSymbol <$> getSymlink+      _           -> return $ RError Unsupported++--------------------------------------------------------------------+-- Ancillary functions.++-- | Deserialises <http://ruby-doc.org/core-2.2.0/NilClass.html nil>.+getNil :: Marshal ()+getNil = marshalLabel "Nil" $ tag 48++-- | Deserialises <http://ruby-doc.org/core-2.2.0/TrueClass.html true> and+-- <http://ruby-doc.org/core-2.2.0/FalseClass.html false>.+getBool :: Marshal Bool+getBool = marshalLabel "Bool" $+  True <$ tag 84 <|> False <$ tag 70++-- | Deserialises <http://ruby-doc.org/core-2.2.0/Array.html Array>.+getArray :: Marshal a -> Marshal (V.Vector a)+getArray g = do+  n <- getFixnum+  x <- V.replicateM n g+  marshalLabel "Array" $ return x++-- | Deserialises <http://ruby-doc.org/core-2.2.0/Fixnum.html Fixnum>.+getFixnum :: Marshal Int+getFixnum = marshalLabel "Fixnum" $ do+  x <- getInt8+  if | x ==  0   -> fromIntegral <$> return x+     | x ==  1   -> fromIntegral <$> getWord8+     | x == -1   -> fromIntegral <$> getNegInt16+     | x ==  2   -> fromIntegral <$> getWord16le+     | x == -2   -> fromIntegral <$> getInt16le+     | x ==  3   -> fromIntegral <$> getWord24le+     | x == -3   -> fromIntegral <$> getInt24le+     | x ==  4   -> fromIntegral <$> getWord32le+     | x == -4   -> fromIntegral <$> getInt32le+     | x >=  6   -> fromIntegral <$> return (x - 5)+     | x <= -6   -> fromIntegral <$> return (x + 5)+     | otherwise -> empty+  where+    getNegInt16 :: Get Int16+    getNegInt16 =  do+      x <- fromIntegral <$> getInt8+      if x >= 0 && x <= 127 then return (x - 256) else return x++-- | Deserialises <http://ruby-doc.org/core-2.2.0/Float.html Float>.+getFloat :: Marshal Double+getFloat = do+  s <- getString+  x <- case readMaybe . toS $ s of+    Just float -> return float+    Nothing    -> fail "getFloat"+  marshalLabel "Float" $ return x++-- | Deserialises <http://ruby-doc.org/core-2.2.0/Hash.html Hash>.+getHash :: forall k v. Ord k => Marshal k -> Marshal v -> Marshal (DM.Map k v)+getHash k v = do+  n <- getFixnum+  x <- DM.fromList `fmap` replicateM n (liftM2 (,) k v)+  marshalLabel "Hash" $ return x++-- | Deserialises <http://docs.ruby-lang.org/en/2.1.0/marshal_rdoc.html#label-Instance+Variables Instance Variables>.+getIVar :: Marshal RubyObject -> Marshal (RubyObject, BS.ByteString)+getIVar g = do+  string <- g+  length <- getFixnum+  if | length /= 1 -> fail "getIvar: expected single character"+     | otherwise   -> do+       symbol <- g+       denote <- g+       case symbol of+         RSymbol "E" -> case denote of+           RBool True  -> cacheAndReturn string "UTF-8"+           RBool False -> cacheAndReturn string "US-ASCII"+           _           -> fail "getIVar: expected bool"+         RSymbol "encoding" -> case denote of+           RString enc -> cacheAndReturn string enc+           _           -> fail "getIVar: expected string"+         _          -> fail "getIVar: invalid ivar"+  where+    cacheAndReturn string enc = do+      let result = (string, enc)+      writeCache $ RIVar result+      marshalLabel "IVar" $ return result++-- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.+getObjectLink :: Marshal (RubyObject, BS.ByteString)+getObjectLink = do+  index <- getFixnum+  maybeObject <- readObject index+  case maybeObject of+    Just (RIVar x) -> return x+    _              -> fail "getObjectLink"++-- | Deserialises <http://ruby-doc.org/core-2.2.0/String.html String>.+getString :: Marshal BS.ByteString+getString = do+  n <- getFixnum+  x <- liftMarshal $ getBytes n+  marshalLabel "RawString" $ return x++-- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.+getSymbol :: Marshal BS.ByteString+getSymbol = do+  x <- getString+  writeCache $ RSymbol x+  marshalLabel "Symbol" $ return x++-- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.+getSymlink :: Marshal BS.ByteString+getSymlink = do+  index <- getFixnum+  maybeObject <- readSymbol index+  case maybeObject of+    Just (RSymbol bs) -> return bs+    _                 -> fail "getSymlink"++--------------------------------------------------------------------+-- Utility functions.++-- | Lift label into Marshal monad.+marshalLabel :: String -> Get a -> Marshal a+marshalLabel x y = liftMarshal $ label x y++-- | Guard against invalid input.+tag :: Word8 -> Get ()+tag t = label "Tag" $+  getWord8 >>= \b -> guard $ t == b++-- | Look up object in our object cache.+readObject :: Int -> Marshal (Maybe RubyObject)+readObject index = gets _objects >>= \objectCache ->+  return $ objectCache V.!? index++-- | Look up a symbol in our symbol cache.+readSymbol :: Int -> Marshal (Maybe RubyObject)+readSymbol index = gets _symbols >>= \symbolCache ->+  return $ symbolCache V.!? index++-- | Write an object to the appropriate cache.+writeCache :: RubyObject -> Marshal ()+writeCache object = do+  cache <- get+  case object of+    RIVar   _ -> put $ cache { _objects = V.snoc (_objects cache) object }+    RSymbol _ -> put $ cache { _symbols = V.snoc (_symbols cache) object }+    _         -> return ()
+ src/Data/Ruby/Marshal/Internal/Int.hs view
@@ -0,0 +1,63 @@+--------------------------------------------------------------------+-- |+-- Module    : Data.Ruby.Marshal.Internal.Int+-- Copyright : (c) Philip Cunningham, 2015+-- License   : MIT+--+-- Maintainer:  hello@filib.io+-- Stability :  experimental+-- Portability: portable+--+-- Helper module for parsing Int.+--+--------------------------------------------------------------------++module Data.Ruby.Marshal.Internal.Int (+  -- * Signed integrals+    getInt8+  , getInt16le+  , getInt24le+  , getInt32le+  , Int16+  -- * Unsigned integrals+  , getWord8+  , getWord16le+  , getWord24le+  , getWord32le+  , Word8+) where++import Control.Applicative+import Prelude++import Data.Bits          ((.|.), shiftL)+import Data.Int           (Int8, Int16, Int32)+import Data.Serialize.Get (Get, getBytes, getWord8, getWord16le, getWord32le)+import Data.Word          (Word8, Word32)++import qualified Data.ByteString as BS++-- | Read an Int8.+getInt8 :: Get Int8+getInt8 = fromIntegral <$> getWord8++-- | Read an Int16.+getInt16le :: Get Int16+getInt16le = fromIntegral <$> getWord16le++-- | Read a Word24 in little endian format. Since Word24 unavailable in Data.Int+-- we use Word32.+getWord24le :: Get Word32+getWord24le = do+  s <- getBytes 3+  return $! (fromIntegral (s `BS.index` 2) `shiftL` 16) .|.+            (fromIntegral (s `BS.index` 1) `shiftL`  8) .|.+             fromIntegral (s `BS.index` 0)++-- | Read an Int24. Since Int24 unavailable in Data.Int we use Int32.+getInt24le :: Get Int32+getInt24le = fromIntegral <$> getWord24le++-- | Read an Int32.+getInt32le :: Get Int32+getInt32le = fromIntegral <$> getWord32le
+ src/Data/Ruby/Marshal/Types.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms #-}++module Data.Ruby.Marshal.Types where++import Control.Applicative+import Prelude++import Control.Monad.State (lift, MonadState, StateT)+import Data.Map            (Map)+import Data.Serialize.Get  (Get)+import Data.Vector         (Vector)++import qualified Data.ByteString as BS++data Cache = Cache {+    _objects :: Vector RubyObject+    -- ^ object cache.+  , _symbols :: Vector RubyObject+    -- ^ symbol cache.+  } deriving Show++-- | Convey when unsupported object encountered.+data Error+  = Unsupported+    -- ^ represents an unsupported Ruby object+  deriving (Eq, Ord, Show)++-- | Marshal monad endows the underling Get monad with State.+newtype Marshal a = Marshal {+  runMarshal :: StateT Cache Get a+  } deriving (Functor, Applicative, Monad, MonadState Cache)++-- | Lift Get monad into Marshal monad.+liftMarshal :: Get a -> Marshal a+liftMarshal = Marshal . lift++-- | Representation of a Ruby object.+data RubyObject+  = RNil+    -- ^ represents @nil@+  | RBool                  !Bool+    -- ^ represents @true@ or @false@+  | RFixnum {-# UNPACK #-} !Int+    -- ^ represents a @Fixnum@+  | RArray                 !(Vector RubyObject)+    -- ^ represents an @Array@+  | RHash                  !(Map RubyObject RubyObject)+    -- ^ represents an @Hash@+  | RIVar                  !(RubyObject, BS.ByteString)+    -- ^ represents an @IVar@+  | RString                !BS.ByteString+    -- ^ represents a @String@+  | RFloat {-# UNPACK #-}  !Double+    -- ^ represents a @Float@+  | RSymbol                !BS.ByteString+    -- ^ represents a @Symbol@+  | RError                 !Error+    -- ^ represents an invalid object+  deriving (Eq, Ord, Show)++-- See docs.ruby-lang.org for more information+-- http://docs.ruby-lang.org/en/2.1.0/marshal_rdoc.html#label-Stream+Format++-- | NilClass+pattern NilC = 48+-- | FalseClass+pattern FalseC = 70+-- | TrueClass+pattern TrueC = 84+-- | Array+pattern ArrayC = 91+-- | Fixnum+pattern FixnumC = 105+-- | Float+pattern FloatC = 102+-- | Hash+pattern HashC = 123+-- | IVar+pattern IVarC = 73+-- | Object link+pattern ObjectLinkC = 64+-- | String+pattern StringC = 34+-- | Symbol+pattern SymbolC = 58+-- | Symlink+pattern SymlinkC = 59
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}