Add Identity Multibase

flake.nix

@@ -141,7 +141,7 @@
       };
       flake = {
         hydraJobs = {
-          inherit (inputs.self) packages devShells;
+          inherit (inputs.self) packages devShells checks;
         };
       };
     };

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

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

src/Codec/Multibase/Error.hs

@@ -0,0 +1,4 @@
+module Codec.Multibase.Error where
+
+data ParseError = UnknownMulticodec | InvalidValue
+  deriving stock (Show, Eq)

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

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]

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]

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]

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 !"
+    ]