{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Network.Ethereum.Ens
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- ENS offers a secure & decentralised way to address resources both on
-- and off the blockchain using simple, human-readable names.
--
-- This module provide basic ENS resolvers.
--

module Network.Ethereum.Ens where

import           Crypto.Ethereum                     (keccak256)
import           Data.ByteArray                      (zero)
import           Data.ByteArray.Sized                (unsafeFromByteArrayAccess)
import           Data.ByteString                     (ByteString)
import           Data.ByteString.Char8               (split)
import           Lens.Micro                          ((.~))

import           Data.Solidity.Prim                  (Address, BytesN)
import           Network.Ethereum.Account.Class      (Account)
import           Network.Ethereum.Account.Internal   (AccountT, to, withParam)
import qualified Network.Ethereum.Ens.PublicResolver as Resolver
import qualified Network.Ethereum.Ens.Registry       as Reg
import           Network.JsonRpc.TinyClient          (JsonRpc)

-- | Namehash algorithm
-- http://docs.ens.domains/en/latest/implementers.html#algorithm
namehash :: ByteString
         -- ^ Domain name
         -> BytesN 32
         -- ^ Associated ENS node
namehash :: ByteString -> BytesN 32
namehash =
    ByteString -> BytesN 32
forall (n :: Nat) bin bout.
(ByteArrayAccess bin, ByteArrayN n bout, KnownNat n) =>
bin -> bout
unsafeFromByteArrayAccess (ByteString -> BytesN 32)
-> (ByteString -> ByteString) -> ByteString -> BytesN 32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString)
-> ByteString -> [ByteString] -> ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> ByteString -> ByteString
algo (Int -> ByteString
forall ba. ByteArray ba => Int -> ba
zero Int
32) ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
split Char
'.'
  where
    algo :: ByteString -> ByteString -> ByteString
    algo :: ByteString -> ByteString -> ByteString
algo ByteString
a ByteString
b = ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
keccak256 (ByteString
b ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
keccak256 ByteString
a)

-- | Get address of ENS domain
resolve :: (JsonRpc m, Account p (AccountT p))
        => ByteString
        -- ^ Domain name
        -> AccountT p m Address
        -- ^ Associated address
resolve :: ByteString -> AccountT p m Address
resolve ByteString
name = do
    Address
r <- AccountT p m Address -> AccountT p m Address
forall (m :: * -> *) a. AccountT p m a -> AccountT p m a
ensRegistry (AccountT p m Address -> AccountT p m Address)
-> AccountT p m Address -> AccountT p m Address
forall a b. (a -> b) -> a -> b
$ BytesN 32 -> AccountT p m Address
forall (m :: * -> *) a (t :: (* -> *) -> * -> *).
(JsonRpc m, Account a t, Functor (t m)) =>
BytesN 32 -> t m Address
Reg.resolver BytesN 32
node
    (CallParam p -> CallParam p)
-> AccountT p m Address -> AccountT p m Address
forall p (m :: * -> *) a.
Account p (AccountT p) =>
(CallParam p -> CallParam p) -> AccountT p m a -> AccountT p m a
withParam ((Address -> Identity Address)
-> CallParam p -> Identity (CallParam p)
forall p. Lens' (CallParam p) Address
to ((Address -> Identity Address)
 -> CallParam p -> Identity (CallParam p))
-> Address -> CallParam p -> CallParam p
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Address
r) (AccountT p m Address -> AccountT p m Address)
-> AccountT p m Address -> AccountT p m Address
forall a b. (a -> b) -> a -> b
$ BytesN 32 -> AccountT p m Address
forall (m :: * -> *) a (t :: (* -> *) -> * -> *).
(JsonRpc m, Account a t, Functor (t m)) =>
BytesN 32 -> t m Address
Resolver.addr BytesN 32
node
  where
    node :: BytesN 32
node = ByteString -> BytesN 32
namehash ByteString
name
    ensRegistry :: AccountT p m a -> AccountT p m a
ensRegistry = (CallParam p -> CallParam p) -> AccountT p m a -> AccountT p m a
forall p (m :: * -> *) a.
Account p (AccountT p) =>
(CallParam p -> CallParam p) -> AccountT p m a -> AccountT p m a
withParam ((CallParam p -> CallParam p) -> AccountT p m a -> AccountT p m a)
-> (CallParam p -> CallParam p) -> AccountT p m a -> AccountT p m a
forall a b. (a -> b) -> a -> b
$ (Address -> Identity Address)
-> CallParam p -> Identity (CallParam p)
forall p. Lens' (CallParam p) Address
to ((Address -> Identity Address)
 -> CallParam p -> Identity (CallParam p))
-> Address -> CallParam p -> CallParam p
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Address
"0x314159265dD8dbb310642f98f50C066173C1259b"