{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedLists            #-}
{-# LANGUAGE OverloadedStrings          #-}
module Auth.Biscuit.Symbols
  ( Symbols
  , BlockSymbols
  , ReverseSymbols
  , SymbolRef (..)
  , PublicKeyRef (..)
  , getSymbol
  , getPublicKey'
  , addSymbols
  , addFromBlock
  , registerNewSymbols
  , registerNewPublicKeys
  , reverseSymbols
  , getSymbolList
  , getPkList
  , getPkTable
  , getSymbolCode
  , getPublicKeyCode
  , newSymbolTable
  ) where

import           Auth.Biscuit.Crypto (PublicKey)
import           Data.Int            (Int64)
import           Data.List           ((\\))
import           Data.Map            (Map, elems, (!?))
import qualified Data.Map            as Map
import           Data.Set            (Set, difference, union)
import qualified Data.Set            as Set
import           Data.Text           (Text)

import           Auth.Biscuit.Utils  (maybeToRight)

newtype SymbolRef = SymbolRef { SymbolRef -> Int64
getSymbolRef :: Int64 }
  deriving stock (SymbolRef -> SymbolRef -> Bool
(SymbolRef -> SymbolRef -> Bool)
-> (SymbolRef -> SymbolRef -> Bool) -> Eq SymbolRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SymbolRef -> SymbolRef -> Bool
== :: SymbolRef -> SymbolRef -> Bool
$c/= :: SymbolRef -> SymbolRef -> Bool
/= :: SymbolRef -> SymbolRef -> Bool
Eq, Eq SymbolRef
Eq SymbolRef =>
(SymbolRef -> SymbolRef -> Ordering)
-> (SymbolRef -> SymbolRef -> Bool)
-> (SymbolRef -> SymbolRef -> Bool)
-> (SymbolRef -> SymbolRef -> Bool)
-> (SymbolRef -> SymbolRef -> Bool)
-> (SymbolRef -> SymbolRef -> SymbolRef)
-> (SymbolRef -> SymbolRef -> SymbolRef)
-> Ord SymbolRef
SymbolRef -> SymbolRef -> Bool
SymbolRef -> SymbolRef -> Ordering
SymbolRef -> SymbolRef -> SymbolRef
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 :: SymbolRef -> SymbolRef -> Ordering
compare :: SymbolRef -> SymbolRef -> Ordering
$c< :: SymbolRef -> SymbolRef -> Bool
< :: SymbolRef -> SymbolRef -> Bool
$c<= :: SymbolRef -> SymbolRef -> Bool
<= :: SymbolRef -> SymbolRef -> Bool
$c> :: SymbolRef -> SymbolRef -> Bool
> :: SymbolRef -> SymbolRef -> Bool
$c>= :: SymbolRef -> SymbolRef -> Bool
>= :: SymbolRef -> SymbolRef -> Bool
$cmax :: SymbolRef -> SymbolRef -> SymbolRef
max :: SymbolRef -> SymbolRef -> SymbolRef
$cmin :: SymbolRef -> SymbolRef -> SymbolRef
min :: SymbolRef -> SymbolRef -> SymbolRef
Ord)
  deriving newtype (Int -> SymbolRef
SymbolRef -> Int
SymbolRef -> [SymbolRef]
SymbolRef -> SymbolRef
SymbolRef -> SymbolRef -> [SymbolRef]
SymbolRef -> SymbolRef -> SymbolRef -> [SymbolRef]
(SymbolRef -> SymbolRef)
-> (SymbolRef -> SymbolRef)
-> (Int -> SymbolRef)
-> (SymbolRef -> Int)
-> (SymbolRef -> [SymbolRef])
-> (SymbolRef -> SymbolRef -> [SymbolRef])
-> (SymbolRef -> SymbolRef -> [SymbolRef])
-> (SymbolRef -> SymbolRef -> SymbolRef -> [SymbolRef])
-> Enum SymbolRef
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SymbolRef -> SymbolRef
succ :: SymbolRef -> SymbolRef
$cpred :: SymbolRef -> SymbolRef
pred :: SymbolRef -> SymbolRef
$ctoEnum :: Int -> SymbolRef
toEnum :: Int -> SymbolRef
$cfromEnum :: SymbolRef -> Int
fromEnum :: SymbolRef -> Int
$cenumFrom :: SymbolRef -> [SymbolRef]
enumFrom :: SymbolRef -> [SymbolRef]
$cenumFromThen :: SymbolRef -> SymbolRef -> [SymbolRef]
enumFromThen :: SymbolRef -> SymbolRef -> [SymbolRef]
$cenumFromTo :: SymbolRef -> SymbolRef -> [SymbolRef]
enumFromTo :: SymbolRef -> SymbolRef -> [SymbolRef]
$cenumFromThenTo :: SymbolRef -> SymbolRef -> SymbolRef -> [SymbolRef]
enumFromThenTo :: SymbolRef -> SymbolRef -> SymbolRef -> [SymbolRef]
Enum)

instance Show SymbolRef where
  show :: SymbolRef -> String
show = (String
"#" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (SymbolRef -> String) -> SymbolRef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> (SymbolRef -> Int64) -> SymbolRef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolRef -> Int64
getSymbolRef

newtype PublicKeyRef = PublicKeyRef { PublicKeyRef -> Int64
getPublicKeyRef :: Int64 }
  deriving stock (PublicKeyRef -> PublicKeyRef -> Bool
(PublicKeyRef -> PublicKeyRef -> Bool)
-> (PublicKeyRef -> PublicKeyRef -> Bool) -> Eq PublicKeyRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKeyRef -> PublicKeyRef -> Bool
== :: PublicKeyRef -> PublicKeyRef -> Bool
$c/= :: PublicKeyRef -> PublicKeyRef -> Bool
/= :: PublicKeyRef -> PublicKeyRef -> Bool
Eq, Eq PublicKeyRef
Eq PublicKeyRef =>
(PublicKeyRef -> PublicKeyRef -> Ordering)
-> (PublicKeyRef -> PublicKeyRef -> Bool)
-> (PublicKeyRef -> PublicKeyRef -> Bool)
-> (PublicKeyRef -> PublicKeyRef -> Bool)
-> (PublicKeyRef -> PublicKeyRef -> Bool)
-> (PublicKeyRef -> PublicKeyRef -> PublicKeyRef)
-> (PublicKeyRef -> PublicKeyRef -> PublicKeyRef)
-> Ord PublicKeyRef
PublicKeyRef -> PublicKeyRef -> Bool
PublicKeyRef -> PublicKeyRef -> Ordering
PublicKeyRef -> PublicKeyRef -> PublicKeyRef
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 :: PublicKeyRef -> PublicKeyRef -> Ordering
compare :: PublicKeyRef -> PublicKeyRef -> Ordering
$c< :: PublicKeyRef -> PublicKeyRef -> Bool
< :: PublicKeyRef -> PublicKeyRef -> Bool
$c<= :: PublicKeyRef -> PublicKeyRef -> Bool
<= :: PublicKeyRef -> PublicKeyRef -> Bool
$c> :: PublicKeyRef -> PublicKeyRef -> Bool
> :: PublicKeyRef -> PublicKeyRef -> Bool
$c>= :: PublicKeyRef -> PublicKeyRef -> Bool
>= :: PublicKeyRef -> PublicKeyRef -> Bool
$cmax :: PublicKeyRef -> PublicKeyRef -> PublicKeyRef
max :: PublicKeyRef -> PublicKeyRef -> PublicKeyRef
$cmin :: PublicKeyRef -> PublicKeyRef -> PublicKeyRef
min :: PublicKeyRef -> PublicKeyRef -> PublicKeyRef
Ord)
  deriving newtype (Int -> PublicKeyRef
PublicKeyRef -> Int
PublicKeyRef -> [PublicKeyRef]
PublicKeyRef -> PublicKeyRef
PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
PublicKeyRef -> PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
(PublicKeyRef -> PublicKeyRef)
-> (PublicKeyRef -> PublicKeyRef)
-> (Int -> PublicKeyRef)
-> (PublicKeyRef -> Int)
-> (PublicKeyRef -> [PublicKeyRef])
-> (PublicKeyRef -> PublicKeyRef -> [PublicKeyRef])
-> (PublicKeyRef -> PublicKeyRef -> [PublicKeyRef])
-> (PublicKeyRef -> PublicKeyRef -> PublicKeyRef -> [PublicKeyRef])
-> Enum PublicKeyRef
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PublicKeyRef -> PublicKeyRef
succ :: PublicKeyRef -> PublicKeyRef
$cpred :: PublicKeyRef -> PublicKeyRef
pred :: PublicKeyRef -> PublicKeyRef
$ctoEnum :: Int -> PublicKeyRef
toEnum :: Int -> PublicKeyRef
$cfromEnum :: PublicKeyRef -> Int
fromEnum :: PublicKeyRef -> Int
$cenumFrom :: PublicKeyRef -> [PublicKeyRef]
enumFrom :: PublicKeyRef -> [PublicKeyRef]
$cenumFromThen :: PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
enumFromThen :: PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
$cenumFromTo :: PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
enumFromTo :: PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
$cenumFromThenTo :: PublicKeyRef -> PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
enumFromThenTo :: PublicKeyRef -> PublicKeyRef -> PublicKeyRef -> [PublicKeyRef]
Enum)

instance Show PublicKeyRef where
  show :: PublicKeyRef -> String
show = (String
"#" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (PublicKeyRef -> String) -> PublicKeyRef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String)
-> (PublicKeyRef -> Int64) -> PublicKeyRef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKeyRef -> Int64
getPublicKeyRef

data Symbols = Symbols
  { Symbols -> Map SymbolRef Text
symbols    :: Map SymbolRef Text
  , Symbols -> Map PublicKeyRef PublicKey
publicKeys :: Map PublicKeyRef PublicKey
  } deriving stock (Symbols -> Symbols -> Bool
(Symbols -> Symbols -> Bool)
-> (Symbols -> Symbols -> Bool) -> Eq Symbols
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Symbols -> Symbols -> Bool
== :: Symbols -> Symbols -> Bool
$c/= :: Symbols -> Symbols -> Bool
/= :: Symbols -> Symbols -> Bool
Eq, Int -> Symbols -> ShowS
[Symbols] -> ShowS
Symbols -> String
(Int -> Symbols -> ShowS)
-> (Symbols -> String) -> ([Symbols] -> ShowS) -> Show Symbols
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Symbols -> ShowS
showsPrec :: Int -> Symbols -> ShowS
$cshow :: Symbols -> String
show :: Symbols -> String
$cshowList :: [Symbols] -> ShowS
showList :: [Symbols] -> ShowS
Show)

data BlockSymbols = BlockSymbols
  { BlockSymbols -> Map SymbolRef Text
blockSymbols    :: Map SymbolRef Text
  , BlockSymbols -> Map PublicKeyRef PublicKey
blockPublicKeys :: Map PublicKeyRef PublicKey
  } deriving stock (BlockSymbols -> BlockSymbols -> Bool
(BlockSymbols -> BlockSymbols -> Bool)
-> (BlockSymbols -> BlockSymbols -> Bool) -> Eq BlockSymbols
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockSymbols -> BlockSymbols -> Bool
== :: BlockSymbols -> BlockSymbols -> Bool
$c/= :: BlockSymbols -> BlockSymbols -> Bool
/= :: BlockSymbols -> BlockSymbols -> Bool
Eq, Int -> BlockSymbols -> ShowS
[BlockSymbols] -> ShowS
BlockSymbols -> String
(Int -> BlockSymbols -> ShowS)
-> (BlockSymbols -> String)
-> ([BlockSymbols] -> ShowS)
-> Show BlockSymbols
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockSymbols -> ShowS
showsPrec :: Int -> BlockSymbols -> ShowS
$cshow :: BlockSymbols -> String
show :: BlockSymbols -> String
$cshowList :: [BlockSymbols] -> ShowS
showList :: [BlockSymbols] -> ShowS
Show)

instance Semigroup BlockSymbols where
  BlockSymbols
b <> :: BlockSymbols -> BlockSymbols -> BlockSymbols
<> BlockSymbols
b' = BlockSymbols
              { blockSymbols :: Map SymbolRef Text
blockSymbols = BlockSymbols -> Map SymbolRef Text
blockSymbols BlockSymbols
b Map SymbolRef Text -> Map SymbolRef Text -> Map SymbolRef Text
forall a. Semigroup a => a -> a -> a
<> BlockSymbols -> Map SymbolRef Text
blockSymbols BlockSymbols
b'
              , blockPublicKeys :: Map PublicKeyRef PublicKey
blockPublicKeys = BlockSymbols -> Map PublicKeyRef PublicKey
blockPublicKeys BlockSymbols
b Map PublicKeyRef PublicKey
-> Map PublicKeyRef PublicKey -> Map PublicKeyRef PublicKey
forall a. Semigroup a => a -> a -> a
<> BlockSymbols -> Map PublicKeyRef PublicKey
blockPublicKeys BlockSymbols
b'
              }

data ReverseSymbols = ReverseSymbols
  { ReverseSymbols -> Map Text SymbolRef
reverseSymbolMap    :: Map Text SymbolRef
  , ReverseSymbols -> Map PublicKey PublicKeyRef
reversePublicKeyMap :: Map PublicKey PublicKeyRef
  }
  deriving stock (ReverseSymbols -> ReverseSymbols -> Bool
(ReverseSymbols -> ReverseSymbols -> Bool)
-> (ReverseSymbols -> ReverseSymbols -> Bool) -> Eq ReverseSymbols
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReverseSymbols -> ReverseSymbols -> Bool
== :: ReverseSymbols -> ReverseSymbols -> Bool
$c/= :: ReverseSymbols -> ReverseSymbols -> Bool
/= :: ReverseSymbols -> ReverseSymbols -> Bool
Eq, Int -> ReverseSymbols -> ShowS
[ReverseSymbols] -> ShowS
ReverseSymbols -> String
(Int -> ReverseSymbols -> ShowS)
-> (ReverseSymbols -> String)
-> ([ReverseSymbols] -> ShowS)
-> Show ReverseSymbols
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReverseSymbols -> ShowS
showsPrec :: Int -> ReverseSymbols -> ShowS
$cshow :: ReverseSymbols -> String
show :: ReverseSymbols -> String
$cshowList :: [ReverseSymbols] -> ShowS
showList :: [ReverseSymbols] -> ShowS
Show)

instance Semigroup ReverseSymbols where
  ReverseSymbols
b <> :: ReverseSymbols -> ReverseSymbols -> ReverseSymbols
<> ReverseSymbols
b' = ReverseSymbols
              { reverseSymbolMap :: Map Text SymbolRef
reverseSymbolMap = ReverseSymbols -> Map Text SymbolRef
reverseSymbolMap ReverseSymbols
b Map Text SymbolRef -> Map Text SymbolRef -> Map Text SymbolRef
forall a. Semigroup a => a -> a -> a
<> ReverseSymbols -> Map Text SymbolRef
reverseSymbolMap ReverseSymbols
b'
              , reversePublicKeyMap :: Map PublicKey PublicKeyRef
reversePublicKeyMap = ReverseSymbols -> Map PublicKey PublicKeyRef
reversePublicKeyMap ReverseSymbols
b Map PublicKey PublicKeyRef
-> Map PublicKey PublicKeyRef -> Map PublicKey PublicKeyRef
forall a. Semigroup a => a -> a -> a
<> ReverseSymbols -> Map PublicKey PublicKeyRef
reversePublicKeyMap ReverseSymbols
b'
              }

getNextOffset :: Symbols -> SymbolRef
getNextOffset :: Symbols -> SymbolRef
getNextOffset (Symbols Map SymbolRef Text
m Map PublicKeyRef PublicKey
_) =
  Int64 -> SymbolRef
SymbolRef (Int64 -> SymbolRef) -> Int64 -> SymbolRef
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Map SymbolRef Text -> Int
forall k a. Map k a -> Int
Map.size Map SymbolRef Text
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Map SymbolRef Text -> Int
forall k a. Map k a -> Int
Map.size Map SymbolRef Text
commonSymbols)

getNextPublicKeyOffset :: Symbols -> PublicKeyRef
getNextPublicKeyOffset :: Symbols -> PublicKeyRef
getNextPublicKeyOffset (Symbols Map SymbolRef Text
_ Map PublicKeyRef PublicKey
m) =
  Int64 -> PublicKeyRef
PublicKeyRef (Int64 -> PublicKeyRef) -> Int64 -> PublicKeyRef
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Map PublicKeyRef PublicKey -> Int
forall k a. Map k a -> Int
Map.size Map PublicKeyRef PublicKey
m

getSymbol :: Symbols -> SymbolRef -> Either String Text
getSymbol :: Symbols -> SymbolRef -> Either String Text
getSymbol (Symbols Map SymbolRef Text
m Map PublicKeyRef PublicKey
_) SymbolRef
i =
  String -> Maybe Text -> Either String Text
forall b a. b -> Maybe a -> Either b a
maybeToRight (String
"Missing symbol at id " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SymbolRef -> String
forall a. Show a => a -> String
show SymbolRef
i) (Maybe Text -> Either String Text)
-> Maybe Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Map SymbolRef Text
m Map SymbolRef Text -> SymbolRef -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? SymbolRef
i

getPublicKey' :: Symbols -> PublicKeyRef -> Either String PublicKey
getPublicKey' :: Symbols -> PublicKeyRef -> Either String PublicKey
getPublicKey' (Symbols Map SymbolRef Text
_ Map PublicKeyRef PublicKey
m) PublicKeyRef
i =
  String -> Maybe PublicKey -> Either String PublicKey
forall b a. b -> Maybe a -> Either b a
maybeToRight (String
"Missing symbol at id " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKeyRef -> String
forall a. Show a => a -> String
show PublicKeyRef
i) (Maybe PublicKey -> Either String PublicKey)
-> Maybe PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ Map PublicKeyRef PublicKey
m Map PublicKeyRef PublicKey -> PublicKeyRef -> Maybe PublicKey
forall k a. Ord k => Map k a -> k -> Maybe a
!? PublicKeyRef
i

-- | Given already existing symbols and a set of symbols used in a block,
-- compute the symbol table carried by this specific block
addSymbols :: Symbols -> Set Text -> Set PublicKey -> BlockSymbols
addSymbols :: Symbols -> Set Text -> Set PublicKey -> BlockSymbols
addSymbols s :: Symbols
s@(Symbols Map SymbolRef Text
sm Map PublicKeyRef PublicKey
pkm) Set Text
bSymbols Set PublicKey
pks =
  let existingSymbols :: Set Text
existingSymbols = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList (Map SymbolRef Text -> [Text]
forall k a. Map k a -> [a]
elems Map SymbolRef Text
commonSymbols) Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`union` [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList (Map SymbolRef Text -> [Text]
forall k a. Map k a -> [a]
elems Map SymbolRef Text
sm)
      newSymbols :: [Text]
newSymbols = Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Text
bSymbols Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`difference` Set Text
existingSymbols
      starting :: SymbolRef
starting = Symbols -> SymbolRef
getNextOffset Symbols
s
      existingPks :: Set PublicKey
existingPks = [PublicKey] -> Set PublicKey
forall a. Ord a => [a] -> Set a
Set.fromList (Map PublicKeyRef PublicKey -> [PublicKey]
forall k a. Map k a -> [a]
elems Map PublicKeyRef PublicKey
pkm)
      newPks :: [PublicKey]
newPks = Set PublicKey -> [PublicKey]
forall a. Set a -> [a]
Set.toList (Set PublicKey -> [PublicKey]) -> Set PublicKey -> [PublicKey]
forall a b. (a -> b) -> a -> b
$ Set PublicKey
pks Set PublicKey -> Set PublicKey -> Set PublicKey
forall a. Ord a => Set a -> Set a -> Set a
`difference` Set PublicKey
existingPks
      startingPk :: PublicKeyRef
startingPk = Symbols -> PublicKeyRef
getNextPublicKeyOffset Symbols
s
   in BlockSymbols
        { blockSymbols :: Map SymbolRef Text
blockSymbols = [(SymbolRef, Text)] -> Map SymbolRef Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([SymbolRef] -> [Text] -> [(SymbolRef, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Item [SymbolRef]
SymbolRef
starting..] [Text]
newSymbols)
        , blockPublicKeys :: Map PublicKeyRef PublicKey
blockPublicKeys = [(PublicKeyRef, PublicKey)] -> Map PublicKeyRef PublicKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([PublicKeyRef] -> [PublicKey] -> [(PublicKeyRef, PublicKey)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Item [PublicKeyRef]
PublicKeyRef
startingPk..] [PublicKey]
newPks)
        }

getSymbolList :: BlockSymbols -> [Text]
getSymbolList :: BlockSymbols -> [Text]
getSymbolList (BlockSymbols Map SymbolRef Text
m Map PublicKeyRef PublicKey
_) = Map SymbolRef Text -> [Text]
forall k a. Map k a -> [a]
Map.elems Map SymbolRef Text
m

getPkList :: BlockSymbols -> [PublicKey]
getPkList :: BlockSymbols -> [PublicKey]
getPkList (BlockSymbols Map SymbolRef Text
_ Map PublicKeyRef PublicKey
m) = Map PublicKeyRef PublicKey -> [PublicKey]
forall k a. Map k a -> [a]
Map.elems Map PublicKeyRef PublicKey
m

getPkTable :: Symbols -> [PublicKey]
getPkTable :: Symbols -> [PublicKey]
getPkTable (Symbols Map SymbolRef Text
_ Map PublicKeyRef PublicKey
m) = Map PublicKeyRef PublicKey -> [PublicKey]
forall k a. Map k a -> [a]
Map.elems Map PublicKeyRef PublicKey
m

newSymbolTable :: Symbols
newSymbolTable :: Symbols
newSymbolTable = Map SymbolRef Text -> Map PublicKeyRef PublicKey -> Symbols
Symbols Map SymbolRef Text
commonSymbols Map PublicKeyRef PublicKey
forall k a. Map k a
Map.empty

-- | Given the symbol table of a protobuf block, update the provided symbol table
addFromBlock :: Symbols -> BlockSymbols -> Symbols
addFromBlock :: Symbols -> BlockSymbols -> Symbols
addFromBlock (Symbols Map SymbolRef Text
sm Map PublicKeyRef PublicKey
pkm) (BlockSymbols Map SymbolRef Text
bsm Map PublicKeyRef PublicKey
bpkm) =
   Symbols
     { symbols :: Map SymbolRef Text
symbols = Map SymbolRef Text
sm Map SymbolRef Text -> Map SymbolRef Text -> Map SymbolRef Text
forall a. Semigroup a => a -> a -> a
<> Map SymbolRef Text
bsm
     , publicKeys :: Map PublicKeyRef PublicKey
publicKeys = Map PublicKeyRef PublicKey
pkm Map PublicKeyRef PublicKey
-> Map PublicKeyRef PublicKey -> Map PublicKeyRef PublicKey
forall a. Semigroup a => a -> a -> a
<> Map PublicKeyRef PublicKey
bpkm
     }

registerNewSymbols :: [Text] -> Symbols -> Symbols
registerNewSymbols :: [Text] -> Symbols -> Symbols
registerNewSymbols [Text]
newSymbols s :: Symbols
s@Symbols{Map SymbolRef Text
symbols :: Symbols -> Map SymbolRef Text
symbols :: Map SymbolRef Text
symbols} =
  let newSymbolsMap :: Map SymbolRef Text
newSymbolsMap = [(SymbolRef, Text)] -> Map SymbolRef Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SymbolRef, Text)] -> Map SymbolRef Text)
-> [(SymbolRef, Text)] -> Map SymbolRef Text
forall a b. (a -> b) -> a -> b
$ [SymbolRef] -> [Text] -> [(SymbolRef, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbols -> SymbolRef
getNextOffset Symbols
s..] [Text]
newSymbols
   in Symbols
s { symbols = symbols <> newSymbolsMap }

registerNewPublicKeys :: [PublicKey] -> Symbols -> Symbols
registerNewPublicKeys :: [PublicKey] -> Symbols -> Symbols
registerNewPublicKeys [PublicKey]
newPks s :: Symbols
s@Symbols{Map PublicKeyRef PublicKey
publicKeys :: Symbols -> Map PublicKeyRef PublicKey
publicKeys :: Map PublicKeyRef PublicKey
publicKeys} =
  let newPkMap :: Map PublicKeyRef PublicKey
newPkMap = [(PublicKeyRef, PublicKey)] -> Map PublicKeyRef PublicKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PublicKeyRef, PublicKey)] -> Map PublicKeyRef PublicKey)
-> [(PublicKeyRef, PublicKey)] -> Map PublicKeyRef PublicKey
forall a b. (a -> b) -> a -> b
$ [PublicKeyRef] -> [PublicKey] -> [(PublicKeyRef, PublicKey)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbols -> PublicKeyRef
getNextPublicKeyOffset Symbols
s..] ([PublicKey]
newPks [PublicKey] -> [PublicKey] -> [PublicKey]
forall a. Eq a => [a] -> [a] -> [a]
\\ Map PublicKeyRef PublicKey -> [PublicKey]
forall k a. Map k a -> [a]
elems Map PublicKeyRef PublicKey
publicKeys)
   in Symbols
