-- SPDX-FileCopyrightText: 2023 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Container for address-to-alias and vice versa translation.
module Morley.Client.Types.AliasesAndAddresses
  ( AliasesAndAddresses
  , lookupAddr
  , lookupAlias
  , mkAliasesAndAddresses
  , insertAliasAndAddress
  , emptyAliasesAndAddresses
  ) where

import Data.Bimap (Bimap)
import Data.Bimap qualified as Bimap
import Data.Constraint ((\\))

import Morley.Client.Types
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Util.Constrained
import Morley.Util.Sing (castSing)

newtype AliasesAndAddresses = AliasesAndAddresses
  { AliasesAndAddresses -> Bimap SomeAlias Address
unAliasesAndAddresses :: Bimap SomeAlias Address }
  -- Invariant: address kind matches between address and alias.

lookupAlias :: KindedAddress kind -> AliasesAndAddresses -> Maybe (Alias kind)
lookupAlias :: forall (kind :: AddressKind).
KindedAddress kind -> AliasesAndAddresses -> Maybe (Alias kind)
lookupAlias KindedAddress kind
addr AliasesAndAddresses
as = do
  Constrained Alias a
alias <- Address -> Bimap SomeAlias Address -> Maybe SomeAlias
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR (KindedAddress kind -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
addr) (AliasesAndAddresses -> Bimap SomeAlias Address
unAliasesAndAddresses AliasesAndAddresses
as)
  Alias a -> Maybe (Alias kind)
forall {k} (a :: k) (b :: k) (t :: k -> *).
(SingI a, SingI b, SDecide k) =>
t a -> Maybe (t b)
castSing Alias a
alias ((L1AddressKind a, SingI a) => Maybe (Alias kind))
-> Dict (L1AddressKind a, SingI a) -> Maybe (Alias kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Alias a -> Dict (L1AddressKind a, SingI a)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias a
alias (SingI kind => Maybe (Alias kind))
-> Dict (SingI kind) -> Maybe (Alias kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress kind -> Dict (SingI kind)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress kind
addr

lookupAddr :: Alias kind -> AliasesAndAddresses -> Maybe (KindedAddress kind)
lookupAddr :: forall (kind :: AddressKind).
Alias kind -> AliasesAndAddresses -> Maybe (KindedAddress kind)
lookupAddr Alias kind
alias AliasesAndAddresses
as = do
  Constrained KindedAddress a
addr <- SomeAlias -> Bimap SomeAlias Address -> Maybe Address
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
Bimap.lookup (Alias kind -> SomeAlias
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained Alias kind
alias) (AliasesAndAddresses -> Bimap SomeAlias Address
unAliasesAndAddresses AliasesAndAddresses
as)
  KindedAddress a -> Maybe (KindedAddress kind)
forall {k} (a :: k) (b :: k) (t :: k -> *).
(SingI a, SingI b, SDecide k) =>
t a -> Maybe (t b)
castSing KindedAddress a
addr ((L1AddressKind kind, SingI kind) => Maybe (KindedAddress kind))
-> Dict (L1AddressKind kind, SingI kind)
-> Maybe (KindedAddress kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Alias kind -> Dict (L1AddressKind kind, SingI kind)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias kind
alias (SingI a => Maybe (KindedAddress kind))
-> Dict (SingI a) -> Maybe (KindedAddress kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress a -> Dict (SingI a)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress a
addr

mkAliasesAndAddresses :: [Constrained NullConstraint AddressWithAlias] -> AliasesAndAddresses
mkAliasesAndAddresses :: [Constrained NullConstraint AddressWithAlias]
-> AliasesAndAddresses
mkAliasesAndAddresses = Bimap SomeAlias Address -> AliasesAndAddresses
AliasesAndAddresses
  (Bimap SomeAlias Address -> AliasesAndAddresses)
-> ([Constrained NullConstraint AddressWithAlias]
    -> Bimap SomeAlias Address)
-> [Constrained NullConstraint AddressWithAlias]
-> AliasesAndAddresses
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SomeAlias, Address)] -> Bimap SomeAlias Address
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList
  ([(SomeAlias, Address)] -> Bimap SomeAlias Address)
-> ([Constrained NullConstraint AddressWithAlias]
    -> [(SomeAlias, Address)])
-> [Constrained NullConstraint AddressWithAlias]
-> Bimap SomeAlias Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constrained NullConstraint AddressWithAlias
 -> (SomeAlias, Address))
-> [Constrained NullConstraint AddressWithAlias]
-> [(SomeAlias, Address)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Constrained AddressWithAlias{KindedAddress a
Alias a
awaAlias :: forall (kind :: AddressKind). AddressWithAlias kind -> Alias kind
awaAddress :: forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAlias :: Alias a
awaAddress :: KindedAddress a
..}) -> (Alias a -> SomeAlias
forall (a :: AddressKind). Alias a -> SomeAlias
SomeAlias Alias a
awaAlias, KindedAddress a -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress a
awaAddress))

insertAliasAndAddress
  :: Alias kind
  -> KindedAddress kind
  -> AliasesAndAddresses
  -> AliasesAndAddresses
insertAliasAndAddress :: forall (kind :: AddressKind).
Alias kind
-> KindedAddress kind -> AliasesAndAddresses -> AliasesAndAddresses
insertAliasAndAddress Alias kind
alias KindedAddress kind
addr
  = Bimap SomeAlias Address -> AliasesAndAddresses
AliasesAndAddresses
  (Bimap SomeAlias Address -> AliasesAndAddresses)
-> (AliasesAndAddresses -> Bimap SomeAlias Address)
-> AliasesAndAddresses
-> AliasesAndAddresses
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeAlias
-> Address -> Bimap SomeAlias Address -> Bimap SomeAlias Address
forall a b. (Ord a, Ord b) => a -> b -> Bimap a b -> Bimap a b
Bimap.insert (Alias kind -> SomeAlias
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained Alias kind
alias) (KindedAddress kind -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
addr)
  (Bimap SomeAlias Address -> Bimap SomeAlias Address)
-> (AliasesAndAddresses -> Bimap SomeAlias Address)
-> AliasesAndAddresses
-> Bimap SomeAlias Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AliasesAndAddresses -> Bimap SomeAlias Address
unAliasesAndAddresses

emptyAliasesAndAddresses :: AliasesAndAddresses
emptyAliasesAndAddresses :: AliasesAndAddresses
emptyAliasesAndAddresses = Bimap SomeAlias Address -> AliasesAndAddresses
AliasesAndAddresses Bimap SomeAlias Address
forall a b. Bimap a b
Bimap.empty