{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Ouroboros.Consensus.Mock.Ledger.Address (
    Addr
  , AddrDist
  , mkAddrDist
  ) where

import           Cardano.Binary (FromCBOR (..), ToCBOR (..))
import           Codec.Serialise (Serialise)
import           Control.DeepSeq (NFData)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.String
import           Data.Text (pack, unpack)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.NodeId (NodeId (..))
import           Ouroboros.Consensus.Util.Condense

-- | Mock address
newtype Addr = Addr String
  deriving (
      Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> String
(Int -> Addr -> ShowS)
-> (Addr -> String) -> ([Addr] -> ShowS) -> Show Addr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Addr -> ShowS
showsPrec :: Int -> Addr -> ShowS
$cshow :: Addr -> String
show :: Addr -> String
$cshowList :: [Addr] -> ShowS
showList :: [Addr] -> ShowS
Show
    , Addr -> Addr -> Bool
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
/= :: Addr -> Addr -> Bool
Eq
    , Eq Addr
Eq Addr =>
(Addr -> Addr -> Ordering)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> Ord Addr
Addr -> Addr -> Bool
Addr -> Addr -> Ordering
Addr -> Addr -> Addr
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 :: Addr -> Addr -> Ordering
compare :: Addr -> Addr -> Ordering
$c< :: Addr -> Addr -> Bool
< :: Addr -> Addr -> Bool
$c<= :: Addr -> Addr -> Bool
<= :: Addr -> Addr -> Bool
$c> :: Addr -> Addr -> Bool
> :: Addr -> Addr -> Bool
$c>= :: Addr -> Addr -> Bool
>= :: Addr -> Addr -> Bool
$cmax :: Addr -> Addr -> Addr
max :: Addr -> Addr -> Addr
$cmin :: Addr -> Addr -> Addr
min :: Addr -> Addr -> Addr
Ord
    , String -> Addr
(String -> Addr) -> IsString Addr
forall a. (String -> a) -> IsString a
$cfromString :: String -> Addr
fromString :: String -> Addr
IsString
    , [Addr] -> Encoding
Addr -> Encoding
(Addr -> Encoding)
-> (forall s. Decoder s Addr)
-> ([Addr] -> Encoding)
-> (forall s. Decoder s [Addr])
-> Serialise Addr
forall s. Decoder s [Addr]
forall s. Decoder s Addr
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Addr -> Encoding
encode :: Addr -> Encoding
$cdecode :: forall s. Decoder s Addr
decode :: forall s. Decoder s Addr
$cencodeList :: [Addr] -> Encoding
encodeList :: [Addr] -> Encoding
$cdecodeList :: forall s. Decoder s [Addr]
decodeList :: forall s. Decoder s [Addr]
Serialise
    , Addr -> ()
(Addr -> ()) -> NFData Addr
forall a. (a -> ()) -> NFData a
$crnf :: Addr -> ()
rnf :: Addr -> ()
NFData
    , [String] -> Addr -> IO (Maybe ThunkInfo)
Proxy Addr -> String
([String] -> Addr -> IO (Maybe ThunkInfo))
-> ([String] -> Addr -> IO (Maybe ThunkInfo))
-> (Proxy Addr -> String)
-> NoThunks Addr
forall a.
([String] -> a -> IO (Maybe ThunkInfo))
-> ([String] -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: [String] -> Addr -> IO (Maybe ThunkInfo)
noThunks :: [String] -> Addr -> IO (Maybe ThunkInfo)
$cwNoThunks :: [String] -> Addr -> IO (Maybe ThunkInfo)
wNoThunks :: [String] -> Addr -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Addr -> String
showTypeOf :: Proxy Addr -> String
NoThunks
    )

instance ToCBOR Addr where
  toCBOR :: Addr -> Encoding
toCBOR (Addr String
a) = Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text -> Encoding) -> Text -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
a

instance FromCBOR Addr where
  fromCBOR :: forall s. Decoder s Addr
fromCBOR = String -> Addr
Addr (String -> Addr) -> (Text -> String) -> Text -> Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Addr) -> Decoder s Text -> Decoder s Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Condense Addr where
  condense :: Addr -> String
condense (Addr String
addr) = String
addr

-- | Mapping from addresses to node IDs
--
-- This is needed in order to assign stake to nodes.
type AddrDist = Map Addr NodeId

-- | Construct address to node ID mapping
mkAddrDist :: NumCoreNodes -> AddrDist
mkAddrDist :: NumCoreNodes -> AddrDist
mkAddrDist NumCoreNodes
numCoreNodes =
    [(Addr, NodeId)] -> AddrDist
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Addr, NodeId)] -> AddrDist) -> [(Addr, NodeId)] -> AddrDist
forall a b. (a -> b) -> a -> b
$ [Addr] -> [NodeId] -> [(Addr, NodeId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ String -> Addr
forall a. IsString a => String -> a
fromString [Char
addr] | Char
addr <- [Char
'a'..] ]
                       [ CoreNodeId -> NodeId
CoreId CoreNodeId
nid
                       | CoreNodeId
nid <- NumCoreNodes -> [CoreNodeId]
enumCoreNodes NumCoreNodes
numCoreNodes
                       ]