s { publicKeys = publicKeys <> newPkMap }

-- | Reverse a symbol table
reverseSymbols :: Symbols -> ReverseSymbols
reverseSymbols :: Symbols -> ReverseSymbols
reverseSymbols (Symbols Map SymbolRef Text
sm Map PublicKeyRef PublicKey
pkm) =
  let swap :: (b, a) -> (a, b)
swap (b
a,a
b) = (a
b,b
a)
      reverseMap :: (Ord a, Ord b) => Map a b -> Map b a
      reverseMap :: forall a b. (Ord a, Ord b) => Map a b -> Map b a
reverseMap = [(b, a)] -> Map b a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(b, a)] -> Map b a)
-> (Map a b -> [(b, a)]) -> Map a b -> Map b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (b, a)) -> [(a, b)] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> (b, a)
forall {b} {a}. (b, a) -> (a, b)
swap ([(a, b)] -> [(b, a)])
-> (Map a b -> [(a, b)]) -> Map a b -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList
   in ReverseSymbols
       { reverseSymbolMap :: Map Text SymbolRef
reverseSymbolMap = Map SymbolRef Text -> Map Text SymbolRef
forall a b. (Ord a, Ord b) => Map a b -> Map b a
reverseMap Map SymbolRef Text
sm
       , reversePublicKeyMap :: Map PublicKey PublicKeyRef
reversePublicKeyMap = Map PublicKeyRef PublicKey -> Map PublicKey PublicKeyRef
forall a b. (Ord a, Ord b) => Map a b -> Map b a
reverseMap Map PublicKeyRef PublicKey
pkm
       }

