{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}

-- | A few extra data types
module Codec.Candid.Data where

import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Row.Internal as R
import Data.Digest.CRC32
import Data.ByteString.Base32
import Data.List
import Data.List.Split (chunksOf)
import Data.Bifunctor
import Control.Monad
import Data.Kind

data Reserved = Reserved
 deriving (Reserved -> Reserved -> Bool
(Reserved -> Reserved -> Bool)
-> (Reserved -> Reserved -> Bool) -> Eq Reserved
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reserved -> Reserved -> Bool
$c/= :: Reserved -> Reserved -> Bool
== :: Reserved -> Reserved -> Bool
$c== :: Reserved -> Reserved -> Bool
Eq, Eq Reserved
Eq Reserved
-> (Reserved -> Reserved -> Ordering)
-> (Reserved -> Reserved -> Bool)
-> (Reserved -> Reserved -> Bool)
-> (Reserved -> Reserved -> Bool)
-> (Reserved -> Reserved -> Bool)
-> (Reserved -> Reserved -> Reserved)
-> (Reserved -> Reserved -> Reserved)
-> Ord Reserved
Reserved -> Reserved -> Bool
Reserved -> Reserved -> Ordering
Reserved -> Reserved -> Reserved
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
min :: Reserved -> Reserved -> Reserved
$cmin :: Reserved -> Reserved -> Reserved
max :: Reserved -> Reserved -> Reserved
$cmax :: Reserved -> Reserved -> Reserved
>= :: Reserved -> Reserved -> Bool
$c>= :: Reserved -> Reserved -> Bool
> :: Reserved -> Reserved -> Bool
$c> :: Reserved -> Reserved -> Bool
<= :: Reserved -> Reserved -> Bool
$c<= :: Reserved -> Reserved -> Bool
< :: Reserved -> Reserved -> Bool
$c< :: Reserved -> Reserved -> Bool
compare :: Reserved -> Reserved -> Ordering
$ccompare :: Reserved -> Reserved -> Ordering
$cp1Ord :: Eq Reserved
Ord, Int -> Reserved -> ShowS
[Reserved] -> ShowS
Reserved -> String
(Int -> Reserved -> ShowS)
-> (Reserved -> String) -> ([Reserved] -> ShowS) -> Show Reserved
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reserved] -> ShowS
$cshowList :: [Reserved] -> ShowS
show :: Reserved -> String
$cshow :: Reserved -> String
showsPrec :: Int -> Reserved -> ShowS
$cshowsPrec :: Int -> Reserved -> ShowS
Show)

newtype Principal = Principal { Principal -> ByteString
rawPrincipal :: BS.ByteString }
 deriving (Principal -> Principal -> Bool
(Principal -> Principal -> Bool)
-> (Principal -> Principal -> Bool) -> Eq Principal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Principal -> Principal -> Bool
$c/= :: Principal -> Principal -> Bool
== :: Principal -> Principal -> Bool
$c== :: Principal -> Principal -> Bool
Eq, Eq Principal
Eq Principal
-> (Principal -> Principal -> Ordering)
-> (Principal -> Principal -> Bool)
-> (Principal -> Principal -> Bool)
-> (Principal -> Principal -> Bool)
-> (Principal -> Principal -> Bool)
-> (Principal -> Principal -> Principal)
-> (Principal -> Principal -> Principal)
-> Ord Principal
Principal -> Principal -> Bool
Principal -> Principal -> Ordering
Principal -> Principal -> Principal
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
min :: Principal -> Principal -> Principal
$cmin :: Principal -> Principal -> Principal
max :: Principal -> Principal -> Principal
$cmax :: Principal -> Principal -> Principal
>= :: Principal -> Principal -> Bool
$c>= :: Principal -> Principal -> Bool
> :: Principal -> Principal -> Bool
$c> :: Principal -> Principal -> Bool
<= :: Principal -> Principal -> Bool
$c<= :: Principal -> Principal -> Bool
< :: Principal -> Principal -> Bool
$c< :: Principal -> Principal -> Bool
compare :: Principal -> Principal -> Ordering
$ccompare :: Principal -> Principal -> Ordering
$cp1Ord :: Eq Principal
Ord, Int -> Principal -> ShowS
[Principal] -> ShowS
Principal -> String
(Int -> Principal -> ShowS)
-> (Principal -> String)
-> ([Principal] -> ShowS)
-> Show Principal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Principal] -> ShowS
$cshowList :: [Principal] -> ShowS
show :: Principal -> String
$cshow :: Principal -> String
showsPrec :: Int -> Principal -> ShowS
$cshowsPrec :: Int -> Principal -> ShowS
Show)

