added CID parsing

.gitignore

···
+.build/
+build/
+Multiformats-*
+.sw?
+.*.sw?
+package-version.txt

lib/Multiformats.pm

···
 package Multiformats;
 use strict;
 
-# ABSTRACT: Implementation of multiformats as per https://multiformats.io/
+# ABSTRACT: Implementation of several multiformats as per https://multiformats.io/ for use with ATprotocol
 
 # VERSION
 
-# this package exists purely as a little placeholder for various abstracts and versions;
-# the real meat is in the various sub-modules
+# this package exists purely as a little placeholder for various abstracts and versions; as well as some
+# of the documentation
 
 1;

lib/Multiformats/CID.pm

···
+package 
+    Multiformats::CID {
+
+    use feature 'signatures';
+    use Exporter 'import';
+    our @EXPORT_OK = qw/cid/;
+    use Multiformats::Varint qw/varint_decode_raw/;
+    use Multiformats::Multicodec qw/multicodec_get_codec multicodec_wrap/;
+    use Multiformats::Multibase qw/multibase_decode/;
+    use Multiformats::Multihash qw/multihash_unwrap/;
+
+    sub cid($bytes) {
+        utf8::downgrade($bytes, 1);
+
+        # so a v0 and v1 cid in binary should start with either 0x00 or 0x01 - if that isn't the case
+        # assume we have a string cid
+        if(substr($bytes, 0, 1) ne "\0" && substr($bytes, 0, 1) ne "\1") {
+            my $binary = multibase_decode($bytes);
+            return cid_from_binary($binary);
+        } else {
+            # binary
+            return cid_from_binary($bytes);
+        }
+    }
+
+    sub cid_from_binary($bytes) {
+        utf8::downgrade($bytes, 1);
+        my ($version, $bread)  = varint_decode_raw($bytes);
+        die 'Unsupported CID version ', $version, ', ' unless $version == 1;
+
+        my ($mc_codec, $bread_codec) = varint_decode_raw(substr($bytes, $bread));
+        
+        my $mc = Multiformats::Multicodec::_get_by_tag($mc_codec);
+
+        # not sure what that codec tag does in here because it doesn't appear to do
+        # anything short of encoding, well, nothing - the remaining data is the multihash 
+        my ($mh, $hash) = multihash_unwrap(substr($bytes, $bread + $bread_codec));
+       
+        return Multiformats::CID::CIDv1->new(version => 1, codec => $mc->[0], hash_function => $mh->[0], hash => $hash);  
+    }
+}
+
+package 
+    Multiformats::CID::CIDv1 {
+    use Mojo::Base -base, -signatures;
+    use Multiformats::Multicodec qw/multicodec_wrap multicodec_unwrap/;
+    use Multiformats::Multibase qw/multibase_encode/;
+    use Multiformats::Varint qw/varint_encode/;
+    use Multiformats::Multihash qw/multihash_wrap/;
+    use overload bool => sub {1}, '""' => sub { shift->to_str }, fallback => 1;
+
+    # note that the codecs are the tag values, not the names, we need to take this into account
+    # in multibase_encode and multihash_encode
+    has [qw/version codec hash_function hash/] => undef;
+
+    sub to_str($self, $codec = 'base32') {
+        return multibase_encode($codec, $self->to_bytes);
+    }
+
+    sub to_bytes($self) {
+        my $hash    = multihash_wrap($self->hash_function, $self->hash);
+        my $content = multicodec_wrap($self->codec, $hash);
+        my $version = varint_encode($self->version);
+        return $version . $content; 
+    }
+}
+
+1;
+    
+

lib/Multiformats/Multibase.pm

···
         return bless({}, $pkg);
     }
 
