From f5fda366a1d18ee9a6b09364d0d22f1884668356 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Charlotte=20=F0=9F=A6=9D=20Delenk?= Date: Sat, 10 Jun 2023 15:12:37 +0100 Subject: [PATCH] Add Identity Multibase --- flake.nix | 2 +- matrix-media-expanded.cabal | 26 ++++++++++++++++++ src/Codec/Multibase.hs | 10 +++++++ src/Codec/Multibase/Error.hs | 4 +++ src/Codec/Multibase/Identity.hs | 17 ++++++++++++ test/Test.hs | 11 ++++++++ test/Test/Codec.hs | 7 +++++ test/Test/Codec/Multibase.hs | 7 +++++ test/Test/Codec/Multibase/Identity.hs | 38 +++++++++++++++++++++++++++ 9 files changed, 121 insertions(+), 1 deletion(-) create mode 100644 src/Codec/Multibase.hs create mode 100644 src/Codec/Multibase/Error.hs create mode 100644 src/Codec/Multibase/Identity.hs create mode 100644 test/Test.hs create mode 100644 test/Test/Codec.hs create mode 100644 test/Test/Codec/Multibase.hs create mode 100644 test/Test/Codec/Multibase/Identity.hs diff --git a/flake.nix b/flake.nix index ce83313..e1711f6 100644 --- a/flake.nix +++ b/flake.nix @@ -141,7 +141,7 @@ }; flake = { hydraJobs = { - inherit (inputs.self) packages devShells; + inherit (inputs.self) packages devShells checks; }; }; }; diff --git a/matrix-media-expanded.cabal b/matrix-media-expanded.cabal index 000415c..2934276 100644 --- a/matrix-media-expanded.cabal +++ b/matrix-media-expanded.cabal @@ -85,12 +85,38 @@ common shared , profunctors , relude >=1.0 , shower + , text , time , with-utf8 hs-source-dirs: src default-language: Haskell2010 +library + import: shared + exposed-modules: + Codec.Multibase + , Codec.Multibase.Error + , Codec.Multibase.Identity + executable matrix-media-expanded import: shared main-is: Main.hs + +test-suite test + import: shared + build-depends: + , tasty + , tasty-smallcheck + , tasty-quickcheck + , tasty-hunit + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + ghc-options: -main-is Test + other-modules: + Codec.Multibase.Error + , Codec.Multibase.Identity + , Test.Codec + , Test.Codec.Multibase + , Test.Codec.Multibase.Identity diff --git a/src/Codec/Multibase.hs b/src/Codec/Multibase.hs new file mode 100644 index 0000000..28a6feb --- /dev/null +++ b/src/Codec/Multibase.hs @@ -0,0 +1,10 @@ +module Codec.Multibase where + +import Codec.Multibase.Identity qualified as Identity +import Data.ByteString.Builder (toLazyByteString) +import Data.ByteString.Lazy (ByteString) +import Prelude hiding (ByteString) + +-- | Encode Bytes as a Multibase bytestring, using the most space efficient encoding. Unlike other formats, this does not return Text in any encoding. +encodeToMultihashBytes :: ByteString -> ByteString +encodeToMultihashBytes = toLazyByteString . Identity.encode diff --git a/src/Codec/Multibase/Error.hs b/src/Codec/Multibase/Error.hs new file mode 100644 index 0000000..ac2e6eb --- /dev/null +++ b/src/Codec/Multibase/Error.hs @@ -0,0 +1,4 @@ +module Codec.Multibase.Error where + +data ParseError = UnknownMulticodec | InvalidValue + deriving stock (Show, Eq) diff --git a/src/Codec/Multibase/Identity.hs b/src/Codec/Multibase/Identity.hs new file mode 100644 index 0000000..6b0d695 --- /dev/null +++ b/src/Codec/Multibase/Identity.hs @@ -0,0 +1,17 @@ +module Codec.Multibase.Identity where + +import Codec.Multibase.Error (ParseError (UnknownMulticodec)) +import Data.ByteString.Builder (Builder, lazyByteString, word8) +import Data.ByteString.Lazy (ByteString) +import Data.ByteString.Lazy qualified as B +import Prelude hiding (ByteString) + +-- | Encodes a ByteString as Multiformat identity +encode :: ByteString -> Builder +encode v = word8 0 <> lazyByteString v + +-- | Attempts to decode a ByteString as Multiformat identity +decode :: ByteString -> Either ParseError ByteString +decode v = case B.head v of + 0 -> Right $ B.tail v + _ -> Left UnknownMulticodec diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 index 0000000..2cb5173 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,11 @@ +module Test where + +import Main.Utf8 qualified as Utf8 +import Test.Codec qualified as Codec +import Test.Tasty (TestTree, defaultMain, testGroup) + +main :: IO () +main = Utf8.withUtf8 $ defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" [Codec.tests] diff --git a/test/Test/Codec.hs b/test/Test/Codec.hs new file mode 100644 index 0000000..6ed6b63 --- /dev/null +++ b/test/Test/Codec.hs @@ -0,0 +1,7 @@ +module Test.Codec where + +import Test.Codec.Multibase qualified as Multibase +import Test.Tasty (TestTree, testGroup) + +tests :: TestTree +tests = testGroup "Codec" [Multibase.tests] diff --git a/test/Test/Codec/Multibase.hs b/test/Test/Codec/Multibase.hs new file mode 100644 index 0000000..8d0f296 --- /dev/null +++ b/test/Test/Codec/Multibase.hs @@ -0,0 +1,7 @@ +module Test.Codec.Multibase where + +import Test.Codec.Multibase.Identity qualified as Identity +import Test.Tasty (TestTree, testGroup) + +tests :: TestTree +tests = testGroup "Multibase" [Identity.tests] diff --git a/test/Test/Codec/Multibase/Identity.hs b/test/Test/Codec/Multibase/Identity.hs new file mode 100644 index 0000000..faf44a4 --- /dev/null +++ b/test/Test/Codec/Multibase/Identity.hs @@ -0,0 +1,38 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use alternative" #-} +module Test.Codec.Multibase.Identity where + +import Codec.Multibase.Identity +import Data.ByteString.Builder (toLazyByteString) +import Data.ByteString.Lazy qualified as B +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.SmallCheck as SC + +tests :: TestTree +tests = testGroup "Identity" [scProps, unitTests] + +encode' :: B.ByteString -> B.ByteString +encode' = toLazyByteString . encode + +scProps :: TestTree +scProps = + testGroup + "SmallCheck" + [ SC.testProperty "decode . encode == id" $ \list -> + let lazyList = B.pack list + in decode (encode' lazyList) == Right lazyList + ] + +unitTests :: TestTree +unitTests = + testGroup + "Unit Tests" + [ testCase "Encoding the string 'yes mani !'" $ encode' "yes mani !" @?= "\0yes mani !" + , testCase "Decoding the Multibase '\\0yes mani !'" $ decode "\0yes mani !" @?= Right "yes mani !" + , testCase "Encoding the string '\\0yes mani !'" $ encode' "\0yes mani !" @?= "\0\0yes mani !" + , testCase "Decoding the Multibase '\\0\\0yes mani !'" $ decode "\0\0yes mani !" @?= Right "\0yes mani !" + , testCase "Encoding the string '\\0\\0yes mani !'" $ encode' "\0\0yes mani !" @?= "\0\0\0yes mani !" + , testCase "Decoding the Multibase '\\0\\0\\0yes mani !'" $ decode "\0\0\0yes mani !" @?= Right "\0\0yes mani !" + ]