{-# 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
    { FieldName -> Word32
fieldHash :: Word32 -- ^ Extract the raw field hash value
    , FieldName -> Maybe Text
fieldName :: Maybe T.Text
    }
  deriving Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldName] -> ShowS
$cshowList :: [FieldName] -> ShowS
show :: FieldName -> String
$cshow :: FieldName -> String
showsPrec :: Int -> FieldName -> ShowS
$cshowsPrec :: Int -> FieldName -> ShowS
Show

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

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

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

-- | Inversion of the Candid field label hash
invertHash :: Word32 -> Maybe T.Text
invertHash :: Word32 -> Maybe Text
invertHash Word32
w32 | Word32
w32 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
32 = Maybe Text
forall a. Maybe a
Nothing
    -- leave small numbers alone, tend to be tuple indicies
invertHash Word32
w32 = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
guesses
  where
    x :: Word64
x = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32 :: Word64
    chars :: String
chars = [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'_']
    ords :: [Word64]
ords = Word64
0 Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: (Char -> Word64) -> String -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (Char -> Int) -> Char -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
chars
    non_mod :: a -> a
non_mod a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
- (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32::Int))
    guesses :: [Text]
guesses =
        [ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
guess
        | Word64
c8 <- [Word64]
ords, Word64
c7 <- [Word64]
ords, Word64
c6 <- [Word64]
ords, Word64
c5 <- [Word64]
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 :: Word64
high_chars = Word64
c5 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
4::Int) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c6 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
5::Int) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c7 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
7::Int)
        , let guess :: String
guess = Word64 -> String
simple (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$ Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Word64
forall a. Integral a => a -> a
non_mod Word64
high_chars
        , (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
chars) String
guess
        ]

    -- inverts the Hash if the hash was created without modulos
    -- returns string in reverse order
    simple :: Word64 -> String
    simple :: Word64 -> String
simple Word64
0 = String
""
    simple Word64
x = Int -> Char
chr (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b) Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> String
simple Word64
a
      where (Word64
a, Word64
b) = Word64
x Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
223


instance Eq FieldName where
    == :: FieldName -> FieldName -> Bool
(==) = Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
    /= :: FieldName -> FieldName -> Bool
(/=) = Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash

instance Ord FieldName where
    compare :: FieldName -> FieldName -> Ordering
compare = Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word32 -> Word32 -> Ordering)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
    < :: FieldName -> FieldName -> Bool
(<) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
    > :: FieldName -> FieldName -> Bool
(>) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(>) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
    <= :: FieldName -> FieldName -> Bool
(<=) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
    >= :: FieldName -> FieldName -> Bool
(>=) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash

instance IsString FieldName where
    fromString :: String -> FieldName
fromString = Text -> FieldName
labledField (Text -> FieldName) -> (String -> Text) -> String -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

instance Pretty FieldName where
    pretty :: FieldName -> Doc ann
pretty (FieldName Word32
_ (Just Text
x)) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
x
    pretty (FieldName Word32
h Maybe Text
Nothing)
        | Just Text
x <- Word32 -> Maybe Text
invertHash Word32
h  = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
x
        | Bool
otherwise               = Word32 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word32
h


-- | The inverse of 'escapeFieldName'
unescapeFieldName :: T.Text -> FieldName
unescapeFieldName :: Text -> FieldName
unescapeFieldName Text
n
    | Just (Char
'_',Text
r') <- Text -> Maybe (Char, Text)
T.uncons Text
n
    , Just (Text
r,Char
'_') <- Text -> Maybe (Text, Char)
T.unsnoc Text
r'
    , Just (Natural
n' :: Natural) <- String -> Maybe Natural
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
r)
    , Natural
n' Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
    = Word32 -> FieldName
hashedField (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n')
    | Just (Text
n', Char
'_') <- Text -> Maybe (Text, Char)
T.unsnoc Text
n
    = Text -> FieldName
labledField Text
n'
    | Bool
otherwise
    = Text -> FieldName
labledField Text
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 -> Text
escapeFieldName (FieldName Word32
_ (Just Text
"")) = Text
""
escapeFieldName (FieldName Word32
_ (Just Text
n)) | Text -> Char
T.last Text
n Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
escapeFieldName (FieldName Word32
_ (Just Text
n)) = Text
n
escapeFieldName (FieldName Word32
h Maybe Text
Nothing) = Char -> Text
T.singleton Char
'_' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
'_'