-    # these 2 maps map the actual encoding and decoding
-    # to a subroutine that takes the to be decoded/encoded values as first argument
-    # please note that only a few formats are implemented by default
-    use constant MB_ENCODE_MAP => {
-        'none'          =>  sub { return "\0" . shift },
-        'base32'        =>  sub { return 'b' . encode_b32r(shift) },
-        'base36'        =>  sub { return 'k' . encode_base36(shift) },
-        'base58btc'     =>  sub { return 'z' . encode_b58b(shift) },
-    };
+    # this map holds the various encodings and decodings
+    use constant MB_MAP => [
+        [ 'none',       "\0",   sub { return shift },                       sub { return shift }                        ],
+        [ 'base32',     'b',    sub { return lc(encode_b32r(shift)) },      sub { return decode_b32r(uc(shift)) }       ],
+        [ 'base32upper','B',    sub { return encode_b32r(shift) },          sub { return decode_b32r(shift) }           ],
+        [ 'base36',     'k',    sub { return lc(encode_base36(shift)) },    sub { return decode_base36(shift) }         ],
+        [ 'base58btc',  'z',    sub { return encode_b58b(shift) },          sub { return decode_b58b(shift) }           ],
+    ];
+
+    sub _map_by_tag($tag) {
+        foreach my $entry (@{__PACKAGE__->MB_MAP}) {
+            return $entry if($entry->[1] eq $tag);
+        }
+        return undef;
+    }
 
-    use constant MB_DECODE_MAP => {
-        "\0"            =>  sub { return shift },
-        'b'             =>  sub { return decode_b32r(shift) },
-        'k'             =>  sub { return decode_base36(shift) },
-        'z'             =>  sub { return decode_b58b(shift) },
-    };
+    sub _map_by_name($name) {
+        if(length($name) == 1) {
+            return _map_by_tag($name);
+        } else {
+            foreach my $entry (@{__PACKAGE__->MB_MAP}) {
+                return $entry if($entry->[0] eq $name);
+            }
+            return undef;
+        }
+    }
 
     sub multibase_decode($bytes) {
+        # make sure it's actual bytes
+        utf8::downgrade($bytes, 1);
         my $t = substr($bytes, 0, 1);
-        die 'unknown format ' . $t . ', ' unless exists MB_DECODE_MAP->{$t};
-        return MB_DECODE_MAP->{$t}->(substr($bytes, 1));
+        if(my $e = _map_by_tag($t)) {
+            my $decoded = $e->[3]->(substr($bytes, 1));
+            return wantarray
+                ? ($t, $decoded)
+                : $decoded;
+        } else {
+            die 'unknown format ' . $t . ', ';
+        }
     }
 
     sub multibase_encode($as, $bytes) {
-        die 'unknown format ' . $as . ', ' unless exists MB_ENCODE_MAP->{$as};
-        return MB_ENCODE_MAP->{$as}->($bytes);
+        utf8::downgrade($bytes, 1);
+        if(my $e = _map_by_name($as)) {
+            my $encoded = $e->[1] . $e->[2]->($bytes);
+            return $encoded;
+        } else {
+            die 'unknown format ' . $as . ', ';
+        }
     }
 }
 

lib/Multiformats/Multicodec.pm

···
+package 
+    Multiformats::Multicodec {
+    use strict;
+    use warnings;
+    use feature 'signatures';
+    use Multiformats::Varint qw/varint_decode_raw varint_encode/;
+
+    use Exporter 'import';
+    our @EXPORT_OK = qw/multicodec_wrap multicodec_unwrap multicodec_get_codec/;
+
+    use constant MULTICODEC_MAP => [
+        [ 'raw',  0x55 ],
+        [ 'dag-cbor', 0x71 ],
+    ];
+
+    sub _get_by_name($as) {
+        foreach my $entry (@{__PACKAGE__->MULTICODEC_MAP}) {
+            return $entry if($entry->[0] eq $as);
+        }
+        return _get_by_tag($as);
+    }
+
+    sub _get_by_tag($tag) {
+        foreach my $entry (@{__PACKAGE__->MULTICODEC_MAP}) {
+            return $entry if($entry->[1] == $tag);
+        }
+        return undef;
+    }
+
+    sub multicodec_wrap($as, $value) {
+        utf8::downgrade($value, 1);
+        if(my $e = _get_by_name($as)) {
+            my $id = varint_encode($e->[1]);
+            return $id . $value; 
+        } else {
+            die 'Unsupported multicodec type ', $as, ', ';
+        }
+    }
+
+    sub multicodec_unwrap($value) {
+        utf8::downgrade($value, 1);
+        my ($id, $bytes) = varint_decode_raw($value);
+        return substr($value, $bytes);
+
+    }
+
+    sub multicodec_get_codec($value) {
+        utf8::downgrade($value, 1);
+        my ($id, $bytes) = varint_decode_raw($value);
+        if(my $e = _get_by_tag($id)) {
+            return $e; 
+        } else {
+            die 'Unsupported multicodec type ', $id, ', ';
+        }
+    }
+}
+
+1;

