{-# 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.CRC
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
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
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
Ord, Int -> Reserved -> ShowS
[Reserved] -> ShowS
Reserved -> String
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
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
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
Ord, Int -> Principal -> ShowS
[Principal] -> ShowS
Principal -> String
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 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"-" forall a b. (a -> b) -> a -> b
$ forall e. Int -> [e] -> [[e]]
chunksOf Int
5 forall a b. (a -> b) -> a -> b
$ ByteString -> String
base32 forall a b. (a -> b) -> a -> b
$ ByteString
checkbytes forall a. Semigroup a => a -> a -> a
<> ByteString
blob
  where
    CRC32 Word32
checksum = forall a. CRC a => ByteString -> a
digest (ByteString -> ByteString
BS.toStrict ByteString
blob)
    checkbytes :: ByteString
checkbytes = Builder -> ByteString
BS.toLazyByteString (Word32 -> Builder
BS.word32BE Word32
checksum)
    base32 :: ByteString -> String
base32 = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'=') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase32 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 <- 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 forall a b. (a -> b) -> a -> b
$
        ByteString -> Either Text ByteString
decodeBase32Unpadded (Text -> ByteString
T.encodeUtf8 ((Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'-') Text
s))
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int64
BS.length ByteString
all_bytes forall a. Ord a => a -> a -> Bool
>= Int64
4) forall a b. (a -> b) -> a -> b
$
        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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
s forall a. Eq a => a -> a -> Bool
== Text
expected) forall a b. (a -> b) -> a -> b
$
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Principal id " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
s forall a. [a] -> [a] -> [a]
++ String
" malformed; did you mean " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
expected forall a. [a] -> [a] -> [a]
++ String
"?"
    forall (m :: * -> *) a. Monad m => a -> m a
return Principal
p

newtype ServiceRef (r :: R.Row Type) = ServiceRef { forall (r :: Row (*)). ServiceRef r -> Principal
rawServiceRef :: Principal }
 deriving (ServiceRef r -> ServiceRef r -> Bool
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, 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
Ord, Int -> ServiceRef r -> ShowS
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 = FuncRef { forall r. FuncRef r -> Principal
service :: Principal, forall r. FuncRef r -> Text
method :: T.Text }
 deriving (FuncRef r -> FuncRef r -> Bool
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, FuncRef r -> FuncRef r -> Bool
FuncRef r -> FuncRef r -> Ordering
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
Ord, Int -> FuncRef r -> ShowS
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)