├── .ghci ├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── example.bin ├── examples ├── Profiling.hs └── RailsSession.hs ├── ruby-marshal.cabal ├── src └── Data │ └── Ruby │ ├── Marshal.hs │ └── Marshal │ ├── Encoding.hs │ ├── Get.hs │ ├── Int.hs │ ├── Monad.hs │ ├── RubyObject.hs │ └── Types.hs ├── stack-7.10.yaml ├── stack-8.0.yaml ├── stack-8.2.yaml ├── stack-8.4.yaml ├── stack-8.6.yaml ├── stack.yaml ├── stack.yaml.lock ├── test ├── MarshalSpec.hs ├── Spec.hs ├── bin │ ├── .gitkeep │ ├── 0.bin │ ├── 2048.bin │ ├── 42.bin │ ├── Shift_JIS_String.bin │ ├── US_ASCII_String.bin │ ├── UTF_8_String.bin │ ├── bigArray.bin │ ├── boolArray.bin │ ├── false.bin │ ├── fixnumArray.bin │ ├── fixnumHash.bin │ ├── float.bin │ ├── neg2048.bin │ ├── neg42.bin │ ├── nil.bin │ ├── nilArray.bin │ ├── objectsAndStringReferences.bin │ ├── railsCookie.bin │ ├── stringArray.bin │ ├── symbol.bin │ ├── symbolArray.bin │ └── true.bin └── dump └── upload-docs /.ghci: -------------------------------------------------------------------------------- 1 | :set -Wall 2 | :seti -XOverloadedStrings 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # haskell 2 | dist 3 | dist-newstyle 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | .virtualenv 12 | .hpc 13 | .hsenv 14 | .cabal-sandbox/ 15 | cabal.sandbox.config 16 | *.prof 17 | *.aux 18 | *.hp 19 | *.ps 20 | .stack-work/ 21 | *~ 22 | stack.yaml.lock 23 | 24 | # ruby 25 | .ruby-version 26 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Don't run as root. 2 | sudo: false 3 | 4 | # Caching so the next build will be fast too. 5 | cache: 6 | directories: 7 | - $HOME/.stack 8 | 9 | # Build matrix. 10 | matrix: 11 | include: 12 | - env: GHCVER=8.8.3 STACK_YAML=stack.yaml 13 | compiler: GHC-8.8.3 14 | addons: 15 | apt: 16 | sources: 17 | - hvr-ghc 18 | packages: 19 | - ghc-8.8.3 20 | 21 | - env: GHCVER=8.6.5 STACK_YAML=stack-8.6.yaml 22 | compiler: GHC-8.6.5 23 | addons: 24 | apt: 25 | sources: 26 | - hvr-ghc 27 | packages: 28 | - ghc-8.6.5 29 | 30 | - env: GHCVER=8.4.2 STACK_YAML=stack-8.4.yaml 31 | compiler: GHC-8.4.2 32 | addons: 33 | apt: 34 | sources: 35 | - hvr-ghc 36 | packages: 37 | - ghc-8.4.2 38 | 39 | - env: GHCVER=8.2.2 STACK_YAML=stack-8.2.yaml 40 | compiler: GHC-8.2.2 41 | addons: 42 | apt: 43 | sources: 44 | - hvr-ghc 45 | packages: 46 | - ghc-8.2.2 47 | 48 | - env: GHCVER=8.0.2 STACK_YAML=stack-8.0.yaml 49 | compiler: GHC-8.0.2 50 | addons: 51 | apt: 52 | sources: 53 | - hvr-ghc 54 | packages: 55 | - ghc-8.0.2 56 | 57 | - env: GHCVER=7.10.3 STACK_YAML=stack-7.10.yaml 58 | compiler: GHC-7.10.3 59 | addons: 60 | apt: 61 | sources: 62 | - hvr-ghc 63 | packages: 64 | - ghc-7.10.3 65 | 66 | # Download and unpack stack. 67 | before_install: 68 | - mkdir -p ~/.local/bin 69 | - export PATH=$HOME/.local/bin:$PATH 70 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 71 | 72 | # Avoid timeouts. 73 | install: 74 | - travis_wait stack --no-terminal --skip-ghc-check setup 75 | - travis_wait stack --no-terminal --skip-ghc-check test --only-snapshot 76 | 77 | # Run the tests. 78 | script: 79 | - stack --no-terminal --skip-ghc-check test --fast 80 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.2.0 2 | 3 | - Added `MonadFail` instance for `Marshal` (#62) 4 | 5 | # 0.1.3 6 | 7 | - Relaxed version bounds. 8 | 9 | # 0.1.2 10 | 11 | - Relaxed version bounds. 12 | 13 | # 0.1.1 14 | 15 | - Added some minor style changes. 16 | - Relaxed mtl lower bound. 17 | 18 | # 0.1.0 19 | 20 | - Separated modules by concern. 21 | - Hid underlying Get monad from consumers to allow us to change the parsing 22 | library without breaking consumers should a more performant one become 23 | available. 24 | - Added Rubyable type class to make it easier to go between RubyObject and plain 25 | Haskell values. 26 | - Replaced Double with Float as per Marshal format. 27 | - Replaced internal representation of Hash with Vector of tuples to simplify 28 | Rubyable type class and usage for consumers. 29 | - Added more type safety by extracting ADT of all possible Ruby string 30 | encodings. 31 | - Re-ordered parser to try parsing simpler objects first. 32 | - Used strict State monad instead of non-strict. 33 | 34 | # 0.0.1 35 | 36 | - Completed fully-functioning parser for a subset of Ruby objects serialised 37 | with Ruby's Marshal format. 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015-2017 Philip Cunningham 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ruby-marshal 2 | 3 | [![Build Status](https://travis-ci.org/mcfilib/ruby-marshal.svg?branch=master)](https://travis-ci.org/mcfilib/ruby-marshal) 4 | 5 | Haskell library to parse a subset of Ruby objects serialised with Marshal.dump. 6 | 7 | ## Supported Types 8 | 9 | - `NilClass` 10 | - `TrueClass | FalseClass` 11 | - `Array` 12 | - `Fixnum` 13 | - `Float` 14 | - `Hash` 15 | - `String` 16 | - `Symbol` 17 | 18 | If you would like to add support for another type, please feel free to 19 | create an issue or open a pull request using the guidelines below. 20 | 21 | ## Usage 22 | 23 | ### Example 24 | 25 | ``` haskell 26 | {-# LANGUAGE OverloadedStrings #-} 27 | 28 | module Main where 29 | 30 | import Data.Ruby.Marshal 31 | import Data.ByteString (ByteString) 32 | import System.Directory (getCurrentDirectory) 33 | 34 | import qualified Data.ByteString as BS 35 | import qualified Data.Map.Strict as DM 36 | 37 | lookupUserID :: (ByteString, RubyStringEncoding) 38 | -> RubyObject 39 | -> Maybe (ByteString, RubyStringEncoding) 40 | lookupUserID key hash = fromRuby hash >>= \cookie -> DM.lookup key cookie 41 | 42 | main :: IO () 43 | main = do 44 | dir <- getCurrentDirectory 45 | rbs <- BS.readFile (mconcat [dir, "/test/bin/railsCookie.bin"]) 46 | print $ 47 | case decode rbs of 48 | Just cookie -> lookupUserID ("user_id", UTF_8) cookie 49 | Nothing -> Nothing 50 | ``` 51 | 52 | ## Contributing 53 | 54 | 1. Fork it. 55 | 2. Create your feature branch (`git checkout -b my-new-feature`). 56 | 3. Commit your changes (`git commit -am 'Add some feature'`). 57 | 4. Push to the branch (`git push origin my-new-feature`). 58 | 5. Create new Pull Request. 59 | 60 | ### Contributors 61 | 62 | - [@mcfilib](https://github.com/mcfilib) 63 | - [@adinapoli](https://github.com/adinapoli) 64 | - [@kanishka-azimi](https://github.com/kanishka-azimi) 65 | - [@zyla](https://github.com/zyla) 66 | - [@etherz10](https://github.com/etherz10) 67 | - [@JackKelly-Bellroy](https://github.com/JackKelly-Bellroy) 68 | 69 | ## Similar Libraries 70 | 71 | - [adjust/gorails](https://github.com/adjust/gorails) 72 | - [instore/node-marshal](https://github.com/instore/node-marshal) 73 | - [mfz/ruby-marshal](https://code.google.com/p/mfz-ruby-marshal) 74 | - [noxyu3m/erlang-ruby-marshal](https://github.com/noxyu3m/erlang-ruby-marshal) 75 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /example.bin: -------------------------------------------------------------------------------- 1 | I"hello haskell:ET -------------------------------------------------------------------------------- /examples/Profiling.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | module Main where 4 | 5 | import qualified Data.ByteString as BS 6 | import qualified Data.Foldable as F 7 | import Data.Monoid (mconcat) 8 | import Data.Ruby.Marshal (RubyObject (..), decode) 9 | import Data.Vector (Vector) 10 | import System.Directory (getCurrentDirectory) 11 | 12 | sumFixnum :: Vector RubyObject -> Int 13 | sumFixnum xs = F.foldl' (+) 0 $ fmap f xs 14 | where 15 | f :: RubyObject -> Int 16 | f (RFixnum x) = x 17 | 18 | main :: IO () 19 | main = do 20 | dir <- getCurrentDirectory 21 | rbs <- BS.readFile (mconcat [dir, "/test/bin/bigArray.bin"]) 22 | print $ decode rbs >>= \case 23 | RArray xs -> Just $ sumFixnum xs 24 | _ -> Nothing 25 | -------------------------------------------------------------------------------- /examples/RailsSession.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Data.ByteString (ByteString) 6 | import qualified Data.ByteString as BS 7 | import qualified Data.Map.Strict as DM 8 | import Data.Ruby.Marshal 9 | import System.Directory (getCurrentDirectory) 10 | 11 | lookupUserID :: (ByteString, RubyStringEncoding) 12 | -> RubyObject 13 | -> Maybe (ByteString, RubyStringEncoding) 14 | lookupUserID key hash = fromRuby hash >>= \cookie -> DM.lookup key cookie 15 | 16 | main :: IO () 17 | main = do 18 | dir <- getCurrentDirectory 19 | rbs <- BS.readFile (mconcat [dir, "/test/bin/railsCookie.bin"]) 20 | print $ 21 | case decode rbs of 22 | Just cookie -> lookupUserID ("user_id", UTF_8) cookie 23 | Nothing -> Nothing 24 | -------------------------------------------------------------------------------- /ruby-marshal.cabal: -------------------------------------------------------------------------------- 1 | name: ruby-marshal 2 | version: 0.2.1 3 | synopsis: Parse a subset of Ruby objects serialised with Marshal.dump. 4 | description: Parse a subset of Ruby objects serialised with Marshal.dump. 5 | homepage: https://github.com/filib/ruby-marshal 6 | license: MIT 7 | license-file: LICENSE 8 | author: Philip Cunningham 9 | maintainer: hello@filib.io 10 | category: Data 11 | build-type: Simple 12 | tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.6.5, GHC == 8.8.3 13 | cabal-version: 2.0 14 | extra-source-files: CHANGELOG.md 15 | 16 | Source-repository head 17 | type: git 18 | location: https://github.com/filib/ruby-marshal 19 | 20 | flag developer 21 | default: False 22 | 23 | library 24 | hs-source-dirs: 25 | src 26 | build-depends: 27 | base >= 4.7 && <= 5 28 | , bytestring >= 0.9.0 && <= 0.12.0 29 | , cereal >= 0.4.0 && < 0.6.0 30 | , containers >= 0.5.0 && <= 0.7.0 31 | , fail >= 4.9.0.0 && < 4.10 32 | , string-conv >= 0.1 && < 0.3 33 | , mtl >= 2.1.0 && <= 2.3.0 34 | , vector >= 0.10.0 && < 0.14 35 | default-language: 36 | Haskell2010 37 | exposed-modules: 38 | Data.Ruby.Marshal 39 | , Data.Ruby.Marshal.Encoding 40 | , Data.Ruby.Marshal.Get 41 | , Data.Ruby.Marshal.Int 42 | , Data.Ruby.Marshal.Monad 43 | , Data.Ruby.Marshal.RubyObject 44 | , Data.Ruby.Marshal.Types 45 | 46 | test-suite spec 47 | ghc-options: 48 | -Wall 49 | hs-source-dirs: 50 | src, test 51 | build-depends: 52 | ruby-marshal -any 53 | , base 54 | , bytestring 55 | , cereal 56 | , containers 57 | , fail 58 | , hspec 59 | , mtl 60 | , string-conv 61 | , vector 62 | build-tool-depends: 63 | hspec-discover:hspec-discover >= 2.9 && < 2.10 64 | default-language: 65 | Haskell2010 66 | other-modules: 67 | Data.Ruby.Marshal 68 | Data.Ruby.Marshal.Encoding 69 | Data.Ruby.Marshal.Get 70 | Data.Ruby.Marshal.Int 71 | Data.Ruby.Marshal.Monad 72 | Data.Ruby.Marshal.RubyObject 73 | Data.Ruby.Marshal.Types 74 | MarshalSpec 75 | main-is: 76 | Spec.hs 77 | type: 78 | exitcode-stdio-1.0 79 | -------------------------------------------------------------------------------- /src/Data/Ruby/Marshal.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------- 2 | -- | 3 | -- Module : Data.Ruby.Marshal 4 | -- Copyright : (c) Philip Cunningham, 2015 5 | -- License : MIT 6 | -- 7 | -- Maintainer: hello@filib.io 8 | -- Stability : experimental 9 | -- Portability: portable 10 | -- 11 | -- Simple interface to parse Ruby Marshal binary. 12 | -- 13 | -------------------------------------------------------------------- 14 | 15 | module Data.Ruby.Marshal ( 16 | -- * Decoding 17 | decode 18 | , decodeEither 19 | -- * Lifting into and lowering from RubyObject 20 | , fromRuby 21 | , toRuby 22 | -- * Re-exported modules 23 | , module Data.Ruby.Marshal.Types 24 | ) where 25 | 26 | import Control.Monad.State.Strict (evalStateT) 27 | import qualified Data.ByteString as BS 28 | import Data.Ruby.Marshal.Get 29 | import Data.Ruby.Marshal.Monad (emptyCache, runMarshal) 30 | import Data.Ruby.Marshal.RubyObject 31 | import Data.Ruby.Marshal.Types 32 | import Data.Serialize (runGet) 33 | 34 | -- | Parses a subset of Ruby objects serialised with Marshal, Ruby's 35 | -- built-in binary serialisation format. 36 | decode :: BS.ByteString 37 | -- ^ Serialised Ruby object 38 | -> Maybe RubyObject 39 | -- ^ De-serialisation result 40 | decode = hush . decodeEither 41 | 42 | -- | Parses a subset of Ruby objects serialised with Marshal, Ruby's 43 | -- built-in binary serialisation format. 44 | decodeEither :: BS.ByteString 45 | -- ^ Serialised Ruby object 46 | -> Either String RubyObject 47 | -- ^ Error message or de-serialisation result 48 | decodeEither = runGet (evalStateT (runMarshal getRubyObject) emptyCache) 49 | 50 | -- | Converts an Either to a Maybe. 51 | hush :: Either a b -> Maybe b 52 | hush = either (const Nothing) Just 53 | -------------------------------------------------------------------------------- /src/Data/Ruby/Marshal/Encoding.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -------------------------------------------------------------------- 4 | -- | 5 | -- Module : Data.Ruby.Marshal.Encoding 6 | -- Copyright : (c) Philip Cunningham, 2015 7 | -- License : MIT 8 | -- 9 | -- Maintainer: hello@filib.io 10 | -- Stability : experimental 11 | -- Portability: portable 12 | -- 13 | -- Ruby encoding types. 14 | -- 15 | -------------------------------------------------------------------- 16 | 17 | module Data.Ruby.Marshal.Encoding ( 18 | -- * The @RubyStringEncoding@ type 19 | fromEnc 20 | , toEnc 21 | , RubyStringEncoding(..) 22 | ) where 23 | 24 | import qualified Data.ByteString as BS 25 | 26 | -- | ADT representing all supported Ruby encodings. 27 | data RubyStringEncoding = ASCII_8BIT 28 | | Big5 29 | | Big5_HKSCS 30 | | Big5_UAO 31 | | CP50220 32 | | CP50221 33 | | CP51932 34 | | CP850 35 | | CP852 36 | | CP855 37 | | CP949 38 | | CP950 39 | | CP951 40 | | EUC_JP 41 | | EUC_JP_2004 42 | | EUC_KR 43 | | EUC_TW 44 | | Emacs_Mule 45 | | EucJP_ms 46 | | GB12345 47 | | GB18030 48 | | GB1988 49 | | GB2312 50 | | GBK 51 | | IBM437 52 | | IBM737 53 | | IBM775 54 | | IBM852 55 | | IBM855 56 | | IBM857 57 | | IBM860 58 | | IBM861 59 | | IBM862 60 | | IBM863 61 | | IBM864 62 | | IBM865 63 | | IBM866 64 | | IBM869 65 | | ISO_2022_JP 66 | | ISO_2022_JP_2 67 | | ISO_2022_JP_KDDI 68 | | ISO_8859_1 69 | | ISO_8859_10 70 | | ISO_8859_11 71 | | ISO_8859_13 72 | | ISO_8859_14 73 | | ISO_8859_15 74 | | ISO_8859_16 75 | | ISO_8859_2 76 | | ISO_8859_3 77 | | ISO_8859_4 78 | | ISO_8859_5 79 | | ISO_8859_6 80 | | ISO_8859_7 81 | | ISO_8859_8 82 | | ISO_8859_9 83 | | KOI8_R 84 | | KOI8_U 85 | | MacCentEuro 86 | | MacCroatian 87 | | MacCyrillic 88 | | MacGreek 89 | | MacIceland 90 | | MacJapanese 91 | | MacRoman 92 | | MacRomania 93 | | MacThai 94 | | MacTurkish 95 | | MacUkraine 96 | | SJIS_DoCoMo 97 | | SJIS_KDDI 98 | | SJIS_SoftBank 99 | | Shift_JIS 100 | | Stateless_ISO_2022_JP 101 | | Stateless_ISO_2022_JP_KDDI 102 | | TIS_620 103 | | US_ASCII 104 | | UTF8_DoCoMo 105 | | UTF8_KDDI 106 | | UTF8_MAC 107 | | UTF8_SoftBank 108 | | UTF_16 109 | | UTF_16BE 110 | | UTF_16LE 111 | | UTF_32 112 | | UTF_32BE 113 | | UTF_32LE 114 | | UTF_7 115 | | UTF_8 116 | | Windows_1250 117 | | Windows_1251 118 | | Windows_1252 119 | | Windows_1253 120 | | Windows_1254 121 | | Windows_1255 122 | | Windows_1256 123 | | Windows_1257 124 | | Windows_1258 125 | | Windows_31J 126 | | Windows_874 127 | | UnsupportedEncoding 128 | deriving (Eq, Ord, Show) 129 | 130 | -- | Lifts encoding strings into encoding ADT. 131 | toEnc :: BS.ByteString -> RubyStringEncoding 132 | toEnc "ASCII-8BIT" = ASCII_8BIT 133 | toEnc "UTF-8" = UTF_8 134 | toEnc "US-ASCII" = US_ASCII 135 | toEnc "Big5" = Big5 136 | toEnc "Big5-HKSCS" = Big5_HKSCS 137 | toEnc "Big5-UAO" = Big5_UAO 138 | toEnc "CP949" = CP949 139 | toEnc "Emacs-Mule" = Emacs_Mule 140 | toEnc "EUC-JP" = EUC_JP 141 | toEnc "EUC-KR" = EUC_KR 142 | toEnc "EUC-TW" = EUC_TW 143 | toEnc "GB18030" = GB18030 144 | toEnc "GBK" = GBK 145 | toEnc "ISO-8859-1" = ISO_8859_1 146 | toEnc "ISO-8859-2" = ISO_8859_2 147 | toEnc "ISO-8859-3" = ISO_8859_3 148 | toEnc "ISO-8859-4" = ISO_8859_4 149 | toEnc "ISO-8859-5" = ISO_8859_5 150 | toEnc "ISO-8859-6" = ISO_8859_6 151 | toEnc "ISO-8859-7" = ISO_8859_7 152 | toEnc "ISO-8859-8" = ISO_8859_8 153 | toEnc "ISO-8859-9" = ISO_8859_9 154 | toEnc "ISO-8859-10" = ISO_8859_10 155 | toEnc "ISO-8859-11" = ISO_8859_11 156 | toEnc "ISO-8859-13" = ISO_8859_13 157 | toEnc "ISO-8859-14" = ISO_8859_14 158 | toEnc "ISO-8859-15" = ISO_8859_15 159 | toEnc "ISO-8859-16" = ISO_8859_16 160 | toEnc "KOI8-R" = KOI8_R 161 | toEnc "KOI8-U" = KOI8_U 162 | toEnc "Shift_JIS" = Shift_JIS 163 | toEnc "UTF-16BE" = UTF_16BE 164 | toEnc "UTF-16LE" = UTF_16LE 165 | toEnc "UTF-32BE" = UTF_32BE 166 | toEnc "UTF-32LE" = UTF_32LE 167 | toEnc "Windows-31J" = Windows_31J 168 | toEnc "Windows-1251" = Windows_1251 169 | toEnc "IBM437" = IBM437 170 | toEnc "IBM737" = IBM737 171 | toEnc "IBM775" = IBM775 172 | toEnc "CP850" = CP850 173 | toEnc "IBM852" = IBM852 174 | toEnc "CP852" = CP852 175 | toEnc "IBM855" = IBM855 176 | toEnc "CP855" = CP855 177 | toEnc "IBM857" = IBM857 178 | toEnc "IBM860" = IBM860 179 | toEnc "IBM861" = IBM861 180 | toEnc "IBM862" = IBM862 181 | toEnc "IBM863" = IBM863 182 | toEnc "IBM864" = IBM864 183 | toEnc "IBM865" = IBM865 184 | toEnc "IBM866" = IBM866 185 | toEnc "IBM869" = IBM869 186 | toEnc "Windows-1258" = Windows_1258 187 | toEnc "GB1988" = GB1988 188 | toEnc "macCentEuro" = MacCentEuro 189 | toEnc "macCroatian" = MacCroatian 190 | toEnc "macCyrillic" = MacCyrillic 191 | toEnc "macGreek" = MacGreek 192 | toEnc "macIceland" = MacIceland 193 | toEnc "macRoman" = MacRoman 194 | toEnc "macRomania" = MacRomania 195 | toEnc "macThai" = MacThai 196 | toEnc "macTurkish" = MacTurkish 197 | toEnc "macUkraine" = MacUkraine 198 | toEnc "CP950" = CP950 199 | toEnc "CP951" = CP951 200 | toEnc "stateless-ISO-2022-JP" = Stateless_ISO_2022_JP 201 | toEnc "eucJP-ms" = EucJP_ms 202 | toEnc "CP51932" = CP51932 203 | toEnc "EUC-JP-2004" = EUC_JP_2004 204 | toEnc "GB2312" = GB2312 205 | toEnc "GB12345" = GB12345 206 | toEnc "ISO-2022-JP" = ISO_2022_JP 207 | toEnc "ISO-2022-JP-2" = ISO_2022_JP_2 208 | toEnc "CP50220" = CP50220 209 | toEnc "CP50221" = CP50221 210 | toEnc "Windows-1252" = Windows_1252 211 | toEnc "Windows-1250" = Windows_1250 212 | toEnc "Windows-1256" = Windows_1256 213 | toEnc "Windows-1253" = Windows_1253 214 | toEnc "Windows-1255" = Windows_1255 215 | toEnc "Windows-1254" = Windows_1254 216 | toEnc "TIS-620" = TIS_620 217 | toEnc "Windows-874" = Windows_874 218 | toEnc "Windows-1257" = Windows_1257 219 | toEnc "MacJapanese" = MacJapanese 220 | toEnc "UTF-7" = UTF_7 221 | toEnc "UTF8-MAC" = UTF8_MAC 222 | toEnc "UTF-16" = UTF_16 223 | toEnc "UTF-32" = UTF_32 224 | toEnc "UTF8-DoCoMo" = UTF8_DoCoMo 225 | toEnc "SJIS-DoCoMo" = SJIS_DoCoMo 226 | toEnc "UTF8-KDDI" = UTF8_KDDI 227 | toEnc "SJIS-KDDI" = SJIS_KDDI 228 | toEnc "ISO-2022-JP-KDDI" = ISO_2022_JP_KDDI 229 | toEnc "stateless-ISO-2022-JP-KDDI" = Stateless_ISO_2022_JP_KDDI 230 | toEnc "UTF8-SoftBank" = UTF8_SoftBank 231 | toEnc "SJIS-SoftBank" = SJIS_SoftBank 232 | toEnc _ = UnsupportedEncoding 233 | 234 | -- | Lowers encoding ADT into an encoding string. 235 | fromEnc :: RubyStringEncoding -> BS.ByteString 236 | fromEnc ASCII_8BIT = "ASCII-8BIT" 237 | fromEnc UTF_8 = "UTF-8" 238 | fromEnc US_ASCII = "US-ASCII" 239 | fromEnc Big5 = "Big5" 240 | fromEnc Big5_HKSCS = "Big5-HKSCS" 241 | fromEnc Big5_UAO = "Big5-UAO" 242 | fromEnc CP949 = "CP949" 243 | fromEnc Emacs_Mule = "Emacs-Mule" 244 | fromEnc EUC_JP = "EUC-JP" 245 | fromEnc EUC_KR = "EUC-KR" 246 | fromEnc EUC_TW = "EUC-TW" 247 | fromEnc GB18030 = "GB18030" 248 | fromEnc GBK = "GBK" 249 | fromEnc ISO_8859_1 = "ISO-8859-1" 250 | fromEnc ISO_8859_2 = "ISO-8859-2" 251 | fromEnc ISO_8859_3 = "ISO-8859-3" 252 | fromEnc ISO_8859_4 = "ISO-8859-4" 253 | fromEnc ISO_8859_5 = "ISO-8859-5" 254 | fromEnc ISO_8859_6 = "ISO-8859-6" 255 | fromEnc ISO_8859_7 = "ISO-8859-7" 256 | fromEnc ISO_8859_8 = "ISO-8859-8" 257 | fromEnc ISO_8859_9 = "ISO-8859-9" 258 | fromEnc ISO_8859_10 = "ISO-8859-10" 259 | fromEnc ISO_8859_11 = "ISO-8859-11" 260 | fromEnc ISO_8859_13 = "ISO-8859-13" 261 | fromEnc ISO_8859_14 = "ISO-8859-14" 262 | fromEnc ISO_8859_15 = "ISO-8859-15" 263 | fromEnc ISO_8859_16 = "ISO-8859-16" 264 | fromEnc KOI8_R = "KOI8-R" 265 | fromEnc KOI8_U = "KOI8-U" 266 | fromEnc Shift_JIS = "Shift_JIS" 267 | fromEnc UTF_16BE = "UTF-16BE" 268 | fromEnc UTF_16LE = "UTF-16LE" 269 | fromEnc UTF_32BE = "UTF-32BE" 270 | fromEnc UTF_32LE = "UTF-32LE" 271 | fromEnc Windows_31J = "Windows-31J" 272 | fromEnc Windows_1251 = "Windows-1251" 273 | fromEnc IBM437 = "IBM437" 274 | fromEnc IBM737 = "IBM737" 275 | fromEnc IBM775 = "IBM775" 276 | fromEnc CP850 = "CP850" 277 | fromEnc IBM852 = "IBM852" 278 | fromEnc CP852 = "CP852" 279 | fromEnc IBM855 = "IBM855" 280 | fromEnc CP855 = "CP855" 281 | fromEnc IBM857 = "IBM857" 282 | fromEnc IBM860 = "IBM860" 283 | fromEnc IBM861 = "IBM861" 284 | fromEnc IBM862 = "IBM862" 285 | fromEnc IBM863 = "IBM863" 286 | fromEnc IBM864 = "IBM864" 287 | fromEnc IBM865 = "IBM865" 288 | fromEnc IBM866 = "IBM866" 289 | fromEnc IBM869 = "IBM869" 290 | fromEnc Windows_1258 = "Windows-1258" 291 | fromEnc GB1988 = "GB1988" 292 | fromEnc MacCentEuro = "macCentEuro" 293 | fromEnc MacCroatian = "macCroatian" 294 | fromEnc MacCyrillic = "macCyrillic" 295 | fromEnc MacGreek = "macGreek" 296 | fromEnc MacIceland = "macIceland" 297 | fromEnc MacRoman = "macRoman" 298 | fromEnc MacRomania = "macRomania" 299 | fromEnc MacThai = "macThai" 300 | fromEnc MacTurkish = "macTurkish" 301 | fromEnc MacUkraine = "macUkraine" 302 | fromEnc CP950 = "CP950" 303 | fromEnc CP951 = "CP951" 304 | fromEnc Stateless_ISO_2022_JP = "stateless-ISO-2022-JP" 305 | fromEnc EucJP_ms = "eucJP-ms" 306 | fromEnc CP51932 = "CP51932" 307 | fromEnc EUC_JP_2004 = "EUC-JP-2004" 308 | fromEnc GB2312 = "GB2312" 309 | fromEnc GB12345 = "GB12345" 310 | fromEnc ISO_2022_JP = "ISO-2022-JP" 311 | fromEnc ISO_2022_JP_2 = "ISO-2022-JP-2" 312 | fromEnc CP50220 = "CP50220" 313 | fromEnc CP50221 = "CP50221" 314 | fromEnc Windows_1252 = "Windows-1252" 315 | fromEnc Windows_1250 = "Windows-1250" 316 | fromEnc Windows_1256 = "Windows-1256" 317 | fromEnc Windows_1253 = "Windows-1253" 318 | fromEnc Windows_1255 = "Windows-1255" 319 | fromEnc Windows_1254 = "Windows-1254" 320 | fromEnc TIS_620 = "TIS-620" 321 | fromEnc Windows_874 = "Windows-874" 322 | fromEnc Windows_1257 = "Windows-1257" 323 | fromEnc MacJapanese = "MacJapanese" 324 | fromEnc UTF_7 = "UTF-7" 325 | fromEnc UTF8_MAC = "UTF8-MAC" 326 | fromEnc UTF_16 = "UTF-16" 327 | fromEnc UTF_32 = "UTF-32" 328 | fromEnc UTF8_DoCoMo = "UTF8-DoCoMo" 329 | fromEnc SJIS_DoCoMo = "SJIS-DoCoMo" 330 | fromEnc UTF8_KDDI = "UTF8-KDDI" 331 | fromEnc SJIS_KDDI = "SJIS-KDDI" 332 | fromEnc ISO_2022_JP_KDDI = "ISO-2022-JP-KDDI" 333 | fromEnc Stateless_ISO_2022_JP_KDDI = "stateless-ISO-2022-JP-KDDI" 334 | fromEnc UTF8_SoftBank = "UTF8-SoftBank" 335 | fromEnc SJIS_SoftBank = "SJIS-SoftBank" 336 | fromEnc _ = "UnsupportedEncoding" 337 | -------------------------------------------------------------------------------- /src/Data/Ruby/Marshal/Get.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE MultiWayIf #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE PatternSynonyms #-} 5 | 6 | -------------------------------------------------------------------- 7 | -- | 8 | -- Module : Data.Ruby.Marshal.Get 9 | -- Copyright : (c) Philip Cunningham, 2015 10 | -- License : MIT 11 | -- 12 | -- Maintainer: hello@filib.io 13 | -- Stability : experimental 14 | -- Portability: portable 15 | -- 16 | -- Parsers for Ruby Marshal format. 17 | -- 18 | -------------------------------------------------------------------- 19 | 20 | module Data.Ruby.Marshal.Get ( 21 | -- * Ruby Marshal parsers 22 | getMarshalVersion 23 | , getRubyObject 24 | ) where 25 | 26 | import Control.Applicative 27 | import Control.Monad (liftM2, when) 28 | import Data.Monoid ((<>)) 29 | import qualified Data.ByteString as BS 30 | import Data.Ruby.Marshal.Encoding (toEnc) 31 | import Data.Ruby.Marshal.Int 32 | import Data.Ruby.Marshal.Monad (liftMarshal, readObject, 33 | readSymbol, writeCache) 34 | import Data.Ruby.Marshal.Types 35 | import Data.Serialize.Get (Get, getBytes, getTwoOf, label) 36 | import Data.String.Conv (toS) 37 | import qualified Data.Vector as V 38 | import Prelude 39 | import Text.Read (readMaybe) 40 | 41 | -------------------------------------------------------------------- 42 | -- Top-level functions. 43 | 44 | -- | Parses Marshal version. 45 | getMarshalVersion :: Marshal (Word8, Word8) 46 | getMarshalVersion = liftAndLabel "Marshal Version" $ 47 | getTwoOf getWord8 getWord8 >>= \version -> case version of 48 | (4, 8) -> return version 49 | _ -> fail "marshal version unsupported" 50 | 51 | -- | Parses a subset of Ruby objects. 52 | getRubyObject :: Marshal RubyObject 53 | getRubyObject = getMarshalVersion >> go 54 | where 55 | go :: Marshal RubyObject 56 | go = liftMarshal getWord8 >>= \case 57 | NilChar -> return RNil 58 | TrueChar -> return $ RBool True 59 | FalseChar -> return $ RBool False 60 | FixnumChar -> RFixnum <$> getFixnum 61 | FloatChar -> RFloat <$> getFloat 62 | StringChar -> RString <$> getString 63 | SymbolChar -> RSymbol <$> getSymbol 64 | ObjectLinkChar -> getObjectLink 65 | SymlinkChar -> RSymbol <$> getSymlink 66 | ArrayChar -> do 67 | result <- RArray <$> getArray go 68 | writeCache result 69 | pure result 70 | HashChar -> do 71 | result <- RHash <$> getHash go go 72 | writeCache result 73 | pure result 74 | IVarChar -> RIVar <$> getIVar go 75 | _ -> return Unsupported 76 | 77 | -------------------------------------------------------------------- 78 | -- Ancillary functions. 79 | 80 | -- | Parses . 81 | getArray :: Marshal a -> Marshal (V.Vector a) 82 | getArray g = marshalLabel "Fixnum" $ do 83 | n <- getFixnum 84 | V.replicateM n g 85 | 86 | -- | Parses . 87 | getFixnum :: Marshal Int 88 | getFixnum = liftAndLabel "Fixnum" $ do 89 | x <- getInt8 90 | if | x == 0 -> fromIntegral <$> return x 91 | | x == 1 -> fromIntegral <$> getWord8 92 | | x == -1 -> fromIntegral <$> getNegInt16 93 | | x == 2 -> fromIntegral <$> getWord16le 94 | | x == -2 -> fromIntegral <$> getInt16le 95 | | x == 3 -> fromIntegral <$> getWord24le 96 | | x == -3 -> fromIntegral <$> getInt24le 97 | | x == 4 -> fromIntegral <$> getWord32le 98 | | x == -4 -> fromIntegral <$> getInt32le 99 | | x >= 6 -> fromIntegral <$> return (x - 5) 100 | | x <= -6 -> fromIntegral <$> return (x + 5) 101 | | otherwise -> empty 102 | where 103 | getNegInt16 :: Get Int16 104 | getNegInt16 = do 105 | x <- fromIntegral <$> getInt8 106 | if x >= 0 && x <= 127 107 | then return (x - 256) 108 | else return x 109 | 110 | -- | Parses . 111 | getFloat :: Marshal Float 112 | getFloat = marshalLabel "Float" $ do 113 | s <- getString 114 | case readMaybe . toS $ s of 115 | Just float -> return float 116 | Nothing -> fail "expected float" 117 | 118 | -- | Parses . 119 | getHash :: Marshal a -> Marshal b -> Marshal (V.Vector (a, b)) 120 | getHash k v = marshalLabel "Hash" $ do 121 | n <- getFixnum 122 | V.replicateM n (liftM2 (,) k v) 123 | 124 | -- | Parses . 125 | getIVar :: Marshal RubyObject -> Marshal (RubyObject, RubyStringEncoding) 126 | getIVar g = marshalLabel "IVar" $ do 127 | str <- g 128 | len <- getFixnum 129 | if | len /= 1 -> fail "expected single character" 130 | | otherwise -> do 131 | symbol <- g 132 | denote <- g 133 | case symbol of 134 | RSymbol "E" -> 135 | case denote of 136 | RBool True -> return' (str, UTF_8) 137 | RBool False -> return' (str, US_ASCII) 138 | _ -> fail "expected bool" 139 | RSymbol "encoding" -> 140 | case denote of 141 | RString enc -> return' (str, toEnc enc) 142 | _ -> fail "expected string" 143 | _ -> fail "invalid ivar" 144 | where 145 | return' result = do 146 | writeCache $ RIVar result 147 | return result 148 | 149 | -- | Pulls an Instance Variable out of the object cache. 150 | getObjectLink :: Marshal RubyObject 151 | getObjectLink = marshalLabel "ObjectLink" $ do 152 | index <- getFixnum 153 | when (index == 0) $ fail $ "invalid object link (index=0)" 154 | maybeObject <- readObject (index - 1) 155 | case maybeObject of 156 | Just x -> return x 157 | x -> fail $ "invalid object link (index=" <> show index <> ", target=" <> show x <> ")" 158 | 159 | -- | Parses . 160 | getString :: Marshal BS.ByteString 161 | getString = marshalLabel "RawString" $ do 162 | n <- getFixnum 163 | liftMarshal $ getBytes n 164 | 165 | -- | Parses . 166 | getSymbol :: Marshal BS.ByteString 167 | getSymbol = marshalLabel "Symbol" $ do 168 | x <- getString 169 | writeCache $ RSymbol x 170 | return x 171 | 172 | -- | Pulls a Symbol out of the symbol cache. 173 | getSymlink :: Marshal BS.ByteString 174 | getSymlink = marshalLabel "Symlink" $ do 175 | index <- getFixnum 176 | maybeObject <- readSymbol index 177 | case maybeObject of 178 | Just (RSymbol bs) -> return bs 179 | _ -> fail "invalid symlink" 180 | 181 | -------------------------------------------------------------------- 182 | -- Utility functions. 183 | 184 | -- | Lift Get into Marshal monad and then label. 185 | liftAndLabel :: String -> Get a -> Marshal a 186 | liftAndLabel x y = liftMarshal $! label x y 187 | 188 | -- | Label underlying Get in Marshal monad. 189 | marshalLabel :: String -> Marshal a -> Marshal a 190 | marshalLabel x y = y >>= \y' -> liftMarshal $! label x (return y') 191 | -------------------------------------------------------------------------------- /src/Data/Ruby/Marshal/Int.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------- 2 | -- | 3 | -- Module : Data.Ruby.Marshal.Int 4 | -- Copyright : (c) Philip Cunningham, 2015 5 | -- License : MIT 6 | -- 7 | -- Maintainer: hello@filib.io 8 | -- Stability : experimental 9 | -- Portability: portable 10 | -- 11 | -- Parsers for signed and unsigned integrals. 12 | -- 13 | -------------------------------------------------------------------- 14 | 15 | module Data.Ruby.Marshal.Int ( 16 | -- * Signed integrals 17 | getInt8 18 | , getInt16le 19 | , getInt24le 20 | , getInt32le 21 | , Int16 22 | -- * Unsigned integrals 23 | , getWord8 24 | , getWord16le 25 | , getWord24le 26 | , getWord32le 27 | , Word8 28 | ) where 29 | 30 | import Control.Applicative 31 | import Data.Bits (shiftL, (.|.)) 32 | import qualified Data.ByteString as BS 33 | import Data.Int (Int16, Int32, Int8) 34 | import Data.Serialize.Get (Get, getBytes, getWord16le, getWord32le, 35 | getWord8) 36 | import Data.Word (Word32, Word8) 37 | import Prelude 38 | 39 | -- | Read an Int8. 40 | getInt8 :: Get Int8 41 | getInt8 = fromIntegral <$> getWord8 42 | 43 | -- | Read an Int16. 44 | getInt16le :: Get Int16 45 | getInt16le = fromIntegral <$> getWord16le 46 | 47 | -- | Read a Word24 in little endian format. Since Word24 unavailable in Data.Int 48 | -- we use Word32. 49 | getWord24le :: Get Word32 50 | getWord24le = do 51 | s <- getBytes 3 52 | return $! (fromIntegral (s `BS.index` 2) `shiftL` 16) .|. 53 | (fromIntegral (s `BS.index` 1) `shiftL` 8) .|. 54 | fromIntegral (s `BS.index` 0) 55 | 56 | -- | Read an Int24. Since Int24 unavailable in Data.Int we use Int32. 57 | getInt24le :: Get Int32 58 | getInt24le = fromIntegral <$> getWord24le 59 | 60 | -- | Read an Int32. 61 | getInt32le :: Get Int32 62 | getInt32le = fromIntegral <$> getWord32le 63 | -------------------------------------------------------------------------------- /src/Data/Ruby/Marshal/Monad.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | 4 | -------------------------------------------------------------------- 5 | -- | 6 | -- Module : Data.Ruby.Marshal.Monad 7 | -- Copyright : (c) Philip Cunningham, 2015 8 | -- License : MIT 9 | -- 10 | -- Maintainer: hello@filib.io 11 | -- Stability : experimental 12 | -- Portability: portable 13 | -- 14 | -- Marshal monad provides an object cache over the Get monad. 15 | -- 16 | -------------------------------------------------------------------- 17 | 18 | module Data.Ruby.Marshal.Monad where 19 | 20 | import Control.Applicative 21 | import qualified Control.Monad.Fail as Fail 22 | import qualified Control.Monad as Monad 23 | import Control.Monad (join) 24 | import Control.Monad.State.Strict (MonadState, StateT, get, gets, 25 | lift, put) 26 | import Data.Ruby.Marshal.RubyObject (RubyObject (..)) 27 | import Data.Serialize.Get (Get) 28 | import Data.Vector (Vector) 29 | import qualified Data.Vector as V 30 | import Prelude 31 | 32 | -- | Marshal monad endows the underlying Get monad with State. 33 | newtype Marshal a = Marshal { 34 | runMarshal :: StateT Cache Get a 35 | } deriving (Functor, Applicative, MonadState Cache) 36 | 37 | instance Monad Marshal where 38 | (Marshal ma) >>= f = Marshal . join $ runMarshal . f <$> ma 39 | 40 | #if !MIN_VERSION_base(4,13,0) 41 | fail = Fail.fail 42 | #endif 43 | 44 | instance Fail.MonadFail Marshal where 45 | fail = Marshal . Monad.fail 46 | 47 | -- | Lift Get monad into Marshal monad. 48 | liftMarshal :: Get a -> Marshal a 49 | liftMarshal = Marshal . lift 50 | 51 | -- | State that we must carry around during deserialisation. 52 | data Cache = Cache { 53 | objects :: !(Vector RubyObject) 54 | -- ^ object cache. 55 | , symbols :: !(Vector RubyObject) 56 | -- ^ symbol cache. 57 | } deriving Show 58 | 59 | -- | Constructs an empty cache to store symbols and objects. 60 | emptyCache :: Cache 61 | emptyCache = Cache { symbols = V.empty, objects = V.empty } 62 | 63 | -- | Look up value in cache. 64 | readCache :: Int -> (Cache -> Vector RubyObject) -> Marshal (Maybe RubyObject) 65 | readCache index f = gets f >>= \cache -> return $ cache V.!? index 66 | 67 | -- | Look up object in object cache. 68 | readObject :: Int -> Marshal (Maybe RubyObject) 69 | readObject index = readCache index objects 70 | 71 | -- | Look up a symbol in symbol cache. 72 | readSymbol :: Int -> Marshal (Maybe RubyObject) 73 | readSymbol index = readCache index symbols 74 | 75 | -- | Write an object to the appropriate cache. 76 | writeCache :: RubyObject -> Marshal () 77 | writeCache object = do 78 | cache <- get 79 | case object of 80 | RSymbol _ -> do 81 | put $ cache { symbols = V.snoc (symbols cache) object } 82 | RIVar _ -> do 83 | put $ cache { objects = V.snoc (objects cache) object } 84 | RArray _ -> do 85 | put $ cache { objects = V.snoc (objects cache) object } 86 | RHash _ -> do 87 | put $ cache { objects = V.snoc (objects cache) object } 88 | _ -> return () 89 | -------------------------------------------------------------------------------- /src/Data/Ruby/Marshal/RubyObject.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE IncoherentInstances #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | 5 | -------------------------------------------------------------------- 6 | -- | 7 | -- Module : Data.Ruby.Marshal.RubyObject 8 | -- Copyright : (c) Philip Cunningham, 2015 9 | -- License : MIT 10 | -- 11 | -- Maintainer: hello@filib.io 12 | -- Stability : experimental 13 | -- Portability: portable 14 | -- 15 | -- Core RubyObject data representation. 16 | -- 17 | -------------------------------------------------------------------- 18 | 19 | module Data.Ruby.Marshal.RubyObject where 20 | 21 | import Control.Applicative 22 | import Control.Arrow ((***)) 23 | import qualified Data.ByteString as BS 24 | import qualified Data.Map.Strict as DM 25 | import Data.Ruby.Marshal.Encoding (RubyStringEncoding (..)) 26 | import qualified Data.Vector as V 27 | import Prelude 28 | 29 | -- | Representation of a Ruby object. 30 | data RubyObject 31 | = RNil 32 | -- ^ represents @nil@ 33 | | RBool !Bool 34 | -- ^ represents @true@ or @false@ 35 | | RFixnum {-# UNPACK #-} !Int 36 | -- ^ represents a @Fixnum@ 37 | | RArray !(V.Vector RubyObject) 38 | -- ^ represents an @Array@ 39 | | RHash !(V.Vector (RubyObject, RubyObject)) 40 | -- ^ represents an @Hash@ 41 | | RIVar !(RubyObject, RubyStringEncoding) 42 | -- ^ represents an @IVar@ 43 | | RString !BS.ByteString 44 | -- ^ represents a @String@ 45 | | RFloat {-# UNPACK #-} !Float 46 | -- ^ represents a @Float@ 47 | | RSymbol !BS.ByteString 48 | -- ^ represents a @Symbol@ 49 | | Unsupported 50 | -- ^ represents an invalid object 51 | deriving (Eq, Ord, Show) 52 | 53 | -- | Transform plain Haskell values to RubyObjects and back. 54 | class Rubyable a where 55 | -- | Takes a plain Haskell value and lifts into RubyObject 56 | toRuby :: a -> RubyObject 57 | -- | Takes a RubyObject transforms it into a more general Haskell value. 58 | fromRuby :: RubyObject -> Maybe a 59 | 60 | -- core instances 61 | 62 | instance Rubyable RubyObject where 63 | toRuby = id 64 | fromRuby = Just 65 | 66 | instance Rubyable () where 67 | toRuby _ = RNil 68 | fromRuby = \case 69 | RNil -> Just () 70 | _ -> Nothing 71 | 72 | instance Rubyable Bool where 73 | toRuby = RBool 74 | fromRuby = \case 75 | RBool x -> Just x 76 | _ -> Nothing 77 | 78 | instance Rubyable Int where 79 | toRuby = RFixnum 80 | fromRuby = \case 81 | RFixnum x -> Just x 82 | _ -> Nothing 83 | 84 | instance Rubyable a => Rubyable (V.Vector a) where 85 | toRuby = RArray . V.map toRuby 86 | fromRuby = \case 87 | RArray x -> V.mapM fromRuby x 88 | _ -> Nothing 89 | 90 | instance (Rubyable a, Rubyable b) => Rubyable (V.Vector (a, b)) where 91 | toRuby x = RHash $ V.map (toRuby *** toRuby) x 92 | fromRuby = \case 93 | RHash x -> V.mapM (\(k, v) -> (,) <$> fromRuby k <*> fromRuby v) x 94 | _ -> Nothing 95 | 96 | instance Rubyable BS.ByteString where 97 | toRuby = RSymbol 98 | fromRuby = \case 99 | RSymbol x -> Just x 100 | _ -> Nothing 101 | 102 | instance Rubyable Float where 103 | toRuby = RFloat 104 | fromRuby = \case 105 | RFloat x -> Just x 106 | _ -> Nothing 107 | 108 | instance Rubyable (BS.ByteString, RubyStringEncoding) where 109 | toRuby (x, y) = RIVar (RString x, y) 110 | fromRuby = \case 111 | RIVar (RString x, y) -> Just (x, y) 112 | _ -> Nothing 113 | 114 | -- nil like 115 | 116 | instance Rubyable a => Rubyable (Maybe a) where 117 | toRuby = \case 118 | Just x -> toRuby x 119 | Nothing -> RNil 120 | fromRuby = \case 121 | RNil -> Just Nothing 122 | x -> fromRuby x 123 | 124 | -- array like 125 | 126 | instance Rubyable a => Rubyable [a] where 127 | toRuby = toRuby . V.fromList 128 | fromRuby x = V.toList <$> fromRuby x 129 | 130 | -- map like 131 | 132 | instance (Rubyable a, Rubyable b) => Rubyable [(a, b)] where 133 | toRuby = toRuby . V.fromList 134 | fromRuby x = V.toList <$> fromRuby x 135 | 136 | instance (Rubyable a, Rubyable b, Ord a) => Rubyable (DM.Map a b) where 137 | toRuby = toRuby . DM.toList 138 | fromRuby x = DM.fromList <$> fromRuby x 139 | -------------------------------------------------------------------------------- /src/Data/Ruby/Marshal/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | 3 | -------------------------------------------------------------------- 4 | -- | 5 | -- Module : Data.Ruby.Marshal.Types 6 | -- Copyright : (c) Philip Cunningham, 2015 7 | -- License : MIT 8 | -- 9 | -- Maintainer: hello@filib.io 10 | -- Stability : experimental 11 | -- Portability: portable 12 | -- 13 | -- Common types for Ruby Marshal deserialisation. 14 | -- 15 | -------------------------------------------------------------------- 16 | 17 | module Data.Ruby.Marshal.Types ( 18 | -- * Marshal Monad 19 | Marshal 20 | -- * Internal cache 21 | , Cache 22 | -- * Ruby string encodings 23 | , RubyStringEncoding(..) 24 | -- * Ruby object 25 | , RubyObject(..) 26 | -- * Patterns 27 | , pattern NilChar 28 | , pattern FalseChar 29 | , pattern TrueChar 30 | , pattern ArrayChar 31 | , pattern FixnumChar 32 | , pattern FloatChar 33 | , pattern HashChar 34 | , pattern IVarChar 35 | , pattern ObjectLinkChar 36 | , pattern StringChar 37 | , pattern SymbolChar 38 | , pattern SymlinkChar 39 | ) where 40 | 41 | import Data.Ruby.Marshal.Encoding 42 | import Data.Ruby.Marshal.Monad 43 | import Data.Ruby.Marshal.RubyObject 44 | 45 | -- | Character that represents NilCharlass. 46 | pattern NilChar = 48 47 | -- | Character that represents FalseClass. 48 | pattern FalseChar = 70 49 | -- | Character that represents TrueClass. 50 | pattern TrueChar = 84 51 | -- | Character that represents Array. 52 | pattern ArrayChar = 91 53 | -- | Character that represents Fixnum. 54 | pattern FixnumChar = 105 55 | -- | Character that represents Float. 56 | pattern FloatChar = 102 57 | -- | Character that represents Hash. 58 | pattern HashChar = 123 59 | -- | Character that represents IVar. 60 | pattern IVarChar = 73 61 | -- | Character that represents Object link. 62 | pattern ObjectLinkChar = 64 63 | -- | Character that represents String. 64 | pattern StringChar = 34 65 | -- | Character that represents Symbol. 66 | pattern SymbolChar = 58 67 | -- | Character that represents Symlink. 68 | pattern SymlinkChar = 59 69 | -------------------------------------------------------------------------------- /stack-7.10.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-6.35 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | -------------------------------------------------------------------------------- /stack-8.0.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-9.21 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | -------------------------------------------------------------------------------- /stack-8.2.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-11.22 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | -------------------------------------------------------------------------------- /stack-8.4.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-12.26 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | -------------------------------------------------------------------------------- /stack-8.6.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.26 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.11 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | flags: {} 6 | extra-package-dbs: [] 7 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 1f43c4ad661a114a4f9dd4580988f30da1208d844c097714f5867c52a02e0aa1 10 | size: 532381 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/11.yaml 12 | original: lts-16.11 13 | -------------------------------------------------------------------------------- /test/MarshalSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module MarshalSpec (spec) where 4 | 5 | import Data.Ruby.Marshal 6 | import Test.Hspec 7 | 8 | import qualified Data.ByteString as BS 9 | import qualified Data.Vector as V 10 | 11 | loadBin :: FilePath -> IO (Maybe RubyObject) 12 | loadBin path = do 13 | bs <- BS.readFile path 14 | return $ decode bs 15 | 16 | loadBinEither :: FilePath -> IO (Either String RubyObject) 17 | loadBinEither path = do 18 | bs <- BS.readFile path 19 | return $ decodeEither bs 20 | 21 | spec :: Spec 22 | spec = describe "load" $ do 23 | context "when we have nil" $ 24 | it "should parse" $ do 25 | object <- loadBin "test/bin/nil.bin" 26 | object `shouldBe` Just RNil 27 | 28 | context "when we have true" $ 29 | it "should parse" $ do 30 | object <- loadBin "test/bin/true.bin" 31 | object `shouldBe` Just (RBool True) 32 | 33 | context "when we have false" $ 34 | it "should parse" $ do 35 | object <- loadBin "test/bin/false.bin" 36 | object `shouldBe` Just (RBool False) 37 | 38 | context "when we have 0" $ 39 | it "should parse" $ do 40 | object <- loadBin "test/bin/0.bin" 41 | object `shouldBe` Just (RFixnum 0) 42 | 43 | context "when we have -42" $ 44 | it "should parse" $ do 45 | object <- loadBin "test/bin/neg42.bin" 46 | object `shouldBe` Just (RFixnum (-42)) 47 | 48 | context "when we have 42" $ 49 | it "should parse" $ do 50 | object <- loadBin "test/bin/42.bin" 51 | object `shouldBe` Just (RFixnum 42) 52 | 53 | context "when we have -2048" $ 54 | it "should parse" $ do 55 | object <- loadBin "test/bin/neg2048.bin" 56 | object `shouldBe` Just (RFixnum (-2048)) 57 | 58 | context "when we have 2048" $ 59 | it "should parse" $ do 60 | object <- loadBin "test/bin/2048.bin" 61 | object `shouldBe` Just (RFixnum 2048) 62 | 63 | context "when we have [nil]" $ 64 | it "should parse" $ do 65 | object <- loadBin "test/bin/nilArray.bin" 66 | object `shouldBe` Just (RArray $ V.fromList [RNil]) 67 | 68 | context "when we have [true, false]" $ 69 | it "should parse" $ do 70 | object <- loadBin "test/bin/boolArray.bin" 71 | object `shouldBe` Just (RArray $ V.fromList [RBool True, RBool False]) 72 | 73 | context "when we have [-2048, -42, 0, 42, 2048]" $ 74 | it "should parse" $ do 75 | object <- loadBin "test/bin/fixnumArray.bin" 76 | object `shouldBe` Just (RArray $ V.fromList [RFixnum (-2048), RFixnum (-42), RFixnum 0, RFixnum 42, RFixnum 2048]) 77 | 78 | context "when we have ['hello', 'haskell', 'hello', 'haskell']" $ 79 | it "should parse" $ do 80 | object <- loadBin "test/bin/stringArray.bin" 81 | object `shouldBe` Just (RArray $ V.fromList [RIVar (RString "hello", UTF_8), RIVar (RString "haskell", UTF_8), RIVar (RString "hello", UTF_8), RIVar (RString "haskell", UTF_8)]) 82 | 83 | context "when we have [:hello, :haskell, :hello, :haskell]" $ 84 | it "should parse" $ do 85 | object <- loadBin "test/bin/symbolArray.bin" 86 | object `shouldBe` Just (RArray $ V.fromList [RSymbol "hello", RSymbol "haskell", RSymbol "hello", RSymbol "haskell"]) 87 | 88 | context "when we have { 0 => false, 1 => true }" $ 89 | it "should parse" $ do 90 | object <- loadBin "test/bin/fixnumHash.bin" 91 | object `shouldBe` Just (RHash $ V.fromList [(RFixnum 0, RBool False), (RFixnum 1, RBool True)]) 92 | 93 | context "when we have 'hello haskell'" $ 94 | it "should parse" $ do 95 | object <- loadBin "test/bin/UTF_8_String.bin" 96 | object `shouldBe` Just (RIVar (RString "hello haskell", UTF_8)) 97 | 98 | context "when we have 'hello haskell' in US-ASCII" $ 99 | it "should parse" $ do 100 | object <- loadBin "test/bin/US_ASCII_String.bin" 101 | object `shouldBe` Just (RIVar (RString "hello haskell", US_ASCII)) 102 | 103 | context "when we have 'hello haskell' in SHIFT_JIS" $ 104 | it "should parse" $ do 105 | object <- loadBin "test/bin/Shift_JIS_String.bin" 106 | object `shouldBe` Just (RIVar (RString "hello haskell", Shift_JIS)) 107 | 108 | context "when we have 3.33333" $ 109 | it "should parse" $ do 110 | object <- loadBin "test/bin/float.bin" 111 | object `shouldBe` Just (RFloat 3.33333) 112 | 113 | context "when we have :hello_haskell" $ 114 | it "should parse" $ do 115 | object <- loadBin "test/bin/symbol.bin" 116 | object `shouldBe` Just (RSymbol "hello_haskell") 117 | 118 | context "when we have hashes, arrays and object links" $ 119 | it "should parse" $ do 120 | object <- loadBinEither "test/bin/objectsAndStringReferences.bin" 121 | object `shouldBe` Right (RArray $ V.fromList 122 | [ RHash mempty, RArray mempty, RIVar (RString "hello", UTF_8), RIVar (RString "haskell", UTF_8) 123 | , RHash mempty, RArray mempty, RIVar (RString "hello", UTF_8), RIVar (RString "haskell", UTF_8)]) 124 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /test/bin/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mcfilib/ruby-marshal/2ef87b56d1c4f9e2d57858d54b02930acc3d3855/test/bin/.gitkeep -------------------------------------------------------------------------------- /test/bin/0.bin: -------------------------------------------------------------------------------- 1 | i -------------------------------------------------------------------------------- /test/bin/2048.bin: -------------------------------------------------------------------------------- 1 | i -------------------------------------------------------------------------------- /test/bin/42.bin: -------------------------------------------------------------------------------- 1 | i/ -------------------------------------------------------------------------------- /test/bin/Shift_JIS_String.bin: -------------------------------------------------------------------------------- 1 | I"hello haskell: encoding"Shift_JIS -------------------------------------------------------------------------------- /test/bin/US_ASCII_String.bin: -------------------------------------------------------------------------------- 1 | I"hello haskell:EF -------------------------------------------------------------------------------- /test/bin/UTF_8_String.bin: -------------------------------------------------------------------------------- 1 | I"hello haskell:ET -------------------------------------------------------------------------------- /test/bin/bigArray.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mcfilib/ruby-marshal/2ef87b56d1c4f9e2d57858d54b02930acc3d3855/test/bin/bigArray.bin -------------------------------------------------------------------------------- /test/bin/boolArray.bin: -------------------------------------------------------------------------------- 1 | [TF -------------------------------------------------------------------------------- /test/bin/false.bin: -------------------------------------------------------------------------------- 1 | F -------------------------------------------------------------------------------- /test/bin/fixnumArray.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mcfilib/ruby-marshal/2ef87b56d1c4f9e2d57858d54b02930acc3d3855/test/bin/fixnumArray.bin -------------------------------------------------------------------------------- /test/bin/fixnumHash.bin: -------------------------------------------------------------------------------- 1 | {iFiT -------------------------------------------------------------------------------- /test/bin/float.bin: -------------------------------------------------------------------------------- 1 | f 3.33333 -------------------------------------------------------------------------------- /test/bin/neg2048.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mcfilib/ruby-marshal/2ef87b56d1c4f9e2d57858d54b02930acc3d3855/test/bin/neg2048.bin -------------------------------------------------------------------------------- /test/bin/neg42.bin: -------------------------------------------------------------------------------- 1 | i� -------------------------------------------------------------------------------- /test/bin/nil.bin: -------------------------------------------------------------------------------- 1 | 0 -------------------------------------------------------------------------------- /test/bin/nilArray.bin: -------------------------------------------------------------------------------- 1 | [0 -------------------------------------------------------------------------------- /test/bin/objectsAndStringReferences.bin: -------------------------------------------------------------------------------- 1 | [ {[I" 2 | hello:ETI" haskell;T@@@@ -------------------------------------------------------------------------------- /test/bin/railsCookie.bin: -------------------------------------------------------------------------------- 1 | {I"session_id:ETI"ba0844151d;TI"_csrf_token;TI"a9212445c5;TI" user_id;TI"1;T -------------------------------------------------------------------------------- /test/bin/stringArray.bin: -------------------------------------------------------------------------------- 1 | [ I" 2 | hello:ETI" haskell;T@@ -------------------------------------------------------------------------------- /test/bin/symbol.bin: -------------------------------------------------------------------------------- 1 | :hello_haskell -------------------------------------------------------------------------------- /test/bin/symbolArray.bin: -------------------------------------------------------------------------------- 1 | [ : 2 | hello: haskell;; -------------------------------------------------------------------------------- /test/bin/true.bin: -------------------------------------------------------------------------------- 1 | T -------------------------------------------------------------------------------- /test/dump: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env ruby 2 | 3 | unless RUBY_VERSION >= "2.0.0" 4 | raise "Please upgrade to at least Ruby 2.0.0." 5 | end 6 | 7 | hello = "hello" 8 | haskell = "haskell" 9 | someHash = {} 10 | someArray = [] 11 | 12 | TYPES = { 13 | "0" => 0, 14 | "2048" => 2048, 15 | "42" => 42, 16 | "Shift_JIS_String" => "hello haskell".force_encoding("Shift_JIS"), 17 | "US_ASCII_String" => "hello haskell".force_encoding("US-ASCII"), 18 | "UTF_8_String" => "hello haskell", 19 | "bigArray" => (-10000..10000).to_a, 20 | "boolArray" => [true, false], 21 | "false" => false, 22 | "fixnumArray" => [-2048, -42, 0, 42, 2048], 23 | "fixnumHash" => { 0 => false, 1 => true }, 24 | "float" => 3.33333, 25 | "neg2048" => -2048, 26 | "neg42" => -42, 27 | "nil" => nil, 28 | "nilArray" => [nil], 29 | "railsCookie" => { "session_id" => "ba0844151d", 30 | "_csrf_token" => "a9212445c5", 31 | "user_id" => "1" }, 32 | "stringArray" => [hello, haskell, hello, haskell], 33 | "symbol" => :hello_haskell, 34 | "symbolArray" => [:hello, :haskell, :hello, :haskell], 35 | "true" => true, 36 | "objectsAndStringReferences" => [someHash, someArray, hello, haskell, someHash, someArray, hello, haskell], 37 | } 38 | 39 | def dump(name, x) 40 | File.open([File.expand_path(File.dirname(__FILE__)), "bin", [name, "bin"].join(".")].join("/"), "w") do |f| 41 | f.write(Marshal.dump(x)) 42 | end 43 | end 44 | 45 | puts "Dumping binary representations..." 46 | 47 | TYPES.each do |key, val| 48 | dump(key, val) 49 | end 50 | -------------------------------------------------------------------------------- /upload-docs: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Adapted from script by Dimitri Sabadie 4 | 5 | dist=$(stack path --dist-dir --stack-yaml ./stack.yaml) 6 | packagename=$(awk '/^name:\s*(.*)/{ print $2 }' ./*.cabal) 7 | packageversion=$(awk '/^version:\s*(.*)/{ print $2 }' ./*.cabal) 8 | 9 | echo -e "\033[1;36mGenerating documentation for $packagename-$packageversion\033[0m" 10 | 11 | if ! stack haddock; then 12 | echo -e "\033[1;31m'stack haddock failed, are you in a stack project?\033[0m" 13 | exit 1 14 | fi 15 | 16 | echo "uploading docs to $packagename-$packageversion" 17 | docdir=$dist/doc/html 18 | cd "$docdir" || (echo "$docdir does not exist!"; exit 1) 19 | doc="$packagename-$packageversion-docs" 20 | echo -e "Compressing documentation from \033[1;34m$docdir\033[0m for \033[1;35m$packagename\033[0m-\033[1;33m$packageversion\033[1;30m" 21 | cp -r "$packagename" "$doc" 22 | tar -c -v -z --format=ustar -f "$doc.tar.gz" "$doc" 23 | echo -e "\033[1;32mUploading to Hackage...\033[0m" 24 | read -r -p "Hackage username: " username 25 | read -r -p "Hackage password: " -s password 26 | echo "" 27 | curl -X PUT -H 'Content-Type: application/x-tar' -H 'Content-Encoding: gzip' --data-binary "@$doc.tar.gz" "https://$username:$password@hackage.haskell.org/package/$packagename-$packageversion/docs" > /dev/null 28 | exit $? 29 | --------------------------------------------------------------------------------