lib/Multiformats/Multihash.pm

···
+package 
+    Multiformats::Multihash {
+    use strict;
+    use warnings;
+    use feature 'signatures';
+
+    use Exporter 'import';
+    our @EXPORT_OK = qw/multihash_encode multihash_decode multihash_wrap multihash_unwrap/;
+
+    use Digest::SHA qw/sha1 sha256 sha384 sha512/; # SHA2
+    use Digest::SHA3 qw/sha3_224 sha3_384 sha3_256/;
+    use Multiformats::Varint qw/varint_decode_raw varint_encode/;
+
+    sub decode($self, $value) {
+        return multihash_decode($value);
+    }
+
+    sub encode($self, $as, $value) {
+        return multihash_encode($as, $value);
+    }
+
+    sub new($pkg) {
+        return bless({}, $pkg);
+    }
+
+    # this map holds the various encodings and decodings
+    use constant MULTIFORMAT_MAP => [
+        [ 'identity',   0x00,     undef, sub { return shift } ],
+        [ 'sha1',       0x11,     undef, sub { return sha1(shift) } ],
+        [ 'sha2-256',   0x12,     undef, sub { return sha256(shift) } ],
+        [ 'sha2-512',   0x13,     undef, sub { return sha512(shift) } ],
+        [ 'sha3-384',   0x15,     undef, sub { return sha3_384(shift) } ],
+        [ 'sha3-256',   0x16,     undef, sub { return sha3_256(shift) } ],
+        [ 'sha3-224',   0x17,     undef, sub { return sha3_224(shift) } ],
+        [ 'sha2-384',   0x20,     undef, sub { return sha_384(shift) } ],
+    ];
+
+    sub codecs { 
+        return __PACKAGE__->MULTIFORMAT_MAP;
+    }
+
+    sub _map_by_tag($tag) {
+        foreach my $entry (@{__PACKAGE__->MULTIFORMAT_MAP}) {
+            return $entry if($entry->[1] == $tag);
+        }
+        return undef;
+    }
+
+    sub _map_by_name($name) {
+        foreach my $entry (@{__PACKAGE__->MULTIFORMAT_MAP}) {
+            return $entry if($entry->[0] eq $name);
+        }
+        return _map_by_tag($name);  
+    }
+
+    sub multihash_decode($bytes) {
+        # make sure it's actual bytes
+        utf8::downgrade($bytes, 1);
+
+        my ($t, $bread_type) = varint_decode_raw($bytes);
+        if(my $e = _map_by_tag($t)) {
+            my ($l, $bread_len) = varint_decode_raw(substr($bytes, $bread_type));
+            return substr($bytes, $bread_type + $bread_len); # there isn't any decoding since hashes are a one-way street so we just return the actual value
+        } else {
+            die 'unknown format ' . $t . ', ';
+        }
+    }
+
+    sub multihash_unwrap($bytes) {
+        utf8::downgrade($bytes, 1);
+
+        my ($t, $bread_type) = varint_decode_raw($bytes);
+        if(my $e = _map_by_tag($t)) {
+            my ($l, $bread_len) = varint_decode_raw(substr($bytes, $bread_type));
+            return wantarray
+                ? ($e, substr($bytes, $bread_type + $bread_len))            # allows us to get the whole kit and kaboodle in one sitting 
+                : substr($bytes, $bread_type + $bread_len)
+        } else {
+            die 'unknown format ' . $t . ', ';
+        }
+    }
+
+    sub multihash_wrap($as, $bytes) {
+        utf8::downgrade($bytes, 1);
+        if(my $e = _map_by_name($as)) {
+            return varint_encode($e->[1]) . varint_encode(length($bytes)) . $bytes;
+        } else {
+            die 'unknown format ' . $as . ', ';
+        }
+    }
+
+    sub multihash_encode($as, $bytes) {
+        utf8::downgrade($bytes, 1);
+        if(my $e = _map_by_name($as)) {
+            my $hash = $e->[3]->($bytes);
+            return varint_encode($e->[1]) . varint_encode(length($hash)) . $hash;
+        } else {
+            die 'unknown format ' . $as . ', ';
+        }
+    }
+}
+
+1;