-- | Given a reverse symbol table (symbol refs indexed by their textual
-- representation), turn textual representations into symbol refs.
-- This function is partial, the reverse table is guaranteed to
-- contain the expected textual symbols.
getSymbolCode :: ReverseSymbols -> Text -> SymbolRef
getSymbolCode :: ReverseSymbols -> Text -> SymbolRef
getSymbolCode (ReverseSymbols Map Text SymbolRef
rm Map PublicKey PublicKeyRef
_) Text
t = Map Text SymbolRef
rm Map Text SymbolRef -> Text -> SymbolRef
forall k a. Ord k => Map k a -> k -> a
Map.! Text
t

getPublicKeyCode :: ReverseSymbols -> PublicKey -> Int64
getPublicKeyCode :: ReverseSymbols -> PublicKey -> Int64
getPublicKeyCode (ReverseSymbols Map Text SymbolRef
_ Map PublicKey PublicKeyRef
rm) PublicKey
t = PublicKeyRef -> Int64
getPublicKeyRef (PublicKeyRef -> Int64) -> PublicKeyRef -> Int64
forall a b. (a -> b) -> a -> b
$ Map PublicKey PublicKeyRef
rm Map PublicKey PublicKeyRef -> PublicKey -> PublicKeyRef
forall k a. Ord k => Map k a -> k -> a
Map.! PublicKey
t

