Point.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}

module Urbit.Azimuth.Point (
    Point(..)
  , Details(..)
  , Rights(..)

  , Keys(..)
  , CryptKey(..)
  , AuthKey(..)
  , CryptoSuite(..)
  , keyInformation

  , Life(..)
  , Rift(..)

  , Address

  , isOwner
  , isLive
  , isSponsor
  , isRequestingEscapeTo
  , isSpawnProxy
  , isTransferProxy
  , isManagementProxy
  , isVotingProxy

  , hasBeenLinked
  , canManageNetworkKeys
  , canSponsor
  , canManage
  , canSpawn
  , canVote
  , canTransfer
  ) where

import qualified Data.ByteArray.Sized as DBS
import Data.Solidity.Prim.Address (Address)
import qualified Data.Solidity.Prim as Solidity.Prim (UIntN, BytesN)
import GHC.Generics (Generic)
import Prelude
import Urbit.Ob (Patp)
import qualified Urbit.Ob as Ob

-- | An Azimuth point, represented by its \@p, 'Details', and 'Rights'.
data Point = Point {
    pointPatp    :: Patp
  , pointDetails :: Details
  , pointRights  :: Rights
  }
  deriving stock (Show, Eq, Generic)

-- | Various information about a 'Point'.
data Details = Details {
    detailsCryptKey          :: CryptKey
  , detailsAuthKey           :: AuthKey
  , detailsHasSponsor        :: Bool
  , detailsActive            :: Bool
  , detailsEscapeRequested   :: Bool
  , detailsSponsor           :: Patp
  , detailsEscapeRequestedTo :: Patp
  , detailsCryptoSuite       :: CryptoSuite
  , detailsLife              :: Life
  , detailsRift              :: Rift
  }
  deriving stock (Show, Eq, Generic)

-- | Ownership and proxy information for a 'Point'.
data Rights = Rights {
    rightsOwner           :: Address
  , rightsManagementProxy :: Maybe Address
  , rightsSpawnProxy      :: Maybe Address
  , rightsVotingProxy     :: Maybe Address
  , rightsTransferProxy   :: Maybe Address
  }
  deriving stock (Show, Eq, Generic)

-- | Grab a point's key information.
keyInformation :: Point -> Keys
keyInformation Point {..} = Keys {
      keyCrypt       = detailsCryptKey
    , keyAuth        = detailsAuthKey
    , keyCryptoSuite = detailsCryptoSuite
    }
  where
    Details {..} = pointDetails
-- | A point's public encryption key.
newtype CryptKey = CryptKey {
    fromCryptKey :: Solidity.Prim.BytesN 32
  }
  deriving stock (Show, Eq)
  deriving newtype (Semigroup, Monoid)

-- | A point's public authentication key.
newtype AuthKey = AuthKey {
    fromAuthKey :: Solidity.Prim.BytesN 32
  }
  deriving stock (Show, Eq)
  deriving newtype (Semigroup, Monoid)

-- | A point's crypto suite version.
newtype CryptoSuite = CryptoSuite {
    fromCryptoSuite :: Solidity.Prim.UIntN 32
  }
  deriving stock (Show, Eq, Ord)
  deriving newtype (Num, Real, Enum, Bounded, Integral)

-- | A point's life (i.e., recorded number of key revisions).
newtype Life = Life {
    fromLife :: Solidity.Prim.UIntN 32
  }
  deriving stock (Show, Eq, Ord)
  deriving newtype (Num, Real, Enum, Bounded, Integral)

-- | A point's rift (i.e., recorded number of continuity breaches).
newtype Rift = Rift {
    fromRift :: Solidity.Prim.UIntN 32
  }
  deriving stock (Show, Eq, Ord)
  deriving newtype (Num, Real, Enum, Bounded, Integral)

-- | Public key information for a 'Point'.
data Keys = Keys {
    keyCrypt       :: CryptKey
  , keyAuth        :: AuthKey
  , keyCryptoSuite :: CryptoSuite
  } deriving stock (Show, Eq)

-- | Check if an address is the owner of a point.
isOwner :: Point -> Address -> Bool
isOwner Point {..} addr = rightsOwner pointRights == addr

-- | Check if a point has been booted.
hasBeenLinked :: Point -> Bool
hasBeenLinked = (> 0) . detailsLife . pointDetails

-- | Check if a point is live.
isLive :: Point -> Bool
isLive Point {..} =
       fromCryptKey detailsCryptKey /= DBS.zero
    && fromAuthKey detailsAuthKey /= DBS.zero
    && fromCryptoSuite detailsCryptoSuite /= 0
  where
    Details {..} = pointDetails

-- | Check if a point is the sponsor of another.
isSponsor :: Point -> Patp -> Bool
isSponsor Point {..} point =
    detailsHasSponsor && detailsSponsor == point
  where
    Details {..} = pointDetails

-- | Check if a point is requesting escape to another point.
isRequestingEscapeTo :: Point -> Patp -> Bool
isRequestingEscapeTo Point {..} patp =
    detailsEscapeRequested && detailsEscapeRequestedTo == patp
  where
    Details {..} = pointDetails

-- | Check if an address is a spawn proxy for a point.
isSpawnProxy :: Point -> Address -> Bool
isSpawnProxy Point {..} addr = case rightsSpawnProxy pointRights of
  Just a  -> a == addr
  Nothing -> False

-- | Check if an address is a transfer proxy for a point.
isTransferProxy :: Point -> Address -> Bool
isTransferProxy Point {..} addr = case rightsTransferProxy pointRights of
  Just a  -> a == addr
  Nothing -> False

-- | Check if an address is a management proxy for a point.
isManagementProxy :: Point -> Address -> Bool
isManagementProxy Point {..} addr = case rightsManagementProxy pointRights of
  Just a  -> a == addr
  Nothing -> False

-- | Check if an address is a voting proxy for a point.
isVotingProxy :: Point -> Address -> Bool
isVotingProxy Point {..} addr = case rightsVotingProxy pointRights of
  Just a  -> a == addr
  Nothing -> False

-- | Check if an address can manage a point's networking keys.
canManageNetworkKeys :: Point -> Address -> Bool
canManageNetworkKeys point addr =
     canManage point addr
  && hasBeenLinked point

-- | Check if a point can sponsor another.
canSponsor :: Point -> Bool
canSponsor Point {..} = case Ob.clan pointPatp of
  Ob.Galaxy -> True
  Ob.Star   -> True
  _         -> False

-- | Check if an address can manage a point.
canManage :: Point -> Address -> Bool
canManage point addr =
     isOwner point addr
  || isManagementProxy point addr

-- | Check if an address can spawn for a point.
canSpawn :: Point -> Address -> Bool
canSpawn point addr =
     canSponsor point
  && hasBeenLinked point
  && (isOwner point addr || isSpawnProxy point addr)

-- | Check if an address can vote for a point.
canVote :: Point -> Address -> Bool
canVote point@Point {..} addr =
       Ob.Galaxy == Ob.clan pointPatp
    && detailsActive
    && (isOwner point addr || isVotingProxy point addr)
  where
    Details {..} = pointDetails

-- | Check if an address can transfer ownership of a point.
canTransfer :: Point -> Address -> Bool
canTransfer point addr =
     isOwner point addr
  || isTransferProxy point addr