diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,16 @@ # Change log -jvm-binary uses [Semantic Versioning][]. -The change log is available through the [releases on GitHub][]. +## Version 0.0.X -[Semantic Versioning]: http://semver.org/spec/v2.0.0.html -[releases on GitHub]: https://github.com/kalhauge/jvm-binary/releases +## Version 0.0.2 + +- Fix problems with package.yaml file +- Add ConstantValue +- Add Exceptions +- Add StackMapTable +- Add BootstrapMethods + +## Version 0.0.1 + +The initial version + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -17,13 +17,11 @@ [docs](http://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.7). The most notable and required are: - - ConstantValue - - Exceptions - - Signature (for Java 6 support) - - StackMapTable (for Java 7 support) - - BootstrapMethods (for Java 8 support) - - LineNumberTable + +- Add lenses for better access of deep fields + +- Add documentation for Code ## Developing diff --git a/jvm-binary.cabal b/jvm-binary.cabal --- a/jvm-binary.cabal +++ b/jvm-binary.cabal @@ -3,13 +3,14 @@ -- see: https://github.com/sol/hpack name: jvm-binary -version: 0.0.1 +version: 0.0.2 synopsis: A library for reading Java class-files -description: A library for reading Java class-files -category: Language -homepage: https://github.com/kalhauge/jvm-binary#readme -bug-reports: https://github.com/kalhauge/jvm-binary/issues -maintainer: Christian Gram Kalhauge +description: A library for reading Java class-files. +category: Language, Java +homepage: https://github.com/ucla-pls/jvm-binary#readme +bug-reports: https://github.com/ucla-pls/jvm-binary/issues +author: Christian Gram Kalhauge +maintainer: Christian Gram Kalhauge license: MIT license-file: LICENSE.md build-type: Simple @@ -24,7 +25,7 @@ source-repository head type: git - location: https://github.com/kalhauge/jvm-binary + location: https://github.com/ucla-pls/jvm-binary library hs-source-dirs: @@ -41,7 +42,11 @@ Language.JVM Language.JVM.AccessFlag Language.JVM.Attribute + Language.JVM.Attribute.BootstrapMethods Language.JVM.Attribute.Code + Language.JVM.Attribute.ConstantValue + Language.JVM.Attribute.Exceptions + Language.JVM.Attribute.StackMapTable Language.JVM.ClassFile Language.JVM.Constant Language.JVM.Field @@ -70,6 +75,7 @@ , text other-modules: Language.JVM.Attribute.CodeTest + Language.JVM.Attribute.StackMapTableTest Language.JVM.AttributeTest Language.JVM.ClassFileTest Language.JVM.ConstantTest diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,14 +1,15 @@ name: jvm-binary -version: '0.0.1' -maintainer: Christian Gram Kalhauge +version: '0.0.2' +author: Christian Gram Kalhauge +maintainer: Christian Gram Kalhauge synopsis: A library for reading Java class-files license: MIT license-file: LICENSE.md -category: Language -github: kalhauge/jvm-binary +category: Language, Java +github: ucla-pls/jvm-binary -description: A library for reading Java class-files +description: A library for reading Java class-files. ghc-options: -Wall diff --git a/src/Language/JVM.hs b/src/Language/JVM.hs --- a/src/Language/JVM.hs +++ b/src/Language/JVM.hs @@ -26,7 +26,7 @@ import Language.JVM.Field import Language.JVM.Method --- | Create a class file form a lazy byte string +-- | Create a class file from a lazy 'BL.ByteString' decodeClassFile :: BL.ByteString -> Either String ClassFile decodeClassFile bs = do case decodeOrFail bs of diff --git a/src/Language/JVM/Attribute.hs b/src/Language/JVM/Attribute.hs --- a/src/Language/JVM/Attribute.hs +++ b/src/Language/JVM/Attribute.hs @@ -19,34 +19,45 @@ , aName , IsAttribute (..) - -- SubAttributes --- , module Language.JVM.Attribute.Code + -- * SubAttributes , Code + , codeStackMapTable + , ConstantValue + , Exceptions + , StackMapTable + , BootstrapMethods + -- * Helpers , Const - ) where -import GHC.Generics (Generic) +import GHC.Generics (Generic) import Data.Bifunctor import Data.Binary -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL -import Data.Text as Text +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.Monoid +import Data.Text as Text -import Language.JVM.Constant (ConstantPool, ConstantRef, - lookupText) -import Language.JVM.Utils (SizedByteString32, trd, - unSizedByteString) +import Language.JVM.Constant (ConstantPool, + ConstantRef, + lookupText) +import Language.JVM.Utils (SizedByteString32, + trd, + unSizedByteString) -import qualified Language.JVM.Attribute.Code +import Language.JVM.Attribute.BootstrapMethods (BootstrapMethods) +import qualified Language.JVM.Attribute.Code as Code +import Language.JVM.Attribute.ConstantValue (ConstantValue) +import Language.JVM.Attribute.Exceptions (Exceptions) +import Language.JVM.Attribute.StackMapTable (StackMapTable) -- | An Attribute, simply contains of a reference to a name and -- contains info. data Attribute = Attribute { aNameIndex :: ! ConstantRef - , aInfo' :: ! SizedByteString32 + , aInfo' :: ! SizedByteString32 } deriving (Show, Eq, Generic) instance Binary Attribute where @@ -85,15 +96,45 @@ return $ fromAttribute as else Nothing +readFromStrict :: Binary a => Attribute -> Either String a +readFromStrict = + bimap trd trd . decodeOrFail . BL.fromStrict . aInfo + -- # Attributes + +-- | 'Code' is an Attribute. +instance IsAttribute Code where + attrName = Const "Code" + fromAttribute = readFromStrict + +-- | 'ConstantValue' is an Attribute. +instance IsAttribute ConstantValue where + attrName = Const "ConstantValue" + fromAttribute = readFromStrict + +-- | 'Exceptions' is an Attribute. +instance IsAttribute Exceptions where + attrName = Const "Exceptions" + fromAttribute = readFromStrict + +-- | 'StackMapTable' is an Attribute. +instance IsAttribute StackMapTable where + attrName = Const "StackMapTable" + fromAttribute = readFromStrict + +-- | 'BootstrapMethods' is an Attribute. +instance IsAttribute BootstrapMethods where + attrName = Const "BootstrapMethods" + fromAttribute = readFromStrict + -- | Code is redefined with Attribute, as it is recursively containing -- 'Attribute'. This is a small hack to fix it. -type Code = Language.JVM.Attribute.Code.Code Attribute +type Code = Code.Code Attribute --- | Code is an Attribute. -instance IsAttribute Code where - attrName = - Const "Code" - fromAttribute = - bimap trd trd . decodeOrFail . BL.fromStrict . aInfo +-- | The a attribute of the code is the StackMapTable. There can be at most one. +-- If the version number of the file is more than 50, and there is no StackMapTable. +-- there is an implicit empty StackMapTable. +codeStackMapTable :: ConstantPool -> Code -> Maybe (Either String BootstrapMethods) +codeStackMapTable cp = + getFirst . foldMap (First . fromAttribute' cp) . Code.attributes diff --git a/src/Language/JVM/Attribute/BootstrapMethods.hs b/src/Language/JVM/Attribute/BootstrapMethods.hs new file mode 100644 --- /dev/null +++ b/src/Language/JVM/Attribute/BootstrapMethods.hs @@ -0,0 +1,47 @@ +{-| +Module : Language.JVM.Attribute.BootstrapMethods +Copyright : (c) Christian Gram Kalhauge, 2017 +License : MIT +Maintainer : kalhuage@cs.ucla.edu + +Based on the BootstrapMethods Attribute, as documented +[here](http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.23). +-} +{-# LANGUAGE DeriveGeneric #-} + +module Language.JVM.Attribute.BootstrapMethods + ( BootstrapMethods (..) + , methods + , BootstrapMethod (..) + , arguments + ) where + +import GHC.Generics (Generic) + +import Data.Binary + +import Language.JVM.Constant (ConstantRef (..)) +import Language.JVM.Utils + +-- | Is a list of bootstrapped methods. +data BootstrapMethods = BootstrapMethods + { methods' :: SizedList16 BootstrapMethod + } deriving (Show, Eq, Generic) + +instance Binary BootstrapMethods where + +-- | The methods as list +methods :: BootstrapMethods -> [ BootstrapMethod ] +methods = unSizedList . methods' + +-- | A bootstraped methods. +data BootstrapMethod = BootstrapMethod + { methodIndex :: ConstantRef + , arguments' :: SizedList16 ConstantRef + } deriving (Show, Eq, Generic) + +-- | The arguments is a cool +arguments :: BootstrapMethod -> [ ConstantRef ] +arguments = unSizedList . arguments' + +instance Binary BootstrapMethod where diff --git a/src/Language/JVM/Attribute/Code.hs b/src/Language/JVM/Attribute/Code.hs --- a/src/Language/JVM/Attribute/Code.hs +++ b/src/Language/JVM/Attribute/Code.hs @@ -56,7 +56,6 @@ import Language.JVM.Utils - data Code a = Code { maxStack :: Int16 , maxLocals :: Int16 diff --git a/src/Language/JVM/Attribute/ConstantValue.hs b/src/Language/JVM/Attribute/ConstantValue.hs new file mode 100644 --- /dev/null +++ b/src/Language/JVM/Attribute/ConstantValue.hs @@ -0,0 +1,26 @@ +{-| +Module : Language.JVM.Attribute.ConstantValue +Copyright : (c) Christian Gram Kalhauge, 2017 +License : MIT +Maintainer : kalhuage@cs.ucla.edu + +Based on the ConstantValue, as documented [here](http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.5). +-} +{-# LANGUAGE DeriveGeneric #-} + +module Language.JVM.Attribute.ConstantValue + ( ConstantValue (..) + ) where + +import GHC.Generics (Generic) + +import Data.Binary + +import Language.JVM.Constant (ConstantRef (..)) + +-- | A constant value is just a index into the constant pool. +data ConstantValue = ConstantValue + { constantValueIndex :: !ConstantRef + } deriving (Show, Eq, Generic) + +instance Binary ConstantValue where diff --git a/src/Language/JVM/Attribute/Exceptions.hs b/src/Language/JVM/Attribute/Exceptions.hs new file mode 100644 --- /dev/null +++ b/src/Language/JVM/Attribute/Exceptions.hs @@ -0,0 +1,34 @@ +{-| +Module : Language.JVM.Attribute.Exceptions +Copyright : (c) Christian Gram Kalhauge, 2017 +License : MIT +Maintainer : kalhuage@cs.ucla.edu + +Based on the Exceptions Attribute, as documented [here](http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.5). It describes the checked +exceptions that a method can make. +-} +{-# LANGUAGE DeriveGeneric #-} + +module Language.JVM.Attribute.Exceptions + ( Exceptions (..) + , exceptionIndexTable + ) where + +import GHC.Generics (Generic) + +import Data.Binary + +import Language.JVM.Constant (ConstantRef (..)) +import Language.JVM.Utils + +-- | An Exceptions attribute is a list of references into the +-- constant pool. +data Exceptions = Exceptions + { exceptionIndexTable' :: SizedList16 ConstantRef + } deriving (Show, Eq, Generic) + +-- | Get the constant refs that points . +exceptionIndexTable :: Exceptions -> [ConstantRef] +exceptionIndexTable = unSizedList . exceptionIndexTable' + +instance Binary Exceptions where diff --git a/src/Language/JVM/Attribute/StackMapTable.hs b/src/Language/JVM/Attribute/StackMapTable.hs new file mode 100644 --- /dev/null +++ b/src/Language/JVM/Attribute/StackMapTable.hs @@ -0,0 +1,173 @@ +{-| +Module : Language.JVM.Attribute.StackMapTable +Copyright : (c) Christian Gram Kalhauge, 2017 +License : MIT +Maintainer : kalhuage@cs.ucla.edu + +Based on the StackMapTable Attribute, +as documented [here](http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.4). + +-} +{-# LANGUAGE DeriveGeneric #-} + +module Language.JVM.Attribute.StackMapTable + ( StackMapTable (..) + , DeltaOffset + , StackMapFrame (..) + , StackMapFrameType (..) + + , VerificationTypeInfo (..) + ) where + +import GHC.Generics (Generic) + +import Data.Binary +import Numeric +import Control.Monad (replicateM) + +import Language.JVM.Constant (ConstantRef (..)) +import Language.JVM.Utils + +-- | An Exceptions attribute is a list of references into the +-- constant pool. +data StackMapTable = StackMapTable + { stackMapTable :: SizedList16 StackMapFrame + } deriving (Show, Eq, Generic) + +instance Binary StackMapTable where + +-- | A delta offset +type DeltaOffset = Word8 + +-- | An stack map frame +data StackMapFrame = StackMapFrame + { deltaOffset :: DeltaOffset + , frameType :: StackMapFrameType + } deriving (Show, Eq) + +-- | An stack map frame type +data StackMapFrameType + = SameFrame + | SameLocals1StackItemFrame VerificationTypeInfo + | ChopFrame Word8 + | AppendFrame [VerificationTypeInfo] + | FullFrame + (SizedList16 VerificationTypeInfo) + (SizedList16 VerificationTypeInfo) + deriving (Show, Eq) + +instance Binary StackMapFrame where + get = do + ft <- getWord8 + let + framegetter + | 0 <= ft && ft <= 63 + = return $ StackMapFrame ft SameFrame + + | 64 <= ft && ft <= 127 + = StackMapFrame (ft - 64) . SameLocals1StackItemFrame <$> get + + | 128 <= ft && ft <= 246 + = fail $ "Reserved for further use: '0x" ++ showHex ft "'" + + | ft == 247 + = StackMapFrame <$> get <*> (SameLocals1StackItemFrame <$> get) + + | 248 <= ft && ft <= 250 + = StackMapFrame <$> get <*> pure (ChopFrame (251 - ft)) + + | ft == 251 + = StackMapFrame <$> get <*> pure SameFrame + + | 252 <= ft && ft <= 254 + = do + offset <- get + locals <- replicateM (fromIntegral $ ft - 251) get + return $ StackMapFrame offset (AppendFrame locals) + + | ft == 255 + = StackMapFrame <$> get <*> (FullFrame <$> get <*> get) + + | otherwise + = fail $ "Unknown frame type '0x" ++ showHex ft "'" + framegetter + + put (StackMapFrame off frame) = do + case frame of + + SameFrame + | off <= 63 -> + putWord8 off + | otherwise -> do + putWord8 251 + putWord8 off + + SameLocals1StackItemFrame vt + | off <= 63 -> do + putWord8 (64 + off) + put vt + | otherwise -> do + putWord8 247 + putWord8 off + put vt + + ChopFrame w + | 0 < w && w <= 3 -> do + putWord8 (251 - w) + putWord8 off + | otherwise -> + fail $ "Can't write a cutoff value outside ]0,3], but was: " ++ show w + + AppendFrame vs + | length vs <= 3 && 0 < length vs -> do + putWord8 (fromIntegral $ 251 + length vs) + putWord8 off + mapM_ put vs + | otherwise -> + fail $ "The AppendFrame has to contain at least 1 and at most 3 elements: " ++ show vs + + FullFrame ls1 ls2 -> do + putWord8 255 + put off + put ls1 + put ls2 + +-- | The types info of the stack map frame. +data VerificationTypeInfo + = VTop + | VInteger + | VFloat + | VLong + | VDouble + | VNull + | VUninitializedThis + | VObject !ConstantRef + | VUninitialized !Word16 + deriving (Show, Eq) + +instance Binary VerificationTypeInfo where + get = do + tag <- getWord8 + case tag of + 0 -> pure VTop + 1 -> pure VInteger + 2 -> pure VFloat + 3 -> pure VLong + 4 -> pure VDouble + 5 -> pure VNull + 6 -> pure VUninitializedThis + 7 -> VObject <$> get + 8 -> VUninitialized <$> get + _ -> fail $ "Unexpected tag : '0x" ++ showHex tag "'" + + put a = do + case a of + VTop -> putWord8 0 + VInteger -> putWord8 1 + VFloat -> putWord8 2 + VLong -> putWord8 3 + VDouble -> putWord8 4 + VNull -> putWord8 5 + VUninitializedThis -> putWord8 6 + VObject s -> do putWord8 7; put s + VUninitialized s -> do putWord8 8; put s diff --git a/src/Language/JVM/ClassFile.hs b/src/Language/JVM/ClassFile.hs --- a/src/Language/JVM/ClassFile.hs +++ b/src/Language/JVM/ClassFile.hs @@ -18,14 +18,18 @@ , cThisClass , cSuperClass + + -- * Attributes + , cBootstrapMethods ) where import Data.Binary +import Data.Monoid import qualified Data.Text as Text import GHC.Generics (Generic) import Language.JVM.AccessFlag -import Language.JVM.Attribute (Attribute) +import Language.JVM.Attribute (Attribute, BootstrapMethods, fromAttribute') import Language.JVM.Constant import Language.JVM.Field (Field) import Language.JVM.Method (Method) @@ -67,10 +71,6 @@ cMethods :: ClassFile -> [Method] cMethods = unSizedList . cMethods' --- | Get a list of 'Attribute's of a ClassFile. -cAttributes :: ClassFile -> [Attribute] -cAttributes = unSizedList . cAttributes' - -- | Lookup the this class in a ConstantPool cThisClass :: ConstantPool -> ClassFile -> Maybe Text.Text cThisClass cp = flip lookupClassName cp . cThisClassIndex @@ -79,12 +79,12 @@ cSuperClass :: ConstantPool -> ClassFile -> Maybe Text.Text cSuperClass cp = flip lookupClassName cp . cSuperClassIndex - --- -- $accesors --- textOf :: ClassFile -> ConstantRef -> Maybe Text.Text --- textOf cf cr = --- lookupText cr (cConstantPool cf) +-- | Get a list of 'Attribute's of a ClassFile. +cAttributes :: ClassFile -> [Attribute] +cAttributes = unSizedList . cAttributes' --- constantOf :: ClassFile -> ConstantRef -> Maybe Constant --- constantOf cf cr = --- lookupConstant cr (cConstantPool cf) +-- | Fetch the 'BootstrapMethods' attribute. +-- There can only one be one exceptions attribute on a class-file. +cBootstrapMethods :: ConstantPool -> ClassFile -> Maybe (Either String BootstrapMethods) +cBootstrapMethods cp = + getFirst . foldMap (First . fromAttribute' cp) . cAttributes diff --git a/src/Language/JVM/Field.hs b/src/Language/JVM/Field.hs --- a/src/Language/JVM/Field.hs +++ b/src/Language/JVM/Field.hs @@ -8,14 +8,18 @@ {-# LANGUAGE DeriveGeneric #-} module Language.JVM.Field ( Field (..) + + -- * Attributes + , fConstantValue ) where import Data.Binary +import Data.Monoid import GHC.Generics (Generic) import Language.JVM.AccessFlag -import Language.JVM.Attribute (Attribute) -import Language.JVM.Constant (ConstantRef) +import Language.JVM.Attribute (Attribute, ConstantValue, fromAttribute') +import Language.JVM.Constant (ConstantRef, ConstantPool) import Language.JVM.Utils -- | A Field in the class-file, as described @@ -28,3 +32,9 @@ } deriving (Show, Eq, Generic) instance Binary Field where + +-- | Fetch the 'ConstantValue' attribute. +-- There can only one be one exceptions attribute on a field. +fConstantValue :: ConstantPool -> Field -> Maybe (Either String ConstantValue) +fConstantValue cp = + getFirst . foldMap (First . fromAttribute' cp) . fAttributes diff --git a/src/Language/JVM/Method.hs b/src/Language/JVM/Method.hs --- a/src/Language/JVM/Method.hs +++ b/src/Language/JVM/Method.hs @@ -14,7 +14,11 @@ , mName , mDescriptor + + -- * Attributes , mCode + , mExceptions + ) where import Data.Binary @@ -25,7 +29,7 @@ import Data.Monoid import Language.JVM.AccessFlag -import Language.JVM.Attribute (Attribute, fromAttribute', Code) +import Language.JVM.Attribute (Attribute, fromAttribute', Code, Exceptions) import Language.JVM.Constant (ConstantRef, ConstantPool, lookupText) import Language.JVM.Utils @@ -56,7 +60,14 @@ mDescriptor :: ConstantPool -> Method -> Maybe Text.Text mDescriptor cp = flip lookupText cp . mDescriptorIndex --- | Fetch the first 'Code' Attribute. +-- | Fetch the 'Code' attribute, if any. +-- There can only one be one code attribute on a method. mCode :: ConstantPool -> Method -> Maybe (Either String Code) mCode cp = + getFirst . foldMap (First . fromAttribute' cp) . mAttributes + +-- | Fetch the 'Exceptions' attribute. +-- There can only one be one exceptions attribute on a method. +mExceptions :: ConstantPool -> Method -> Maybe (Either String Exceptions) +mExceptions cp = getFirst . foldMap (First . fromAttribute' cp) . mAttributes diff --git a/test-suite/Language/JVM/Attribute/StackMapTableTest.hs b/test-suite/Language/JVM/Attribute/StackMapTableTest.hs new file mode 100644 --- /dev/null +++ b/test-suite/Language/JVM/Attribute/StackMapTableTest.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Language.JVM.Attribute.StackMapTableTest where + +import SpecHelper + +import Language.JVM.AttributeTest () +import Language.JVM.ConstantTest () +import Language.JVM.UtilsTest () + +import Language.JVM.Attribute.StackMapTable + +prop_encode_and_decode :: StackMapTable -> Property +prop_encode_and_decode = isoBinary + +prop_StackMapFrame_encode_and_decode :: StackMapFrame -> Property +prop_StackMapFrame_encode_and_decode = isoBinary + +instance Arbitrary StackMapTable where + arbitrary = StackMapTable <$> arbitrary + +instance Arbitrary StackMapFrame where + arbitrary = + StackMapFrame <$> arbitrary <*> arbitrary + +instance Arbitrary StackMapFrameType where + arbitrary = oneof + [ pure SameFrame + , SameLocals1StackItemFrame <$> arbitrary + , ChopFrame <$> choose (1,3) + , AppendFrame <$> (choose (1,3) >>= flip vectorOf arbitrary) + , FullFrame <$> arbitrary <*> arbitrary + ] + +instance Arbitrary (VerificationTypeInfo) where + arbitrary = oneof + [ pure VTop + , pure VInteger + , pure VTop + , pure VInteger + , pure VFloat + , pure VLong + , pure VDouble + , pure VNull + , pure VUninitializedThis + , VObject <$> arbitrary + , VUninitialized <$> arbitrary + ]