-- | The common symbols defined in the biscuit spec
commonSymbols :: Map SymbolRef Text
commonSymbols :: Map SymbolRef Text
commonSymbols = [(SymbolRef, Text)] -> Map SymbolRef Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SymbolRef, Text)] -> Map SymbolRef Text)
-> [(SymbolRef, Text)] -> Map SymbolRef Text
forall a b. (a -> b) -> a -> b
$ [SymbolRef] -> [Text] -> [(SymbolRef, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int64 -> SymbolRef
SymbolRef Int64
0..]
  [ Item [Text]
Text
"read"
  , Item [Text]
Text
"write"
  , Item [Text]
Text
"resource"
  , Item [Text]
Text
"operation"
  , Item [Text]
Text
"right"
  , Item [Text]
Text
"time"
  , Item [Text]
Text
"role"
  , Item [Text]
Text
"owner"
  , Item [Text]
Text
"tenant"
  , Item [Text]
Text
"namespace"
  , Item [Text]
Text
"user"
  , Item [Text]
Text
"team"
  , Item [Text]
Text
"service"
  , Item [Text]
Text
"admin"
  , Item [Text]
Text
"email"
  , Item [Text]
Text
"group"
  , Item [Text]
Text
"member"
  , Item [Text]
Text
"ip_address"
  , Item [Text]
Text
"client"
  , Item [Text]
Text
"client_ip"
  , Item [Text]
Text
"domain"
  , Item [Text]
Text
"path"
  , Item [Text]
Text
"version"
  , Item [Text]
Text
"cluster"
  , Item [Text]
Text
"node"
  , Item [Text]
Text
"hostname"
  , Item [Text]
Text
"nonce"
  , Item [Text]
Text
"query"
  ]