{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors      #-}
{-# LANGUAGE StrictData            #-}

-- | An incomplete-but-good-enough implementation of the ActivityStreams vocabulary.
--
-- This module contains only what is needed for the ActivityPub implementation (which
-- is also technically incomplete).
module Puppy.Protocol.ActivityStreams (
  Activity (..),
  Actor (..),
  Document (..),
  Id (..),
  Inbox (..),
  Object,
  PublicKey (..),
  Subtype (..),
  IsObject (..),
  idToInbox,
  inboxToId,
  object,
  subtype,
) where

import Data.Aeson (FromJSON, ToJSON (..), (.=))
import Data.Functor ((<&>), ($>))
import Data.Maybe (fromMaybe)
import Data.String (IsString)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import Puppy.Crypto.RSA (encodePublicKey)
import qualified Crypto.PubKey.RSA as RSA
import qualified Data.Aeson.Types as JSON
import qualified Data.Text.Encoding as T
import qualified Data.Vector as Vec
import Unsafe.Coerce (unsafeCoerce)


newtype Id = Id { url :: Text }
  deriving newtype (Eq, IsString, ToJSON, FromJSON)

newtype Inbox = Inbox { url :: Text }
  deriving newtype (Eq, IsString, ToJSON, FromJSON)

inboxToId :: Inbox -> Id
inboxToId = Id . (.url)

idToInbox :: Id -> Inbox
idToInbox = Inbox . (.url)


data Activity o
  = Activity {
    id      :: Id,
    actor   :: Id,
    object  :: o,
    to      :: [Inbox],
    cc      :: [Inbox],
    time    :: Maybe UTCTime,
    subtype :: Subtype (Activity o)
  }

instance Functor Activity where
  fmap f x = x { object = f x.object, subtype = unsafeCoerce x.subtype }

data Document
  = Document {
    id      :: Id,
    content :: Maybe Text,
    summary :: Maybe Text,
    subtype :: Subtype Document
  }

data Actor
  = Actor {
    id          :: Id,
    inbox       :: Maybe Inbox,
    outbox      :: Maybe Id,
    followers   :: Maybe Id,
    following   :: Maybe Id,
    accountName :: Text,
    displayName :: Maybe Text,
    summary     :: Maybe Text,
    publicKey   :: PublicKey,
    locked      :: Bool,
    subtype     :: Subtype Actor
  }

data PublicKey
  = PublicKey {
    id           :: Id,
    owner        :: Id,
    publicKeyPem :: RSA.PublicKey
  }

data Object
  = ActivityO (Activity Object)
  | DocumentO Document
  | ActorO    Actor

class IsObject x where 
  toObject   :: x -> Object
  fromObject :: Object -> Maybe x

instance (IsObject o) => IsObject (Activity o) where
  toObject x = ActivityO (x <&> toObject)
  fromObject = \case 
    (ActivityO x) -> (fromObject x.object) <&> (x $>)
    _ -> Nothing

instance IsObject Actor where
  toObject = ActorO
  fromObject = \case
    ActorO o -> Just o
    _ -> Nothing

instance IsObject Document where
  toObject = DocumentO
  fromObject = \case
    DocumentO o -> Just o
    _ -> Nothing

instance IsObject Object where
  toObject = id
  fromObject = pure

-- * Subtyping

class Subtyped a where
  data Subtype a
  subtype :: a -> Subtype a

instance forall o. Subtyped (Activity o) where
  subtype = (.subtype)
  data Subtype (Activity o)
    = Follow
    | Accept
    | Reject
    | Create
    | Delete
    | Announce
    | Like
    | Undo
    deriving (Show, Generic, FromJSON, ToJSON)

instance Subtyped Document where
  subtype = (.subtype)
  data Subtype Document
    = Article
    | Audio
    | Video
    | Image
    | Note
    deriving (Show, Generic, FromJSON, ToJSON)

instance Subtyped Actor where
  subtype = (.subtype)
  data Subtype Actor
    = Person
    | Service
    | Application
    | Organization
    | Group
    deriving (Show, Generic, FromJSON, ToJSON)

instance Subtyped Object where
  subtype = \case
    ActivityO o -> ActivityT o.subtype
    DocumentO o -> DocumentT o.subtype
    ActorO o    -> ActorT o.subtype
  data Subtype Object
    = ActivityT (Subtype (Activity Object))
    | DocumentT (Subtype Document)
    | ActorT (Subtype Actor)
    deriving (Show)

instance HasField "id" Object Id where 
  getField = object (.id) (.id) (.id)

instance (ToJSON o) => ToJSON (Activity o) where
  toJSON o = JSON.object (filterNull [
      "@context"  .= context,
      "id"        .= o.id,
      "to"        .= o.to,
      "cc"        .= o.cc,
      "actor"     .= o.actor,
      "object"    .= o.object,
      "published" .= o.time,
      "type"      .= o.subtype
    ])

instance ToJSON Document where
  toJSON o = JSON.object (filterNull [
      "@context"  .= context,
      "id"      .= o.id,
      "summary" .= o.summary,
      "content" .= o.content,
      "type"    .= o.subtype
    ])

instance ToJSON Actor where
  toJSON o = JSON.object (filterNull [
      "@context"  .= context,
      "id"        .= o.id,
      "inbox"     .= o.inbox,
      "outbox"    .= o.outbox,
      "followers" .= o.followers,
      "following" .= o.following,
      "publicKey" .= o.publicKey,
      "name"      .= fromMaybe o.accountName o.displayName,
      "summary"   .= o.summary,
      "type"      .= o.subtype,
      "preferredUsername"
        .= o.accountName,
      "manuallyApprovesFollowers"
        .= o.locked
    ])

instance ToJSON PublicKey where
  toJSON o = JSON.object [
      "id"           .= o.id,
      "publicKeyPem" .= T.decodeUtf8 (encodePublicKey o.publicKeyPem),
      "owner"        .= o.owner
    ]

instance ToJSON Object where
  toJSON = object toJSON toJSON toJSON

filterNull :: [JSON.Pair] -> [JSON.Pair]
filterNull = filter isNotNull
  where
    isNotNull (_, JSON.Null) = False
    isNotNull _ = True

-- | Case analysis on an `Object`.
object :: (Activity Object -> a) -> (Document -> a) -> (Actor -> a) -> Object -> a
object activity document actor = \case
  ActivityO x -> activity x
  DocumentO x -> document x
  ActorO x -> actor x

context :: JSON.Value
context = JSON.Array (Vec.fromList [
    JSON.String "https://www.w3.org/ns/activitystreams"
  ])