Internal.hs

-- |
-- Module      : Crypto.Multihash.Internal
-- License     : BSD3
-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
{-# LANGUAGE OverloadedStrings #-}
module Crypto.Multihash.Internal where

import Data.ByteArray (ByteArrayAccess(..))
import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Encoding as BE
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base58 as B58
import Data.List (elemIndices)
import Data.Word (Word8)

-------------------------------------------------------------------------------
import Crypto.Multihash.Internal.Types
-------------------------------------------------------------------------------

-- | Convert a maybe type to an either type
maybeToEither :: l -> Maybe r -> Either l r
maybeToEither _ (Just res) = Right res
maybeToEither err _        = Left err

-- | Codes corresponding to the various hash algorithms
hashCodes :: [Word8]
hashCodes = map fromIntegral
                ([0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x40, 0x41]::[Int])

-- | Convert a 'BS.ByteString' from a 'Base' into a 'BS.ByteString' in 'Base2'.
convertFromBase :: Base -> BS.ByteString -> Either String BS.ByteString
convertFromBase b bs = case b of
  Base2  -> Left "This is not supposed to happen"
  Base16 -> BE.convertFromBase BE.Base16 bs
  Base32 -> BE.convertFromBase BE.Base32 bs
  Base58 -> do
    dec <- maybeToEither "Base58 decoding error" (B58.decodeBase58 B58.bitcoinAlphabet bs)
    return (BA.convert dec)
  Base64 -> BE.convertFromBase BE.Base64 bs

-- | Infer the 'Base' encoding function from an encoded 'BS.BinaryString'.
--   Supports only 'Base16', bitcoin 'Base58' and 'Base64' for the moment.
--   NOTE: it can fail or _infer the wrong encoding_ if the string is too short
--   or if it is encoded using a different standard.
getBase :: BS.ByteString -> Either String Base
getBase h = if len == 0 
  then 
    Left "Unable to infer an encoding" 
  else 
    pure $ [Base16, Base32, Base58, Base64] !! head bsi
  where
    len = Prelude.length bsi
    bsi = elemIndices 0 $ map (unmatch h) [b16Alphabet, b32Alphabet, b58Alphabet, b64Alphabet]
    unmatch str alphabet = BS.length $ BS.filter (`BS.notElem` alphabet) str

    b16Alphabet :: BS.ByteString
    b16Alphabet = "0123456789abcdef"

    -- from RFC https://tools.ietf.org/rfc/rfc4648.txt
    -- same one used by Hasekll's `memory` for the encoding/decoding
    b32Alphabet :: BS.ByteString
    b32Alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567="

    b58Alphabet :: BS.ByteString
    b58Alphabet = B58.unAlphabet B58.bitcoinAlphabet

    b64Alphabet :: BS.ByteString
    b64Alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

-- TODO: test this with quickcheck

-- old implementation
-- getBase :: BS.ByteString -> Either String Base
-- getBase h
--       | startWiths h ["1114", "1220", "1340", "1440", "1530", "1620", "171c", "4040", "4120"] = Right Base16
--       | startWiths h ["5d", "Qm", "8V", "8t", "G9", "W1", "5d", "S2", "2U"] = Right Base58
--       | startWiths h ["ER", "Ei", "E0", "FE", "FT", "Fi", "Fx", "QE", "QS"] = Right Base64
--       | otherwise = Left "Unable to infer an encoding"
--       where startWiths h = any (`BS.isPrefixOf` h)


-- | Encode the binary data using a given 'Base'.
encoder :: ByteArrayAccess a => Base -> a -> Either String BA.Bytes
encoder base bs = case base of
            Base2  -> return $ BA.convert bs
            Base16 -> return $ BE.convertToBase BE.Base16 bs
            Base32 -> return $ BE.convertToBase BE.Base32 bs
            Base58 -> return $ BA.convert $ B58.encodeBase58 B58.bitcoinAlphabet 
                                                             (BA.convert bs :: BS.ByteString)
            Base64 -> return $ BE.convertToBase BE.Base64 bs

-- | Compare the lenght of the encoded multihash digest with the encoded hash length.
--   Return 'True' if the lengths are matching.
badLength :: ByteArrayAccess bs => bs -> Bool
badLength mh = 
      case BA.length mh of
        n | n <= 2 -> True
        n | BA.index mh 1 /= (fromIntegral n-2) -> True
        _ -> False