FieldName.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- This module keeps the FieldName type abstract,
-- to ensure that the field name hash is correct
module Codec.Candid.FieldName
  ( FieldName
  , labledField
  , hashedField
  , fieldHash
  , candidHash
  , invertHash
  , unescapeFieldName
  , escapeFieldName
  ) where

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString.Lazy as BS
import Data.Text.Prettyprint.Doc
import Data.String
import Data.Maybe
import Data.Word
import Data.Char
import Numeric.Natural
import Data.Function
import Text.Read (readMaybe)

-- | A type for a Candid field name. Essentially a 'Word32' with maybe a textual label attached
data FieldName = FieldName
    { fieldHash :: Word32 -- ^ Extract the raw field hash value
    , fieldName :: Maybe T.Text
    }
  deriving Show

-- | Create a 'FieldName' from a label
labledField :: T.Text -> FieldName
labledField s = FieldName (candidHash s) (Just s)

-- | Create a 'FieldName' from the raw hash
hashedField :: Word32 -> FieldName
hashedField h = FieldName h Nothing

-- | The Candid field label hashing algorithm
candidHash :: T.Text -> Word32
candidHash s = BS.foldl (\h c -> h * 223 + fromIntegral c) 0 $ BS.fromStrict $ T.encodeUtf8 s

-- | Inversion of the Candid field label hash
invertHash :: Word32 -> Maybe T.Text
invertHash w32 | w32 < 32 = Nothing
    -- leave small numbers alone, tend to be tuple indicies
invertHash w32 = listToMaybe guesses
  where
    x = fromIntegral w32 :: Word64
    chars = ['a'..'z'] ++ ['_']
    ords = 0 : map (fromIntegral . ord) chars
    non_mod x = x - (x `mod` 2^(32::Int))
    guesses =
        [ T.pack $ reverse guess
        | c8 <- ords, c7 <- ords, c6 <- ords, c5 <- ords
        -- It seems that 8 characters are enough to invert anything
        -- (based on quickchecking)
        -- Set up so that short guesses come first
        , let high_chars = c5 * 223^(4::Int) + c6 * 223^(5::Int) + c7 * 223^(6::Int) + c8 * 223^(7::Int)
        , let guess = simple $ x + non_mod high_chars
        , all (`elem` chars) guess
        ]

    -- inverts the Hash if the hash was created without modulos
    -- returns string in reverse order
    simple :: Word64 -> String
    simple 0 = ""
    simple x = chr (fromIntegral b) : simple a
      where (a, b) = x `divMod` 223


instance Eq FieldName where
    (==) = (==) `on` fieldHash
    (/=) = (/=) `on` fieldHash

instance Ord FieldName where
    compare = compare `on` fieldHash
    (<) = (<) `on` fieldHash
    (>) = (>) `on` fieldHash
    (<=) = (<=) `on` fieldHash
    (>=) = (>=) `on` fieldHash

instance IsString FieldName where
    fromString = labledField . fromString

instance Pretty FieldName where
    pretty (FieldName _ (Just x)) = pretty x
    pretty (FieldName h Nothing)
        | Just x <- invertHash h  = pretty x
        | otherwise               = pretty h


-- | The inverse of 'escapeFieldName'
unescapeFieldName :: T.Text -> FieldName
unescapeFieldName n
    | Just ('_',r') <- T.uncons n
    , Just (r,'_') <- T.unsnoc r'
    , Just (n' :: Natural) <- readMaybe (T.unpack r)
    , n' <= fromIntegral (maxBound :: Word32)
    = hashedField (fromIntegral n')
    | Just (n', '_') <- T.unsnoc n
    = labledField n'
    | otherwise
    = labledField n

-- | Represent a 'FieldName' (which may be numeric) in contexts where only text
-- is allowed, using the same encoding/decoding algorithm as Motoko.
--
-- This used in the 'Codec.Candid.Class.Candid' instance for 'Data.Row.Rec' and
-- 'Data.Row.Vec'
escapeFieldName :: FieldName -> T.Text
escapeFieldName (FieldName _ (Just "")) = ""
escapeFieldName (FieldName _ (Just n)) | T.last n == '_' = n <> "_"
escapeFieldName (FieldName _ (Just n)) = n
escapeFieldName (FieldName h Nothing) = T.singleton '_' <> T.pack (show h) <> T.singleton '_'