prettyPrincipal :: Principal -> T.Text
prettyPrincipal :: Principal -> Text
prettyPrincipal (Principal ByteString
blob) =
    String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall e. Int -> [e] -> [[e]]
chunksOf Int
5 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
base32 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
checkbytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
blob
  where
    checksum :: Word32
checksum = ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 (ByteString -> ByteString
BS.toStrict ByteString
blob)
    checkbytes :: ByteString
checkbytes = Builder -> ByteString
BS.toLazyByteString (Word32 -> Builder
BS.word32BE Word32
checksum)
    base32 :: ByteString -> String
base32 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'=') ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase32 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict

parsePrincipal :: T.Text -> Either String Principal
parsePrincipal :: Text -> Either String Principal
parsePrincipal Text
s = do
    ByteString
all_bytes <- (Text -> String)
-> (ByteString -> ByteString)
-> Either Text ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> String
T.unpack ByteString -> ByteString
BS.fromStrict (Either Text ByteString -> Either String ByteString)
-> Either Text ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either Text ByteString
decodeBase32Unpadded (Text -> ByteString
T.encodeUtf8 ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') Text
s))
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int64
BS.length ByteString
all_bytes Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
4) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
        String -> Either String ()
forall a b. a -> Either a b
Left String
"Too short id"
    let p :: Principal
p = ByteString -> Principal
Principal (Int64 -> ByteString -> ByteString
BS.drop Int64
4 ByteString
all_bytes)
    let expected :: Text
expected = Principal -> Text
prettyPrincipal Principal
p
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expected) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
        String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"Principal id " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" malformed; did you mean " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?"
    Principal -> Either String Principal
forall (m :: * -> *) a. Monad m => a -> m a
return Principal
p

