scale (empty) → 1.0.0.0
raw patch · 15 files changed
+1378/−0 lines, 15 filesdep +basedep +bitvecdep +bytestringsetup-changed
Dependencies added: base, bitvec, bytestring, cereal, data-default, generics-sop, hspec, hspec-contrib, hspec-discover, hspec-expectations, memory, template-haskell, text, vector
Files
- LICENSE +211/−0
- Setup.hs +2/−0
- scale.cabal +100/−0
- src/Codec/Scale.hs +72/−0
- src/Codec/Scale/Class.hs +60/−0
- src/Codec/Scale/Compact.hs +70/−0
- src/Codec/Scale/Core.hs +237/−0
- src/Codec/Scale/Generic.hs +89/−0
- src/Codec/Scale/SingletonEnum.hs +30/−0
- src/Codec/Scale/Skip.hs +32/−0
- src/Codec/Scale/TH.hs +31/−0
- tests/Codec/Scale/Test/CoreSpec.hs +258/−0
- tests/Codec/Scale/Test/SingleFieldStructSpec.hs +105/−0
- tests/Codec/Scale/Test/SkipSpec.hs +80/−0
- tests/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,211 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++END OF TERMS AND CONDITIONS++APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++Copyright 2016-2021 Aleksandr Krupenkin ++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.++ NOTE+ +Individual files contain the following tag instead of the full license+text.++ SPDX-License-Identifier: Apache-2.0++This enables machine processing of license information based on the SPDX+License Identifiers that are here available: http://spdx.org/licenses/
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ scale.cabal view
@@ -0,0 +1,100 @@+cabal-version: 1.12+name: scale+version: 1.0.0.0+license: Apache-2.0+license-file: LICENSE+copyright: (c) Aleksandr Krupenkin 2016-2021+maintainer: mail@akru.me+author: Aleksandr Krupenkin+homepage: https://github.com/airalab/hs-web3#readme+bug-reports: https://github.com/airalab/hs-web3/issues+synopsis: SCALE v2.0 codec for Haskell Web3 library.+description: Client library for Third Generation of Web.+category: Network+build-type: Simple++source-repository head+ type: git+ location: https://github.com/airalab/hs-web3++library+ exposed-modules:+ Codec.Scale+ Codec.Scale.Class+ Codec.Scale.Compact+ Codec.Scale.Core+ Codec.Scale.Generic+ Codec.Scale.SingletonEnum+ Codec.Scale.Skip+ Codec.Scale.TH++ hs-source-dirs: src+ other-modules: Paths_scale+ default-language: Haskell2010+ ghc-options:+ -funbox-strict-fields -Wduplicate-exports -Whi-shadowing+ -Widentities -Woverlapping-patterns -Wpartial-type-signatures+ -Wunrecognised-pragmas -Wtyped-holes -Wincomplete-patterns+ -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods+ -Wmissing-exported-signatures -Wmissing-monadfail-instances+ -Wmissing-signatures -Wname-shadowing -Wunused-binds+ -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds+ -Wunused-imports -Wunused-matches -Wunused-foralls -Wtabs++ build-depends:+ base >4.11 && <4.15,+ bitvec >1.0 && <2.0,+ bytestring >0.10 && <0.11,+ cereal >0.5 && <0.6,+ data-default >0.7 && <0.8,+ generics-sop >0.3 && <0.6,+ memory >0.14 && <0.16,+ template-haskell >2.11 && <2.17,+ text >1.2 && <1.3,+ vector >0.12 && <0.13++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: tests src+ other-modules:+ Codec.Scale.Test.CoreSpec+ Codec.Scale.Test.SingleFieldStructSpec+ Codec.Scale.Test.SkipSpec+ Codec.Scale+ Codec.Scale.Class+ Codec.Scale.Compact+ Codec.Scale.Core+ Codec.Scale.Generic+ Codec.Scale.SingletonEnum+ Codec.Scale.Skip+ Codec.Scale.TH+ Paths_scale++ default-language: Haskell2010+ ghc-options:+ -funbox-strict-fields -Wduplicate-exports -Whi-shadowing+ -Widentities -Woverlapping-patterns -Wpartial-type-signatures+ -Wunrecognised-pragmas -Wtyped-holes -Wincomplete-patterns+ -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods+ -Wmissing-exported-signatures -Wmissing-monadfail-instances+ -Wmissing-signatures -Wname-shadowing -Wunused-binds+ -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds+ -Wunused-imports -Wunused-matches -Wunused-foralls -Wtabs -threaded+ -rtsopts -with-rtsopts=-N++ build-depends:+ base >4.11 && <4.15,+ bitvec >1.0 && <2.0,+ bytestring >0.10 && <0.11,+ cereal >0.5 && <0.6,+ data-default >0.7 && <0.8,+ generics-sop >0.3 && <0.6,+ hspec >=2.4.4 && <2.8,+ hspec-contrib >=0.4.0 && <0.6,+ hspec-discover >=2.4.4 && <2.8,+ hspec-expectations >=0.8.2 && <0.9,+ memory >0.14 && <0.16,+ template-haskell >2.11 && <2.17,+ text >1.2 && <1.3,+ vector >0.12 && <0.13
+ src/Codec/Scale.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Codec.Scale.Class+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : unportable+--+-- The SCALE (Simple Concatenated Aggregate Little-Endian) Codec is+-- a lightweight, efficient, binary serialization and deserialization codec.+--+-- It is designed for high-performance, copy-free encoding and decoding of data in+-- resource-constrained execution contexts, like the Substrate runtime. It is not+-- self-describing in any way and assumes the decoding context has all type+-- knowledge about the encoded data.+--++module Codec.Scale+ ( encode+ , decode+ , encode'+ , decode'+ , Encode+ , Decode+ , Generic+ , module Core+ ) where++import Data.ByteArray (ByteArray, ByteArrayAccess, convert)+import Data.Serialize (runGet, runPut)+import Generics.SOP (Generic, Rep, from, to)++import Codec.Scale.Class (Decode (..), Encode (..), GDecode (..),+ GEncode (..))+import Codec.Scale.Core as Core++-- | Encode datatype to SCALE format.+encode :: (Encode a, ByteArray ba)+ => a+ -> ba+{-# INLINE encode #-}+encode = convert . runPut . put++-- | Generic driven version of 'encode'+encode' :: (Generic a,+ Rep a ~ rep,+ GEncode rep,+ ByteArray ba)+ => a+ -> ba+{-# INLINE encode' #-}+encode' = convert . runPut . gPut . from++-- | Decode datatype from SCALE format.+decode :: (ByteArrayAccess ba, Decode a)+ => ba+ -> Either String a+{-# INLINE decode #-}+decode = runGet get . convert++-- | Generic driven version of 'decode'+decode' :: (Generic a,+ Rep a ~ rep,+ GDecode rep,+ ByteArrayAccess ba)+ => ba+ -> Either String a+{-# INLINE decode' #-}+decode' = runGet (to <$> gGet) . convert
+ src/Codec/Scale/Class.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Codec.Scale.Class+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : unportable+--+--+--++module Codec.Scale.Class where++import Data.Serialize (Get, Putter)+import Generics.SOP (Generic, Rep, from, to)++-- | A class for encoding datatypes to SCALE format.+--+-- If your compiler has support for the @DeriveGeneric@ and+-- @DefaultSignatures@ language extensions (@ghc >= 7.2.1@),+-- the 'put' method will have default generic implementations.+--+-- To use this option, simply add a @deriving 'Generic'@ clause+-- to your datatype and declare a 'Encode' instance for it without+-- giving a definition for 'put'.+--+class Encode a where+ put :: Putter a++ default put :: (Generic a, Rep a ~ rep, GEncode rep) => Putter a+ put = gPut . from++-- | A class for encoding generically composed datatypes to SCALE format.+class GEncode a where+ gPut :: Putter a++-- | A class for decoding datatypes from SCALE format.+--+-- If your compiler has support for the @DeriveGeneric@ and+-- @DefaultSignatures@ language extensions (@ghc >= 7.2.1@),+-- the 'get' method will have default generic implementations.+--+-- To use this option, simply add a @deriving 'Generic'@ clause+-- to your datatype and declare a 'Decode' instance for it without+-- giving a definition for 'get'.+--+class Decode a where+ get :: Get a++ default get :: (Generic a, Rep a ~ rep, GDecode rep) => Get a+ get = to <$> gGet++-- | A class for decoding generically composed datatypes from SCALE format.+class GDecode a where+ gGet :: Get a
+ src/Codec/Scale/Compact.hs view
@@ -0,0 +1,70 @@+-- |+-- Module : Codec.Scale.Compact+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : noportable+--+-- Efficient general integer codec.+--++module Codec.Scale.Compact (Compact(..)) where++import Control.Monad (replicateM)+import Data.Bits (shiftL, shiftR, (.&.), (.|.))+import Data.List (unfoldr)+import Data.Serialize.Get (getWord16le, getWord32le, getWord8,+ lookAhead)+import Data.Serialize.Put (putWord16le, putWord32le, putWord8)++import Codec.Scale.Class (Decode (..), Encode (..))++-- | A "compact" or general integer encoding is sufficient for encoding+-- large integers (up to 2**536) and is more efficient at encoding most+-- values than the fixed-width version.+newtype Compact a = Compact { unCompact :: a }+ deriving (Eq, Ord)++instance Show a => Show (Compact a) where+ show = ("Compact " ++) . show . unCompact++instance Integral a => Encode (Compact a) where+ put (Compact x)+ | n < 0 = error "negatives not supported by compact codec"+ | n < 64 = singleByteMode+ | n < 2^14 = twoByteMode+ | n < 2^30 = fourByteMode+ | n < 2^536 = bigIntegerMode+ | otherwise = error $ "unable to encode " ++ show n ++ " as compact"+ where+ n = toInteger x+ singleByteMode = putWord8 (fromIntegral x `shiftL` 2)+ twoByteMode = putWord16le (fromIntegral x `shiftL` 2 .|. 1)+ fourByteMode = putWord32le (fromIntegral x `shiftL` 2 .|. 2)+ bigIntegerMode = do+ let step 0 = Nothing+ step i = Just (fromIntegral i, i `shiftR` 8)+ unroll = unfoldr step n+ putWord8 (fromIntegral (length unroll - 4) `shiftL` 2 .|. 3)+ mapM_ putWord8 unroll++instance Integral a => Decode (Compact a) where+ get = do+ mode <- lookAhead ((3 .&.) <$> getWord8)+ Compact <$> case mode of+ 0 -> fromIntegral <$> singleByteMode+ 1 -> fromIntegral <$> twoByteMode+ 2 -> fromIntegral <$> fourByteMode+ 3 -> bigIntegerMode+ _ -> fail "unexpected prefix decoding compact number"+ where+ singleByteMode = flip shiftR 2 <$> getWord8+ twoByteMode = flip shiftR 2 <$> getWord16le+ fourByteMode = flip shiftR 2 <$> getWord32le+ bigIntegerMode = do+ let unstep b a = a `shiftL` 8 .|. fromIntegral b+ roll = fromInteger . foldr unstep 0+ len <- ((+4) . flip shiftR 2) <$> getWord8+ roll <$> replicateM (fromIntegral len) getWord8
+ src/Codec/Scale/Core.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module : Codec.Scale.Core+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : unportable+--+-- Particular core type instances.+--++module Codec.Scale.Core (Compact(..)) where++import Control.Monad (replicateM)+import Data.Bit (Bit, castFromWords8, cloneToWords8)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (length)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Serialize.Get (getByteString, getInt16le, getInt32le,+ getInt64le, getInt8, getWord16le,+ getWord32le, getWord64le, getWord8)+import Data.Serialize.Put (putByteString, putInt16le, putInt32le,+ putInt64le, putInt8, putWord16le,+ putWord32le, putWord64le, putWord8)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8', encodeUtf8)+import Data.Vector.Unboxed (Unbox, Vector)+import qualified Data.Vector.Unboxed as V+import Data.Word (Word16, Word32, Word64, Word8)+import Generics.SOP ()++import Codec.Scale.Class (Decode (..), Encode (..))+import Codec.Scale.Compact (Compact (..))+import Codec.Scale.Generic ()+import Codec.Scale.TH (tupleInstances)++--+-- Empty instance.+--++instance Encode () where+ put = return++instance Decode () where+ get = return ()++--+-- Boolean instance.+--++instance Encode Bool where+ put False = putWord8 0+ put True = putWord8 1++instance Decode Bool where+ get = do x <- getWord8+ case x of+ 0 -> return False+ 1 -> return True+ _ -> fail "invalid boolean representation"++--+-- Integer instances.+--++instance Encode Word8 where+ put = putWord8++instance Decode Word8 where+ get = getWord8++instance Encode Word16 where+ put = putWord16le++instance Decode Word16 where+ get = getWord16le++instance Encode Word32 where+ put = putWord32le++instance Decode Word32 where+ get = getWord32le++instance Encode Word64 where+ put = putWord64le++instance Decode Word64 where+ get = getWord64le++instance Encode Int8 where+ put = putInt8++instance Decode Int8 where+ get = getInt8++instance Encode Int16 where+ put = putInt16le++instance Decode Int16 where+ get = getInt16le++instance Encode Int32 where+ put = putInt32le++instance Decode Int32 where+ get = getInt32le++instance Encode Int64 where+ put = putInt64le++instance Decode Int64 where+ get = getInt64le++--+-- Option type instances.+--++-- Let's map `Maybe a` type to Rust `Option<T>`: Just -> Some, Nothing -> None++instance Encode a => Encode (Maybe a) where+ put (Just a) = putWord8 1 >> put a+ put Nothing = putWord8 0++instance Decode a => Decode (Maybe a) where+ get = do+ x <- getWord8+ case x of+ 0 -> return Nothing+ 1 -> Just <$> get+ _ -> fail "unexpecded first byte decoding Option"++-- Option<bool> is exception and it is always one byte++instance {-# OVERLAPPING #-} Encode (Maybe Bool) where+ put Nothing = putWord8 0+ put (Just False) = putWord8 1+ put (Just True) = putWord8 2++instance {-# OVERLAPPING #-} Decode (Maybe Bool) where+ get = do+ x <- getWord8+ case x of+ 0 -> return Nothing+ 1 -> return (Just False)+ 2 -> return (Just True)+ _ -> fail "unexpecded first byte decoding OptionBool"++--+-- Result type isntances.+--++-- Let's map `Ether a b` type to Rust `Result<T, E>`: Left -> Error, Right -> Ok++instance (Encode a, Encode b) => Encode (Either a b) where+ put (Right a) = putWord8 0 >> put a+ put (Left a) = putWord8 1 >> put a++instance (Decode a, Decode b) => Decode (Either a b) where+ get = do+ x <- getWord8+ case x of+ 0 -> Right <$> get+ 1 -> Left <$> get+ _ -> fail "unexpected first byte decoding Result"+++--+-- Tuple type instances.+--++$(concat <$> mapM tupleInstances [2..20])++--+-- Vector type instances.+--++instance Encode a => Encode [a] where+ put list = do+ put (Compact $ length list)+ mapM_ put list++instance Decode a => Decode [a] where+ get = do+ len <- get+ replicateM (unCompact len) get++instance (Encode a, Unbox a) => Encode (Vector a) where+ put vec = do+ put (Compact $ V.length vec)+ V.mapM_ put vec++instance (Decode a, Unbox a) => Decode (Vector a) where+ get = do+ len <- get+ V.replicateM (unCompact len) get++instance {-# OVERLAPPING #-} Encode (Vector Bit) where+ put vec = do+ let encoded = cloneToWords8 vec+ put (Compact $ V.length encoded)+ V.mapM_ put encoded++instance {-# OVERLAPPING #-} Decode (Vector Bit) where+ get = do+ len <- get+ castFromWords8 <$> V.replicateM (unCompact len) get++instance Encode ByteString where+ put bs = do+ put (Compact $ BS.length bs)+ putByteString bs++instance Decode ByteString where+ get = do+ len <- get+ getByteString (unCompact len)++--+-- Text type instances.+--++instance Encode Text where+ put str = do+ let encoded = encodeUtf8 str+ put (Compact $ BS.length encoded)+ putByteString encoded++instance Decode Text where+ get = do+ len <- get+ str <- getByteString (unCompact len)+ either (fail . show) return (decodeUtf8' str)
+ src/Codec/Scale/Generic.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}++-- |+-- Module : Codec.Scale.Generic+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : unportable+--+-- This module defines generic codec instances for data structures (including tuples)+-- and enums (tagged-unions in Rust).+--++module Codec.Scale.Generic () where++import Data.Serialize.Get (Get, getWord8)+import Data.Serialize.Put (PutM, putWord8)+import Data.Word (Word8)+import Generics.SOP (All, Compose, I (..), NP (..), NS (..),+ SOP (..), unSOP, unZ)++import Codec.Scale.Class (Decode (..), Encode (..), GDecode (..),+ GEncode (..))++-- Enum has multiple sum types.+instance ( GEncode (NP f xs)+ , GEncode (NP f ys)+ , All (GEncode `Compose` NP f) xss+ ) => GEncode (SOP f (xs ': ys ': xss)) where+ gPut = go 0 . unSOP+ where+ go :: forall f as . All (GEncode `Compose` f) as => Word8 -> NS f as -> PutM ()+ go !acc (Z x) = putWord8 acc >> gPut x+ go !acc (S x) = go (acc + 1) x++-- Structures has only one sum type.+instance GEncode (NP f xs) => GEncode (SOP f '[xs]) where+ gPut = gPut . unZ . unSOP++-- Product serialization is just encode each field step by step.+instance (Encode a, GEncode (NP I as)) => GEncode (NP I (a ': as)) where+ gPut (I a :* as) = put a >> gPut as++-- Finish when all fields handled.+instance GEncode (NP I '[]) where+ gPut _ = mempty++-- | Enum parser definition.+--+-- The index of sum type to parse given as an argument.+class EnumParser xs where+ enumParser :: All (GDecode `Compose` NP f) xs => Word8 -> Get (NS (NP f) xs)++-- Enumerate enum index, zero means that we reach the goal.+instance EnumParser as => EnumParser (a ': as) where+ enumParser !i | i > 0 = S <$> enumParser (i - 1)+ | otherwise = Z <$> gGet++-- When index out of type scope raise the error.+instance EnumParser '[] where+ enumParser i = fail ("index out of enum constructors count: " ++ show i)++-- Decode enum when multiple sum types.+instance ( GDecode (NP f xs)+ , GDecode (NP f ys)+ , All (GDecode `Compose` NP f) xss+ , EnumParser xss+ ) => GDecode (SOP f (xs ': ys ': xss)) where+ gGet = SOP <$> (enumParser =<< getWord8)++-- Decode plain structure when only one sum type.+instance GDecode (NP f as) => GDecode (SOP f '[as]) where+ gGet = SOP . Z <$> gGet++-- Decode each field in sequence.+instance (Decode a, GDecode (NP I as)) => GDecode (NP I (a ': as)) where+ gGet = (:*) <$> (I <$> get) <*> gGet++-- Finish decoding when empty.+instance GDecode (NP I '[]) where+ gGet = return Nil
+ src/Codec/Scale/SingletonEnum.hs view
@@ -0,0 +1,30 @@+-- |+-- Module : Codec.Scale.SingletonEnum+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : noportable+--+-- This type helps to encode/decode singleton Rust enums like:+-- `enum Enum { Data { some_data: u32 } }`+--++module Codec.Scale.SingletonEnum (SingletonEnum(..)) where++import Data.Serialize.Get (getWord8)+import Data.Serialize.Put (putWord8)++import Codec.Scale.Class (Decode (..), Encode (..))++-- | Haskell don't permit to make Rust-like enum type with only one element.+-- For this reason it is impossible to make generic parser for singleton enum type.+-- This type helps to parse Rust encoded singleton enums.+newtype SingletonEnum a = SingletonEnum { unSingletonEnum :: a }++instance Encode a => Encode (SingletonEnum a) where+ put (SingletonEnum x) = putWord8 0 >> put x++instance Decode a => Decode (SingletonEnum a) where+ get = getWord8 >> (SingletonEnum <$> get)
+ src/Codec/Scale/Skip.hs view
@@ -0,0 +1,32 @@+-- |+-- Module : Codec.Scale.Skip+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : noportable+--+-- This type helps to skip fields in encoded data type.+--++module Codec.Scale.Skip (Skip(..)) where++import Data.Default (Default (..))++import Codec.Scale.Class (Decode (..), Encode (..))++-- | This type hide filed from encoding context.+-- It's useful in cases when serialization impossible or not needed.+-- For decoding wrapped type should have 'Default' instance.+newtype Skip a = Skip { unSkip :: a }+ deriving (Eq, Ord, Show)++instance Encode (Skip a) where+ put _ = return ()++instance Default a => Decode (Skip a) where+ get = return def++instance Default a => Default (Skip a) where+ def = Skip def
+ src/Codec/Scale/TH.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module : Codec.Scale.TH+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : noportable+--+-- It contains template haskell SCALE helper functions.+--++module Codec.Scale.TH where+++import Control.Monad (replicateM)+import Language.Haskell.TH (DecsQ, Type (VarT), appT, conT, cxt,+ instanceD, newName, tupleT)++import Codec.Scale.Class (Decode, Encode)++tupleInstances :: Int -> DecsQ+tupleInstances n = do+ vars <- replicateM n $ newName "a"+ let types = fmap (pure . VarT) vars+ sequence $+ [ instanceD (cxt $ map (appT $ conT ''Decode) types) (appT (conT ''Decode) (foldl appT (tupleT n) types)) []+ , instanceD (cxt $ map (appT $ conT ''Encode) types) (appT (conT ''Encode) (foldl appT (tupleT n) types)) []+ ]
+ tests/Codec/Scale/Test/CoreSpec.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Codec.Scale.Test.CoreSpec+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : unportable+--+-- Ported to Haskell rust test spec:+-- https://github.com/paritytech/parity-scale-codec/blob/master/tests/single_field_struct_encoding.rs+--++module Codec.Scale.Test.CoreSpec where++import Control.Monad (forM_)+import Data.Bit (castFromWords8)+import Data.Bits (bit)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (length, pack, unpack)+import Data.Int (Int16, Int32, Int64, Int8)+import qualified Data.Text as T (pack)+import Data.Vector.Unboxed (Vector)+import qualified Data.Vector.Unboxed as V (fromList)+import Data.Word (Word16, Word32, Word64, Word8)+import qualified GHC.Generics as GHC (Generic)+import Test.Hspec+import Test.Hspec.QuickCheck++import Codec.Scale++data Unit = Unit+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++data Indexed = Indexed Word32 Word64+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++data Struct a b c = Struct+ { _a :: a+ , _b :: b+ , _c :: c+ }+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++data StructWithPhantom a = StructWithPhantom+ { a1 :: Word32+ , b1 :: Word64+ }+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++type TestType = Struct Word32 Word64 (Vector Word8);++data EnumType = A+ | B Word32 Word64+ | C+ { a2 :: Word32+ , b2 :: Word64+ }+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++data TestHasCompact a = TestHasCompact+ { bar1 :: Compact a+ }+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++data TestHasCompactEnum a = Unnamed (Compact a)+ | Named+ { bar2 :: Compact a+ }+ | UnnamedCompact (Compact a)+ | NamedCompact+ { bar3 :: Compact a+ }+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++data TestGenericEnum = UnnamedGenericEnum (Compact Integer) (Vector Word16)+ | NamedGenericEnum+ { bar5 :: Compact Word64+ , bar6 :: Word32+ }+ deriving (Eq, Show, GHC.Generic, Generic)++data RecursiveVariant1 a = RecursiveVariant1+ { payload1 :: a+ , other1 :: [RecursiveVariant1 a]+ }+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++data RecursiveVariant2 a b n = RecursiveVariant2+ { payload2 :: n+ , other2 :: [Struct a b (RecursiveVariant1 n)]+ }+ deriving (Eq, Show, GHC.Generic, Generic, Encode, Decode)++spec :: Spec+spec = parallel $ do+ describe "Regular types" $ do+ prop "Bool" $ \(v :: Bool) -> decode (encode v :: ByteString) == Right v++ prop "Option<Bool>" $ \(v :: Maybe Bool) -> decode (encode v :: ByteString) == Right v++ prop "Result<Bool, Vector<u8>>" $ \v vec -> do+ let success = Right v :: Either (Vector Word8) Bool+ failure = Left (V.fromList vec) :: Either (Vector Word8) Bool+ decode (encode success :: ByteString) == Right success+ && decode (encode failure :: ByteString) == Right failure++ prop "u64" $ \(v :: Word64) -> decode (encode v :: ByteString) == Right v+ prop "u32" $ \(v :: Word32) -> decode (encode v :: ByteString) == Right v+ prop "u16" $ \(v :: Word16) -> decode (encode v :: ByteString) == Right v+ prop "u8" $ \(v :: Word8) -> decode (encode v :: ByteString) == Right v++ prop "i64" $ \(v :: Int64) -> decode (encode v :: ByteString) == Right v+ prop "i32" $ \(v :: Int32) -> decode (encode v :: ByteString) == Right v+ prop "i16" $ \(v :: Int16) -> decode (encode v :: ByteString) == Right v+ prop "i8" $ \(v :: Int8) -> decode (encode v :: ByteString) == Right v++ prop "Compact<integer>" $ \(v :: Integer) -> decode (encode (Compact $ abs v) :: ByteString) == Right (Compact $ abs v)+ prop "Compact<u64>" $ \(v :: Word64) -> decode (encode (Compact v) :: ByteString) == Right (Compact v)+ prop "Compact<u32>" $ \(v :: Word32) -> decode (encode (Compact v) :: ByteString) == Right (Compact v)+ prop "Compact<u16>" $ \(v :: Word16) -> decode (encode (Compact v) :: ByteString) == Right (Compact v)+ prop "Compact<u8>" $ \(v :: Word8) -> decode (encode (Compact v) :: ByteString) == Right (Compact v)++ prop "Vector<u64>" $ \(v :: [Word64]) -> decode (encode (V.fromList v) :: ByteString) == Right v+ prop "Vector<u32>" $ \(v :: [Word32]) -> decode (encode (V.fromList v) :: ByteString) == Right v+ prop "Vector<u16>" $ \(v :: [Word16]) -> decode (encode (V.fromList v) :: ByteString) == Right v+ prop "Vector<u8>" $ \(v :: [Word8]) -> decode (encode (V.fromList v) :: ByteString) == Right v++ prop "BitVec" $ \(v :: [Word8]) -> decode (encode $ castFromWords8 $ V.fromList v :: ByteString) == Right v++ prop "ByteString" $ \(v :: [Word8]) -> decode (encode (BS.pack v) :: ByteString) == Right (BS.pack v)++ prop "Text" $ \(v :: String) -> decode (encode (T.pack v) :: ByteString) == Right (T.pack v)++ prop "List<u64>" $ \(v :: [Word64]) -> decode (encode v :: ByteString) == Right v+ prop "List<u32>" $ \(v :: [Word32]) -> decode (encode v :: ByteString) == Right v+ prop "List<u16>" $ \(v :: [Word16]) -> decode (encode v :: ByteString) == Right v+ prop "List<u8>" $ \(v :: [Word8]) -> decode (encode v :: ByteString) == Right v++ describe "Generic types" $ do+ prop "unamed_enum" $ \v vec ->+ let e = UnnamedGenericEnum (Compact $ abs v) (V.fromList vec)+ in decode' (encode' e :: ByteString) == Right e+ prop "named_struct_enum" $ \a b ->+ let e = NamedGenericEnum (Compact a) b+ in decode' (encode' e :: ByteString) == Right e++ describe "Recursive types" $ do+ prop "variant_1" $ \(n :: Word32) ->+ let v = RecursiveVariant1 n [RecursiveVariant1 (n+1) []]+ in decode (encode v :: ByteString) == Right v++ prop "variant_2" $ \(a :: Word8) (b :: Word16) (n :: Word32) ->+ let v = RecursiveVariant2 n [Struct a b (RecursiveVariant1 (n+1) [])]+ in decode (encode v :: ByteString) == Right v++ describe "SCALE Rust core tests" $ do+ it "option_excheption_works" $ do+ encode (Nothing :: Maybe Bool) `shouldBe` ("\0" :: ByteString)+ encode (Just False) `shouldBe` ("\x01" :: ByteString)+ encode (Just True) `shouldBe` ("\x02" :: ByteString)++ it "should_work_for_simple_enum" $ do+ -- Index modificator isn't support yet, skip codec test for A+ let sb = B 1 2+ sc = C 1 2+ encoded_b = "\x01\x01\0\0\0\x02\0\0\0\0\0\0\0" :: ByteString+ encoded_c = "\x02\x01\0\0\0\x02\0\0\0\0\0\0\0" :: ByteString++ encode sc `shouldBe` encoded_c+ encode sb `shouldBe` encoded_b++ decode encoded_b `shouldBe` Right sb+ decode encoded_c `shouldBe` Right sc+ decode ("\x0a" :: ByteString) `shouldBe` (Left "Failed reading: index out of enum constructors count: 7\nEmpty call stack\n" :: Either String EnumType)++ it "should_derive_encode" $ do+ let v :: TestType+ v = Struct 15 9 (V.fromList $ BS.unpack "Hello world")+ v_encoded :: ByteString+ v_encoded = "\x0f\0\0\0\x09\0\0\0\0\0\0\0\x2cHello world"+ encode v `shouldBe` v_encoded+ Right v `shouldBe` decode v_encoded++ it "should_work_for_unit" $ do+ encode Unit `shouldBe` ("" :: ByteString)+ decode ("" :: ByteString) `shouldBe` Right Unit++ it "should_work_for_indexed" $ do+ let v = Indexed 1 2+ v_encoded :: ByteString+ v_encoded = "\x01\0\0\0\x02\0\0\0\0\0\0\0"+ encode v `shouldBe` v_encoded+ Right v `shouldBe` decode v_encoded++ it "correct_error_for_indexed_0" $ do+ let wrong = "\x08" :: ByteString+ decode wrong `shouldBe` (Left "too few bytes\nFrom:\tdemandInput\n\n" :: Either String Indexed)++ it "correct_error_for_indexed_1" $ do+ let wrong = "\0\0\0\0\x01" :: ByteString+ decode wrong `shouldBe` (Left "too few bytes\nFrom:\tdemandInput\n\n" :: Either String Indexed)++ it "correct_error_for_enumtype" $ do+ let wrong = "\x01" :: ByteString+ decode wrong `shouldBe` (Left "too few bytes\nFrom:\tdemandInput\n\n" :: Either String EnumType)++ it "correct_error_for_named_struct_1" $ do+ let wrong = "\x01" :: ByteString+ decode wrong `shouldBe` (Left "too few bytes\nFrom:\tdemandInput\n\n" :: Either String TestType)++ it "correct_error_for_named_struct_2" $ do+ let wrong = "\0\0\0\0\x01" :: ByteString+ decode wrong `shouldBe` (Left "too few bytes\nFrom:\tdemandInput\n\n" :: Either String TestType)++ let u64_TEST_COMPACT_VALUES :: [(Word64, Int)]+ u64_TEST_COMPACT_VALUES =+ [ (0, 1), (63, 1), (64, 2), (16383, 2)+ , (16384, 4), (1073741823, 4), (1073741824, 5)+ , (bit 32 - 1, 5), (bit 32, 6), (bit 40, 7)+ , (bit 48, 8), (bit 56 - 1, 8), (bit 56, 9)+ , (maxBound, 9)+ ]++ it "compact_works" $ forM_ u64_TEST_COMPACT_VALUES $ \(n, l) -> do+ let encoded = encode (TestHasCompact $ Compact n)+ BS.length encoded `shouldBe` l+ decode encoded `shouldBe` Right (Compact n)++ let u64_TEST_COMPACT_VALUES_FOR_ENUM :: [(Word64, Int)]+ u64_TEST_COMPACT_VALUES_FOR_ENUM =+ [ (0, 2), (63, 2), (64, 3), (16383, 3), (16384, 5)+ , (1073741823, 5), (1073741824, 6), (bit 32 - 1, 6)+ , (bit 32, 7), (bit 40, 8), (bit 48, 9), (bit 56 - 1, 9)+ , (bit 56, 10), (maxBound, 10)+ ]++ it "enum_compact_works" $ forM_ u64_TEST_COMPACT_VALUES_FOR_ENUM $ \(x, l) -> do+ let u = encode $ Unnamed (Compact x)+ BS.length u `shouldBe` l+ decode u `shouldBe` Right (Unnamed $ Compact x)++ let n = encode $ Named (Compact x)+ BS.length n `shouldBe` l+ decode n `shouldBe` Right (Named $ Compact x)++ let uc = encode $ UnnamedCompact (Compact x)+ BS.length uc `shouldBe` l+ decode uc `shouldBe` Right (UnnamedCompact $ Compact x)++ let nc = encode $ NamedCompact (Compact x)+ BS.length nc `shouldBe` l+ decode nc `shouldBe` Right (NamedCompact $ Compact x)
+ tests/Codec/Scale/Test/SingleFieldStructSpec.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Codec.Scale.Test.SingleFieldStructSpec+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : Apache-2.0+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : unportable+--+-- Ported to Haskell rust test spec:+-- https://github.com/paritytech/parity-scale-codec/blob/master/tests/single_field_struct_encoding.rs+--++module Codec.Scale.Test.SingleFieldStructSpec where++import Data.ByteString as BS (pack)+import Data.Default (def)+import Data.Word (Word32, Word64)+import qualified GHC.Generics as GHC (Generic)+import Test.Hspec++import Codec.Scale+import Codec.Scale.Skip++newtype S = S { x1 :: Word32 }+ deriving (Eq, Ord, Show, Encode, Decode)++data SSkip = SSkip+ { s1 :: Skip Word32+ , x2 :: Word32+ , s2 :: Skip Word32+ }+ deriving (Eq, Ord, Show, GHC.Generic)++instance Generic SSkip+instance Encode SSkip+instance Decode SSkip++newtype Sc = Sc { x3 :: Compact Word32 }+ deriving (Eq, Ord, Show, Encode, Decode)++newtype U = U Word32+ deriving (Eq, Ord, Show, Enum, Num, Real, Integral, Encode, Decode)++newtype U2 = U2 { a :: Word64 }+ deriving (Eq, Ord, Show, Encode, Decode)++data USkip = USkip (Skip Word32) Word32 (Skip Word32)+ deriving (Eq, Ord, Show, GHC.Generic)++instance Generic USkip+instance Encode USkip+instance Decode USkip++newtype Uc = Uc (Compact Word32)+ deriving (Eq, Ord, Show, Encode, Decode)++newtype Ucas = Ucas (Compact U)+ deriving (Eq, Ord, Show, Encode, Decode)++spec :: Spec+spec = parallel $ do+ describe "Single field struct encoding" $ do+ let x = 3+ s = S x+ s_skip = SSkip def x def+ sc = Sc (Compact x)+ u = U x+ u_skip = USkip def x def+ uc = Uc (Compact x)+ ucom = Compact u+ ucas = Ucas (Compact u)++ s_encoded = BS.pack [3, 0, 0, 0]+ s_skip_encoded = BS.pack [3, 0, 0, 0]+ sc_encoded = BS.pack [12]+ u_encoded = BS.pack [3, 0, 0, 0]+ u_skip_encoded = BS.pack [3, 0, 0, 0]+ uc_encoded = BS.pack [12]+ ucom_encoded = BS.pack [12]+ ucas_encoded = BS.pack [12]++ it "encoding" $ do+ encode s `shouldBe` s_encoded+ encode s_skip `shouldBe` s_skip_encoded+ encode sc `shouldBe` sc_encoded+ encode u `shouldBe` u_encoded+ encode u_skip `shouldBe` u_skip_encoded+ encode uc `shouldBe` uc_encoded+ encode ucom `shouldBe` ucom_encoded+ encode ucas `shouldBe` ucas_encoded++ it "decoding" $ do+ Right s `shouldBe` decode s_encoded+ Right s_skip `shouldBe` decode s_skip_encoded+ Right sc `shouldBe` decode sc_encoded+ Right u `shouldBe` decode u_encoded+ Right u_skip `shouldBe` decode u_skip_encoded+ Right uc `shouldBe` decode uc_encoded+ Right ucom `shouldBe` decode ucom_encoded+ Right ucas `shouldBe` decode ucas_encoded
+ tests/Codec/Scale/Test/SkipSpec.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Codec.Scale.Test.SkipSpec+-- Copyright : Aleksandr Krupenkin 2016-2021+-- License : BSD3+--+-- Maintainer : mail@akru.me+-- Stability : experimental+-- Portability : unportable+--+-- Ported to Haskell rust test spec:+-- https://github.com/paritytech/parity-scale-codec/blob/master/tests/skip.rs+--++module Codec.Scale.Test.SkipSpec where++import Data.ByteString (ByteString, pack)+import Data.Default (Default)+import Data.Word (Word32)+import qualified GHC.Generics as GHC (Generic)+import Test.Hspec++import Codec.Scale+import Codec.Scale.SingletonEnum+import Codec.Scale.Skip++data UncodecType = UncodecType+ deriving (Eq, Ord, Show, GHC.Generic, Default)++-- Implementing A constructor is impossible+data EnumType = B+ { _b1 :: Skip UncodecType+ , b2 :: Word32+ }+ | C (Skip UncodecType) Word32+ deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode)+++data StructNamed = StructNamed+ { a :: Skip UncodecType+ , b :: Word32+ }+ deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode)++data StructUnnamed = StructUnnamed (Skip UncodecType) Word32+ deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode)++data NamedStruct = NamedStruct+ { some_named :: Word32+ , ignore :: Skip (Maybe Word32)+ }+ deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode)++spec :: Spec+spec = parallel $ do+ describe "Type encoding modificators" $ do+ it "enum_struct_test" $ do+ let eb = B { _b1 = Skip UncodecType, b2 = 1 }+ ec = C (Skip UncodecType) 1+ sn = StructNamed { a = Skip UncodecType, b = 1 }+ su = StructUnnamed (Skip UncodecType) 1++ let eb_encoded = encode eb :: ByteString+ let ec_encoded = encode ec :: ByteString+ let sn_encoded = encode sn :: ByteString+ let su_encoded = encode su :: ByteString++ decode eb_encoded `shouldBe` Right eb+ decode ec_encoded `shouldBe` Right ec+ decode sn_encoded `shouldBe` Right sn+ decode su_encoded `shouldBe` Right su++ it "skip_enum_struct_inner_variant" $ do+ let struct = NamedStruct { some_named = 1, ignore = Skip (Just 1) }+ single = SingletonEnum struct+ encoded = pack [0x00, 0x01, 0x00, 0x00, 0x00]+ encode single `shouldBe` encoded
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}