{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
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)
data Version = V0 | V1
deriving (Eq, Show, Ord, Enum, Bounded, Generic)
instance Hashable Version
instance NFData Version
data Codec
= Raw
| DagProtobuf
| DagCbor
| GitRaw
deriving (Eq, Show, Ord, Generic)
instance Hashable Codec
instance NFData Codec
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
newCidV0 :: Digest SHA256 -> CID
newCidV0 dig = CID
{ cidVersion = V0
, cidCodec = DagProtobuf
, cidHash = Multihash.fromDigest dig
}
newCidV1 :: Multihashable a => Codec -> Digest a -> CID
newCidV1 codec dig = CID
{ cidVersion = V1
, cidCodec = codec
, cidHash = Multihash.fromDigest dig
}
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)
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
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)
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
guardReserved bs = case BS.uncons bs of
Just (x, _) | x == 18 -> Left "CID > V0 starts with reserved byte 0x12"
_ -> Right bs
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
codecToCode :: Codec -> Word8
codecToCode Raw = 0x55
codecToCode DagProtobuf = 0x70
codecToCode DagCbor = 0x71
codecToCode GitRaw = 0x78
codecFromCode :: Word8 -> Maybe Codec
codecFromCode 0x55 = pure Raw
codecFromCode 0x70 = pure DagProtobuf
codecFromCode 0x71 = pure DagCbor
codecFromCode 0x78 = pure GitRaw
codecFromCode _ = Nothing