lib/Multiformats/Varint.pm

···
 
     # varint_encode, varint_decode_raw and varint_decode lifted from python multiformats https://github.com/hashberg-io/multiformats
     sub varint_encode($value) {
-        die 'PerlDS::Encoding::varint_encode: cannot encode negative values' unless $value >= 0;
+        die 'Multiformats::Varint::varint_encode: cannot encode negative values' unless $value >= 0;
         my @out = ();
         while(1) {
             my $next_byte = $value & 0b01111111;
···
                 last;
             }
         }
-        die 'PerlDS::Encoding::varint_encode: encoded varint > 9 bytes' unless scalar(@out) <= 9;
+        die 'Multiformats::Varint::varint_encode: encoded varint > 9 bytes' unless scalar(@out) <= 9;
         return wantarray 
             ? (pack('C*', @out), scalar(@out))
             : pack('C*', @out)
···
 
     sub varint_decode($value) {
         my ($x, $read) = varint_decode_raw($value);
-        die 'PerlDS::Encoding::varint_decode: not all bytes used by encoding' if($read > length($value)); 
+        die 'Multiformats::Varint::varint_decode: not all bytes used by encoding' if($read > length($value)); 
         return $x;
     }
 
···
                                         # via the num_bytes_read later
 
         while($expect_next) {
-            die 'PerlDS::Encoding::varint_decode: no next byte to read' if $num_bytes_read >= scalar(@buf);
+            die 'Multiformats::Varint::varint_decode_raw: no next byte to read' if $num_bytes_read >= scalar(@buf);
             my $next_byte = $buf[$num_bytes_read];
             $x += ($next_byte & 0b01111111) << (7 * $num_bytes_read);
             $expect_next = ($next_byte >> 7 == 0b1) ? 1 : undef;

t/003_multihash.t

···
+use Test::More;
+
+use_ok('Multiformats::Multihash');
+
+done_testing();

t/004_multicodec.t

···
+use Test::More;
+
+use_ok('Multiformats::Multicodec');
+
+done_testing();

t/005_cid.t

···
+use Test::More;
+
+use_ok('Multiformats::CID');
+
+my $binary = "\1q\22 |\b\217\356\37\274\0\216H\230\361\"\234\4\243ZFc\225`\26k\316\$\363\tfQ\234\307\3550";
+
+my $cid = Multiformats::CID::cid($binary); 
+
+is(ref($cid), 'Multiformats::CID::CIDv1', 'cid returns proper object');
+
+my $str = $cid->to_str; 
+
+my $cid2 = Multiformats::CID::cid($str); 
+
+is(ref($cid2), 'Multiformats::CID::CIDv1', 'cid returns proper object for string cid');
+
+is($cid2->hash, $cid->hash, 'hashes match');
+
+
+
+done_testing();