{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE DisambiguateRecordFields #-}

module Puppy.Context (
  -- * Effect
  ServerInfo,
  -- * Actions
  localActorId,
  localUrl,
  localId,
  serverActor,
  nodeName,
  -- * Handlers
  runServerInfo
) where

import Crypto.PubKey.RSA (PrivateKey (..))
import Data.Text (Text)
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.TH (makeEffect)
import Puppy.Config
import Puppy.Protocol.ActivityStreams (Id (..), Actor (..), PublicKey (..), Subtype (..), Inbox (..))

-- | Query information about the server.
data ServerInfo :: Effect where
  NodeName :: ServerInfo m Text
  ServerActor :: ServerInfo m Actor

makeEffect ''ServerInfo

-- | Create an `Id` for a local actor given only a name.
localActorId
  :: (ServerInfo :> es)
  => Text
  -> Eff es Id
localActorId actorName = localId ("/ap/a/" <> actorName)

localUrl :: (ServerInfo :> es) => Text -> Eff es Text
localUrl suffix = do
  us <- nodeName
  return ("https://" <> us <> suffix)

localId :: (ServerInfo :> es) => Text -> Eff es Id
localId = fmap Id . localUrl

runServerInfo :: (Config :> es) => Eff (ServerInfo : es) a -> Eff es a
runServerInfo = interpret $ \_ -> \case
  NodeName -> getsConfig name
  ServerActor -> do
    config <- getConfig
    let actorId = Id ("https://" <> config.name <> "/ap/a/server")
    return (Actor {
      id = actorId,
      accountName = "server",
      publicKey = PublicKey {
        id = Id (actorId.url <> "#key"),
        publicKeyPem = config.serverKey.private_pub,
        owner = actorId
      },
      inbox = Just (Inbox (actorId.url <> "/inbox")),
      outbox = Nothing,
      followers = Nothing,
      following = Nothing,
      displayName = Nothing,
      summary = Nothing,
      locked = True,
      subtype = Service
  })