ipld-cid (empty) → 0.1.0.0
raw patch · 6 files changed
+470/−0 lines, 6 filesdep +basedep +binarydep +binary-varint
Dependencies added: base, binary, binary-varint, bytestring, cryptonite, deepseq, hashable, hedgehog, ipld-cid, multibase, multihash-cryptonite, text
Files
- CHANGELOG.md +0/−0
- LICENSE +30/−0
- README.md +4/−0
- ipld-cid.cabal +81/−0
- src/Data/IPLD/CID.hs +229/−0
- test/properties/Main.hs +126/−0
+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Monadic GmbH++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Monadic GmbH nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,4 @@+Haskell types describing [Content Identifiers](https://github.com/multiformats/cid) (CIDs).++CIDs are "self-describing content-addressed identifiers" and are central to+addressing in [IPFS](https://ipfs.io), respectively [IPLD](https://ipld.io).
+ ipld-cid.cabal view
@@ -0,0 +1,81 @@+cabal-version: 2.2+build-type: Simple++name: ipld-cid+version: 0.1.0.0+synopsis: IPLD Content-IDentifiers <https://github.com/ipld/cid>+homepage: https://github.com/oscoin/ipfs+bug-reports: https://github.com/oscoin/ipfs/issues+license: BSD-3-Clause+license-file: LICENSE+author: Kim Altintop+maintainer: Kim Altintop <kim@monadic.xyz>, Monadic Team <team@monadic.xyz>+copyright: 2018 Monadic GmbH++category: Data++extra-source-files:+ CHANGELOG.md+ , README.md++source-repository head+ type: git+ location: https://github.com/oscoin/ipfs++common common+ default-language: Haskell2010+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fprint-expanded-synonyms+ -funbox-small-strict-fields+ default-extensions:+ DeriveGeneric+ LambdaCase+ MultiWayIf+ NamedFieldPuns+ RecordWildCards+ StrictData+ TupleSections++library+ import: common+ hs-source-dirs: src+ exposed-modules:+ Data.IPLD.CID++ build-depends:+ base >= 4.9 && < 5+ , binary+ , binary-varint+ , bytestring+ , cryptonite+ , deepseq+ , hashable+ , multibase+ , multihash-cryptonite+ , text++test-suite properties+ import: common+ main-is: Main.hs+ hs-source-dirs: test/properties+ type: exitcode-stdio-1.0++ build-depends:+ base+ , bytestring+ , cryptonite+ , hedgehog+ , ipld-cid+ , multibase+ , multihash-cryptonite+ , text++ ghc-options:+ -threaded+ -rtsopts+ -with-rtsopts=-N
+ src/Data/IPLD/CID.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Copyright : 2018 Monadic GmbH+-- License : BSD3+-- Maintainer : kim@monadic.xyz, team@monadic.xyz+-- Stability : provisional+-- Portability : non-portable (GHC extensions)+--+-- <https://github.com/ipld/cid Content IDentifiers>+--+-- \"CID is a format for referencing content in distributed information systems,+-- like IPFS. It leverages content addressing, cryptographic hashing, and+-- self-describing formats. It is the core identifier used by IPFS and IPLD.\"+module Data.IPLD.CID+ ( Version (..)+ , Codec (..)++ , CID+ , cidVersion+ , cidCodec+ , cidHash+ , newCidV0+ , newCidV1+ , buildCid+ , decodeCid+ , getCid++ , cidFromText+ , cidToText++ , codecToCode+ , codecFromCode+ )+where++import Control.DeepSeq (NFData)+import Control.Monad ((>=>))+import Crypto.Hash (Digest, SHA256)+import Data.Bifunctor (bimap)+import Data.Binary.Get as Binary+import Data.Binary.VarInt (buildVarInt, getVarInt)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.BaseN as BaseN+import Data.ByteString.Builder (Builder)+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Multibase as Multibase+import Data.Hashable (Hashable)+import Data.Multihash (Multihash, Multihashable)+import qualified Data.Multihash as Multihash+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Word (Word8)+import GHC.Generics (Generic)++-- | Specification version.+data Version = V0 | V1+ deriving (Eq, Show, Ord, Enum, Bounded, Generic)++instance Hashable Version+instance NFData Version++-- | The content type or format of the data being addressed, specified as a+-- <https://github.com/multiformats/multicodec multicodec>.+--+-- Note that we do not currently have a full multicodec implementation, as it is+-- overly complicated for our purposes. We also only support 'Codec's on an+-- as-needed basis. Future versions may utilise a separate library.+data Codec+ = Raw+ | DagProtobuf+ | DagCbor+ | GitRaw+ deriving (Eq, Show, Ord, Generic)++instance Hashable Codec+instance NFData Codec++-- | A Content IDentifier.+--+-- * 'V0' 'CID's are merely SHA256 hashes, base58-encoded using the bitcoin+-- alphabet. The 'Codec' is implicitly 'DagProtobuf'.+-- * 'V1' 'CID's may use any 'Multihash', and any of the supported 'Codec's.+data CID = CID+ { cidVersion :: Version+ , cidCodec :: Codec+ , cidHash :: Multihash+ } deriving (Eq, Ord, Generic)++instance Hashable CID+instance NFData CID++instance Show CID where+ show = Text.unpack . cidToText++instance Read CID where+ readsPrec _ =+ either (const []) (\cid -> [(cid, "")]) . cidFromText . Text.pack++-- CID -------------------------------------------------------------------------++-- | Create a 'V0' 'CID'.+newCidV0 :: Digest SHA256 -> CID+newCidV0 dig = CID+ { cidVersion = V0+ , cidCodec = DagProtobuf+ , cidHash = Multihash.fromDigest dig+ }++-- | Create a 'V1' 'CID'.+newCidV1 :: Multihashable a => Codec -> Digest a -> CID+newCidV1 codec dig = CID+ { cidVersion = V1+ , cidCodec = codec+ , cidHash = Multihash.fromDigest dig+ }++-- | Serialise a 'CID'.+buildCid :: CID -> Builder+buildCid CID{..} = case cidVersion of+ V0 -> Builder.byteString (Multihash.encodedBytes cidHash)+ V1 -> buildVarInt (fromEnum cidVersion)+ <> buildVarInt (codecToCode cidCodec)+ <> Builder.byteString (Multihash.encodedBytes cidHash)++-- | Decode a 'CID' from a strict 'ByteString'.+--+-- @+-- decodeCid . buildCid ≡ Right+-- @+decodeCid :: ByteString -> Either String CID+decodeCid bs+ | isV0 = newCidV0 <$> Multihash.decodeDigest bs+ | otherwise = bimap _3 _3 . Binary.runGetOrFail getCid $ LBS.fromStrict bs+ where+ isV0 = BS.length bs == 34 && magic == BS.take 2 bs+ magic = BS.pack [18,32]++ _3 (_,_,x) = x++-- | Deserialise a 'CID' in the 'Binary.Get' monad.+--+-- Note that this does __/not/__ support 'V0' 'CID's.+getCid :: Binary.Get CID+getCid = do+ cidVersion <- do+ v <- Binary.getWord8 >>= getVarInt+ if v < minVersion || v > maxVersion then+ fail $ "CID: Invalid version: " <> show v+ else+ pure $ toEnum v++ case cidVersion of+ V1 -> do+ cidCodec <- do+ c <- Binary.getWord8 >>= getVarInt+ maybe (fail ("CID: Unknown Codec: " <> show c)) pure+ $ codecFromCode c+ cidHash <- Multihash.getMultihash+ pure CID{..}+ v -> fail $ "CID: Unsupported version: " <> show v+ where+ maxVersion = fromEnum (maxBound :: Version)+ minVersion = fromEnum (minBound :: Version)++-- | Decode a 'CID' from a textual representation.+--+-- The 'Text' value is expected to be base58 (bitcoin) encoded (for 'V0'+-- 'CID's), or a valid 'Multibase'.+--+-- @+-- cidFromText . cidToText ≡ id+-- @+cidFromText :: Text -> Either String CID+cidFromText t = decodeBase >=> decodeCid $ encodeUtf8 t+ where+ isV0 = Text.length t == 46 && "Qm" `Text.isPrefixOf` t++ decodeBase | isV0 = BaseN.decodeBase58btc+ | otherwise = Multibase.decode >=> guardReserved++ -- "If the first decoded byte is 0x12, return an error. CIDv0 CIDs may not+ -- be multibase encoded and there will be no CIDv18 (0x12 = 18) to prevent+ -- ambiguity with decoded CIDv0s."+ guardReserved bs = case BS.uncons bs of+ Just (x, _) | x == 18 -> Left "CID > V0 starts with reserved byte 0x12"+ _ -> Right bs++-- | Encode a 'CID' to a textual representation.+--+-- The result is either a base58 (bitcoin) encoded string of just the 'cidHash'+-- value for 'V0' 'CID's, or otherwise a 'Multibase' value at base 'Base58btc'+-- of the binary representation of the 'CID' (as produced by 'buildCid').+cidToText :: CID -> Text+cidToText cid =+ decodeUtf8+ $ case cidVersion cid of+ V0 -> BaseN.encodedBytes+ . BaseN.encodeBase58btc+ . Multihash.encodedBytes+ $ cidHash cid+ V1 -> Multibase.fromMultibase+ . Multibase.encode+ . BaseN.encodeBase58btc+ . LBS.toStrict . Builder.toLazyByteString+ $ buildCid cid++-- Codec -----------------------------------------------------------------------++-- | <https://github.com/multiformats/multicodec multicodec> numerical code of+-- the given 'Codec'.+codecToCode :: Codec -> Word8+codecToCode Raw = 0x55+codecToCode DagProtobuf = 0x70+codecToCode DagCbor = 0x71+codecToCode GitRaw = 0x78++-- | Attempt to convert from a <https://github.com/multiformats/multicodec multicodec>+-- numerical code to a 'Codec'.+codecFromCode :: Word8 -> Maybe Codec+codecFromCode 0x55 = pure Raw+codecFromCode 0x70 = pure DagProtobuf+codecFromCode 0x71 = pure DagCbor+codecFromCode 0x78 = pure GitRaw+codecFromCode _ = Nothing
+ test/properties/Main.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Control.Monad (unless)+import qualified Crypto.Hash as C+import Data.ByteString (ByteString)+import qualified Data.ByteString.BaseN as BaseN+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as LBS+import Data.Foldable (for_)+import Data.Functor.Identity (Identity)+import Data.List (isInfixOf)+import Data.Text.Encoding (decodeUtf8)+import System.Exit (exitFailure)+import System.IO (BufferMode(..), hSetBuffering, stderr, stdout)++import Data.ByteString.Multibase (fromMultibase)+import qualified Data.ByteString.Multibase as Multibase+import Data.IPLD.CID+ ( CID+ , buildCid+ , cidFromText+ , cidToText+ , newCidV0+ , newCidV1+ )+import qualified Data.IPLD.CID as CID+import Data.Multihash (Multihash, Multihashable)+import qualified Data.Multihash as Multihash+import Data.Multihash.Internal (HashAlgorithm(..))++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++main :: IO ()+main = do+ for_ [stdout, stderr] $ flip hSetBuffering LineBuffering++ ok <- props+ unless ok exitFailure++props :: IO Bool+props = checkParallel $$(discover)++prop_roundtripBytes :: Property+prop_roundtripBytes = property $ do+ cid <- forAll genCID+ tripping cid (Builder.toLazyByteString . buildCid) (CID.decodeCid . LBS.toStrict)++prop_roundtripText :: Property+prop_roundtripText = property $ do+ cid <- forAll genCID+ tripping cid cidToText cidFromText++-- | "If the first decoded byte is 0x12, return an error. CIDv0 CIDs may not be+-- multibase encoded and there will be no CIDv18 (0x12 = 18) to prevent+-- ambiguity with decoded CIDv0s."+--+-- It seems like the only way this can happen is to pass a 'C.SHA256'+-- 'Multihash' (or an arbitrary byte sequence which happens to start with 0x12),+-- encoded at some base /= 'Base58btc'. ie. the multibase encoding has to be+-- valid.+prop_ambiguousVersion :: Property+prop_ambiguousVersion = property $ do+ hash <- forAllWith (show . Multihash.encodedBytes) (genMultihash C.SHA256)+ let+ encoded = Multibase.encode (BaseN.encodeAtBase BaseN.Base32 . Multihash.encodedBytes $ hash)+ notACid = decodeUtf8 $ fromMultibase encoded+ fromTxt = cidFromText notACid+ in do+ annotate (show $ fromMultibase encoded)+ annotateShow notACid+ annotateShow fromTxt+ case fromTxt of+ Left e | "reserved" `isInfixOf` e -> success+ _ -> failure+-- Generators ------------------------------------------------------------------++genCID :: GenT Identity CID+genCID = Gen.choice [v0, v1]+ where+ v0 = newCidV0 <$> genDigest+ v1 = do+ codec <- genCodec+ algo <- genHashAlgorithm+ case algo of+ Blake2s_160 -> newCidV1 codec <$> genDigest @C.Blake2s_160+ Blake2s_224 -> newCidV1 codec <$> genDigest @C.Blake2s_224+ Blake2s_256 -> newCidV1 codec <$> genDigest @C.Blake2s_256+ Blake2b_160 -> newCidV1 codec <$> genDigest @C.Blake2b_160+ Blake2b_224 -> newCidV1 codec <$> genDigest @C.Blake2b_224+ Blake2b_256 -> newCidV1 codec <$> genDigest @C.Blake2b_256+ Blake2b_384 -> newCidV1 codec <$> genDigest @C.Blake2b_384+ Blake2b_512 -> newCidV1 codec <$> genDigest @C.Blake2b_512+ MD4 -> newCidV1 codec <$> genDigest @C.MD4+ MD5 -> newCidV1 codec <$> genDigest @C.MD5+ SHA1 -> newCidV1 codec <$> genDigest @C.SHA1+ SHA256 -> newCidV1 codec <$> genDigest @C.SHA256+ SHA512 -> newCidV1 codec <$> genDigest @C.SHA512+ Keccak_224 -> newCidV1 codec <$> genDigest @C.Keccak_224+ Keccak_256 -> newCidV1 codec <$> genDigest @C.Keccak_256+ Keccak_384 -> newCidV1 codec <$> genDigest @C.Keccak_384+ Keccak_512 -> newCidV1 codec <$> genDigest @C.Keccak_512+ SHA3_224 -> newCidV1 codec <$> genDigest @C.SHA3_224+ SHA3_256 -> newCidV1 codec <$> genDigest @C.SHA3_256+ SHA3_384 -> newCidV1 codec <$> genDigest @C.SHA3_384+ SHA3_512 -> newCidV1 codec <$> genDigest @C.SHA3_512++genMultihash :: forall a. Multihashable a => a -> GenT Identity Multihash+genMultihash _ = Multihash.fromDigest <$> genDigest @a++genDigest :: Multihashable a => GenT Identity (C.Digest a)+genDigest = C.hash <$> genBytes++genHashAlgorithm :: GenT Identity Multihash.HashAlgorithm+genHashAlgorithm = Gen.prune Gen.enumBounded++genBytes :: GenT Identity ByteString+genBytes = Gen.prune $ Gen.bytes (Range.singleton 255)++genCodec :: GenT Identity CID.Codec+genCodec = Gen.element [CID.Raw, CID.DagProtobuf, CID.DagCbor, CID.GitRaw]