module U.Util.Base32Hex
  ( Base32Hex (UnsafeFromText),
    fromByteString,
    toByteString,
    fromText,
    toText,
    validChars,
  )
where

import Data.ByteString.Base32.Hex qualified as Base32.Hex
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Unison.Prelude

newtype Base32Hex = UnsafeFromText Text
  deriving (Base32Hex -> Base32Hex -> Bool
(Base32Hex -> Base32Hex -> Bool)
-> (Base32Hex -> Base32Hex -> Bool) -> Eq Base32Hex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base32Hex -> Base32Hex -> Bool
== :: Base32Hex -> Base32Hex -> Bool
$c/= :: Base32Hex -> Base32Hex -> Bool
/= :: Base32Hex -> Base32Hex -> Bool
Eq, Eq Base32Hex
Eq Base32Hex =>
(Base32Hex -> Base32Hex -> Ordering)
-> (Base32Hex -> Base32Hex -> Bool)
-> (Base32Hex -> Base32Hex -> Bool)
-> (Base32Hex -> Base32Hex -> Bool)
-> (Base32Hex -> Base32Hex -> Bool)
-> (Base32Hex -> Base32Hex -> Base32Hex)
-> (Base32Hex -> Base32Hex -> Base32Hex)
-> Ord Base32Hex
Base32Hex -> Base32Hex -> Bool
Base32Hex -> Base32Hex -> Ordering
Base32Hex -> Base32Hex -> Base32Hex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Base32Hex -> Base32Hex -> Ordering
compare :: Base32Hex -> Base32Hex -> Ordering
$c< :: Base32Hex -> Base32Hex -> Bool
< :: Base32Hex -> Base32Hex -> Bool
$c<= :: Base32Hex -> Base32Hex -> Bool
<= :: Base32Hex -> Base32Hex -> Bool
$c> :: Base32Hex -> Base32Hex -> Bool
> :: Base32Hex -> Base32Hex -> Bool
$c>= :: Base32Hex -> Base32Hex -> Bool
>= :: Base32Hex -> Base32Hex -> Bool
$cmax :: Base32Hex -> Base32Hex -> Base32Hex
max :: Base32Hex -> Base32Hex -> Base32Hex
$cmin :: Base32Hex -> Base32Hex -> Base32Hex
min :: Base32Hex -> Base32Hex -> Base32Hex
Ord, Int -> Base32Hex -> ShowS
[Base32Hex] -> ShowS
Base32Hex -> [Char]
(Int -> Base32Hex -> ShowS)
-> (Base32Hex -> [Char])
-> ([Base32Hex] -> ShowS)
-> Show Base32Hex
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base32Hex -> ShowS
showsPrec :: Int -> Base32Hex -> ShowS
$cshow :: Base32Hex -> [Char]
show :: Base32Hex -> [Char]
$cshowList :: [Base32Hex] -> ShowS
showList :: [Base32Hex] -> ShowS
Show)

toText :: Base32Hex -> Text
toText :: Base32Hex -> Text
toText (UnsafeFromText Text
s) = Text
s

-- | Return the lowercase unpadded base32Hex encoding of this 'ByteString'.
-- Multibase prefix would be 'v', see https://github.com/multiformats/multibase
fromByteString :: ByteString -> Base32Hex
fromByteString :: ByteString -> Base32Hex
fromByteString =
  Text -> Base32Hex
UnsafeFromText (Text -> Base32Hex)
-> (ByteString -> Text) -> ByteString -> Base32Hex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Base32.Hex.encodeBase32Unpadded

-- | Produce a 'Hash' from a base32hex-encoded version of its binary representation
toByteString :: Base32Hex -> ByteString
toByteString :: Base32Hex -> ByteString
toByteString (UnsafeFromText Text
s) =
  case ByteString -> Either Text ByteString
Base32.Hex.decodeBase32Unpadded (Text -> ByteString
Text.encodeUtf8 Text
s) of
    Left Text
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char]
"not base32: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
s)
    Right ByteString
h -> ByteString
h

fromText :: Text -> Maybe Base32Hex
fromText :: Text -> Maybe Base32Hex
fromText Text
s =
  if ByteString -> Bool
Base32.Hex.isBase32Hex (ByteString -> Bool) -> (Text -> ByteString) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toUpper (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text
s
    then Base32Hex -> Maybe Base32Hex
forall a. a -> Maybe a
Just (Text -> Base32Hex
UnsafeFromText Text
s)
    else Maybe Base32Hex
forall a. Maybe a
Nothing

validChars :: Set Char
validChars :: Set Char
validChars = [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList ([Char] -> Set Char) -> [Char] -> Set Char
forall a b. (a -> b) -> a -> b
$ [Char
'0' .. Char
'9'] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'v']