newtype ServiceRef (r :: R.Row Type) = ServiceRef { ServiceRef r -> Principal
rawServiceRef :: Principal }
 deriving (ServiceRef r -> ServiceRef r -> Bool
(ServiceRef r -> ServiceRef r -> Bool)
-> (ServiceRef r -> ServiceRef r -> Bool) -> Eq (ServiceRef r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
/= :: ServiceRef r -> ServiceRef r -> Bool
$c/= :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
== :: ServiceRef r -> ServiceRef r -> Bool
$c== :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
Eq, Eq (ServiceRef r)
Eq (ServiceRef r)
-> (ServiceRef r -> ServiceRef r -> Ordering)
-> (ServiceRef r -> ServiceRef r -> Bool)
-> (ServiceRef r -> ServiceRef r -> Bool)
-> (ServiceRef r -> ServiceRef r -> Bool)
-> (ServiceRef r -> ServiceRef r -> Bool)
-> (ServiceRef r -> ServiceRef r -> ServiceRef r)
-> (ServiceRef r -> ServiceRef r -> ServiceRef r)
-> Ord (ServiceRef r)
ServiceRef r -> ServiceRef r -> Bool
ServiceRef r -> ServiceRef r -> Ordering
ServiceRef r -> ServiceRef r -> ServiceRef r
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
forall (r :: Row *). Eq (ServiceRef r)
forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
forall (r :: Row *). ServiceRef r -> ServiceRef r -> Ordering
forall (r :: Row *). ServiceRef r -> ServiceRef r -> ServiceRef r
min :: ServiceRef r -> ServiceRef r -> ServiceRef r
$cmin :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> ServiceRef r
max :: ServiceRef r -> ServiceRef r -> ServiceRef r
$cmax :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> ServiceRef r
>= :: ServiceRef r -> ServiceRef r -> Bool
$c>= :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
> :: ServiceRef r -> ServiceRef r -> Bool
$c> :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
<= :: ServiceRef r -> ServiceRef r -> Bool
$c<= :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
< :: ServiceRef r -> ServiceRef r -> Bool
$c< :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> Bool
compare :: ServiceRef r -> ServiceRef r -> Ordering
$ccompare :: forall (r :: Row *). ServiceRef r -> ServiceRef r -> Ordering
$cp1Ord :: forall (r :: Row *). Eq (ServiceRef r)
Ord, Int -> ServiceRef r -> ShowS
[ServiceRef r] -> ShowS
ServiceRef r -> String
(Int -> ServiceRef r -> ShowS)
-> (ServiceRef r -> String)
-> ([ServiceRef r] -> ShowS)
-> Show (ServiceRef r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (r :: Row *). Int -> ServiceRef r -> ShowS
forall (r :: Row *). [ServiceRef r] -> ShowS
forall (r :: Row *). ServiceRef r -> String
showList :: [ServiceRef r] -> ShowS
$cshowList :: forall (r :: Row *). [ServiceRef r] -> ShowS
show :: ServiceRef r -> String
$cshow :: forall (r :: Row *). ServiceRef r -> String
showsPrec :: Int -> ServiceRef r -> ShowS
$cshowsPrec :: forall (r :: Row *). Int -> ServiceRef r -> ShowS
Show)

data FuncRef (r :: Type) = FuncRef { FuncRef r -> Principal
service :: Principal, FuncRef r -> Text
method :: T.Text }
 deriving (FuncRef r -> FuncRef r -> Bool
(FuncRef r -> FuncRef r -> Bool)
-> (FuncRef r -> FuncRef r -> Bool) -> Eq (FuncRef r)
forall r. FuncRef r -> FuncRef r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuncRef r -> FuncRef r -> Bool
$c/= :: forall r. FuncRef r -> FuncRef r -> Bool
== :: FuncRef r -> FuncRef r -> Bool
$c== :: forall r. FuncRef r -> FuncRef r -> Bool
Eq, Eq (FuncRef r)
Eq (FuncRef r)
-> (FuncRef r -> FuncRef r -> Ordering)
-> (FuncRef r -> FuncRef r -> Bool)
-> (FuncRef r -> FuncRef r -> Bool)
-> (FuncRef r -> FuncRef r -> Bool)
-> (FuncRef r -> FuncRef r -> Bool)
-> (FuncRef r -> FuncRef r -> FuncRef r)
-> (FuncRef r -> FuncRef r -> FuncRef r)
-> Ord (FuncRef r)
FuncRef r -> FuncRef r -> Bool
FuncRef r -> FuncRef r -> Ordering
FuncRef r -> FuncRef r -> FuncRef r
forall r. Eq (FuncRef r)
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
forall r. FuncRef r -> FuncRef r -> Bool
forall r. FuncRef r -> FuncRef r -> Ordering
forall r. FuncRef r -> FuncRef r -> FuncRef r
min :: FuncRef r -> FuncRef r -> FuncRef r
$cmin :: forall r. FuncRef r -> FuncRef r -> FuncRef r
max :: FuncRef r -> FuncRef r -> FuncRef r
$cmax :: forall r. FuncRef r -> FuncRef r -> FuncRef r
>= :: FuncRef r -> FuncRef r -> Bool
$c>= :: forall r. FuncRef r -> FuncRef r -> Bool
> :: FuncRef r -> FuncRef r -> Bool
$c> :: forall r. FuncRef r -> FuncRef r -> Bool
<= :: FuncRef r -> FuncRef r -> Bool
$c<= :: forall r. FuncRef r -> FuncRef r -> Bool
< :: FuncRef r -> FuncRef r -> Bool
$c< :: forall r. FuncRef r -> FuncRef r -> Bool
compare :: FuncRef r -> FuncRef r -> Ordering
$ccompare :: forall r. FuncRef r -> FuncRef r -> Ordering
$cp1Ord :: forall r. Eq (FuncRef r)
Ord, Int -> FuncRef r -> ShowS
[FuncRef r] -> ShowS
FuncRef r -> String
(Int -> FuncRef r -> ShowS)
-> (FuncRef r -> String)
-> ([FuncRef r] -> ShowS)
-> Show (FuncRef r)
forall r. Int -> FuncRef r -> ShowS
forall r. [FuncRef r] -> ShowS
forall r. FuncRef r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuncRef r] -> ShowS
$cshowList :: forall r. [FuncRef r] -> ShowS
show :: FuncRef r -> String
$cshow :: forall r. FuncRef r -> String
showsPrec :: Int -> FuncRef r -> ShowS
$cshowsPrec :: forall r. Int -> FuncRef r -> ShowS
Show)