tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

Object.hs (2052B)

      1 module ContentStore.Object
      2   ( Domain(..)
      3   , ObjectHash
      4   , StorePath(..)
      5   , hashObject
      6   , hashToText
      7   , textToHashBytes
      8   , validateObjectHash
      9   , verifyObjectBytes
     10   , shardForHash
     11   ) where
     12 
     13 import Crypto.Hash            (Digest, SHA256, hash)
     14 import Data.ByteArray         (convert)
     15 import Data.ByteString.Base16 (decode, encode)
     16 import Data.Text              (Text)
     17 import Data.Text.Encoding     (decodeUtf8, encodeUtf8)
     18 
     19 import qualified Data.ByteString as BS
     20 import qualified Data.Text       as T
     21 
     22 newtype Domain = Domain { unDomain :: Text }
     23   deriving (Eq, Ord, Show)
     24 
     25 type ObjectHash = Text
     26 
     27 newtype StorePath = StorePath { unStorePath :: FilePath }
     28   deriving (Eq, Ord, Show)
     29 
     30 hashObject :: Domain -> BS.ByteString -> ObjectHash
     31 hashObject (Domain domain) payload = hashToText digest
     32   where
     33     digest :: Digest SHA256
     34     digest = hash (encodeUtf8 domain <> BS.pack [0x00] <> payload)
     35 
     36 hashToText :: Digest SHA256 -> Text
     37 hashToText = decodeUtf8 . encode . (convert :: Digest SHA256 -> BS.ByteString)
     38 
     39 textToHashBytes :: Text -> Either String BS.ByteString
     40 textToHashBytes h = case decode (encodeUtf8 h) of
     41   Left _ -> Left "invalid hexadecimal hash"
     42   Right raw
     43     | BS.length raw == 32 -> Right raw
     44     | otherwise -> Left "hash must decode to 32 bytes"
     45 
     46 shardForHash :: ObjectHash -> FilePath
     47 shardForHash = T.unpack . T.take 3
     48 
     49 -- | Filesystem identities are canonical SHA-256 names, not arbitrary hex or
     50 -- paths. Keep this separate from the more permissive binary hex decoder.
     51 validateObjectHash :: ObjectHash -> Either String ()
     52 validateObjectHash h
     53   | T.length h == 64 && T.all (\c -> (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f')) h = Right ()
     54   | otherwise = Left $ "invalid object hash (expected 64 lowercase hex digits): " ++ show h
     55 
     56 verifyObjectBytes :: Domain -> ObjectHash -> BS.ByteString -> Either String ()
     57 verifyObjectBytes domain h bytes = do
     58   validateObjectHash h
     59   if hashObject domain bytes == h then Right ()
     60     else Left $ "object digest mismatch (" ++ T.unpack (unDomain domain) ++ "): " ++ T.unpack h