{-# LANGUAGE RecordWildCards #-}

module Fedi.Types where

import Control.Monad (guard)
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Text qualified as T
import Fedi.UserDetails
import Prelude hiding (id, last)

-- | An Object is what everything is here.
-- <https://www.w3.org/TR/activitystreams-vocabulary/#object-types>
data Object typ
  = Object
  { id :: Maybe ObjectId
  , otype :: typ
  , content :: Maybe Content
  , published :: Maybe UTCTime
  , replies :: Maybe [Link]
  , attachment :: Maybe [AnyMedia]
  , attributedTo :: Maybe (LinkOrObject Actor)
  , -- , audience :: Maybe String
    tag :: Maybe [Tag]
  , to :: Maybe [Link]
  , cc :: Maybe [Link]
  , inReplyTo :: Maybe (LinkOrObject Actor)
  , url :: Maybe Url -- revisit
  , name :: Maybe Name
  , icon :: Maybe Image
  , image :: Maybe Image
  , preview :: Maybe Preview
  , summary :: Maybe T.Text
  , updated :: Maybe UTCTime
  , -- , bto :: Maybe String
    -- , bcc :: Maybe String
    mediaType :: Maybe MediaType
    -- , duration  :: Maybe String
  }
  deriving (Show, Eq)

class ToObject a where
  toObject :: a -> [A.Pair]

instance (ToObject a) => A.ToJSON (Object a) where
  toJSON = A.object . toObject

instance (ToObject a) => ToObject (Object a) where
  toObject object =
    [ "@context"
        A..=
        [ ("https://www.w3.org/ns/activitystreams" :: String)
        , ("https://w3id.org/security/v1" :: String)
        ]
    ]
      <> toObject object.otype
      <> [ assignment
         | Just assignment <-
            [ fmap ("id" A..=) object.id
            , fmap ("content" A..=) object.content
            , fmap ("attachement" A..=) object.attachment
            , fmap ("attributedTo" A..=) object.attributedTo
            , fmap ("published" A..=) object.published
            , fmap ("inReplyTo" A..=) object.inReplyTo
            , fmap ("url" A..=) object.url
            , fmap ("name" A..=) object.name
            , fmap ("icon" A..=) object.icon
            , fmap ("image" A..=) object.image
            , -- , fmap ("preview" A..=  ) object.preview
              fmap ("summary" A..=) object.summary
            , fmap ("updated" A..=) object.updated
            , fmap ("mediaType" A..=) object.mediaType
            , fmap ("to" A..=) object.to
            , fmap ("cc" A..=) object.cc
            , fmap ("replies" A..=) object.replies
            ]
         ]

instance (A.FromJSON a) => A.FromJSON (Object a) where
  parseJSON object = do
    otype <- A.parseJSON object
    flip (A.withObject "Object") object $ \v -> do
      id <- v A..:? "id"
      content <- v A..:? "content"
      published <- v A..:? "published"
      replies <- v A..:? "replies"
      attachment <- v A..:? "attachment"
      attributedTo <- v A..:? "attributedTo"
      tag <- pure Nothing -- v A..:? "tag"
      to <- v A..:? "to"
      cc <- v A..:? "cc"
      inReplyTo <- v A..:? "inReplyTo"
      url <- v A..:? "url"
      name <- v A..:? "name"
      icon <- v A..:? "icon"
      image <- v A..:? "image"
      preview <- pure Nothing -- v A..:? "preview"
      summary <- v A..:? "summary"
      updated <- v A..:? "updated"
      mediaType <- v A..:? "mediaType"
      pure $ Object {..}

newtype ObjectId = ObjectId {unwrap :: String}
  deriving (Show, Eq, A.FromJSON, A.ToJSON) via String

newtype Link = Link {unwrap :: Url}
  deriving (Show, Eq, A.FromJSON, A.ToJSON) via Url

data LinkOrObject a
  = LLink Link
  | OObject (Object a)
  | CCollection [LinkOrObject a]
  deriving (Show, Eq)

instance (A.FromJSON a) => A.FromJSON (LinkOrObject a) where
  parseJSON = \case
    A.String str -> pure $ LLink (Link $ T.unpack str)
    A.Array objs -> CCollection <$> traverse A.parseJSON (toList objs)
    value -> OObject <$> A.parseJSON value

getAttributedTo :: LinkOrObject a -> Link
getAttributedTo = \case
  LLink link -> link
  OObject obj -> Link (fromMaybe (ObjectId "") obj.id).unwrap
  CCollection list ->
    maybe (Link "") getAttributedTo (listToMaybe list)

instance (ToObject o) => A.ToJSON (LinkOrObject o) where
  toJSON = \case
    LLink link -> A.toJSON link
    OObject ob -> A.toJSON ob
    CCollection loos -> A.toJSON loos

data AnyMedia
  = ImageMedia Image
  deriving (Show, Eq)

instance A.ToJSON AnyMedia where
  toJSON = \case
    ImageMedia obj -> A.toJSON obj

instance A.FromJSON AnyMedia where
  parseJSON value =
    ImageMedia <$> A.parseJSON value

type Image = Object TypeImage

data TypeImage = TypeImage deriving (Show, Eq)

instance ToObject TypeImage where
  toObject TypeImage =
    ["type" A..= ("Image" :: String)]

instance A.FromJSON TypeImage where
  parseJSON =
    A.withObject "TypeImage" \value -> do
      (i :: String) <- value A..: "type"
      guard (i == "Image")
      pure TypeImage

data Name
  = StringName String
  | ObjectName (LinkOrObject Actor)
  deriving (Show, Eq)

instance A.ToJSON Name where
  toJSON = \case
    StringName str -> A.toJSON str
    ObjectName loo -> A.toJSON loo

instance A.FromJSON Name where
  parseJSON = \case
    A.String str -> pure $ StringName (T.unpack str)
    value -> ObjectName <$> A.parseJSON value

type Content = T.Text

type MediaType = String

-- | A Note is an object that has the type 'Note'.
type Note = Object TypeNote

data TypeNote
  = TypeNote
  { likes :: Collection Like
  , shares :: Collection Share
  , replies :: Collection Note
  , sensitive :: Bool
  }
  deriving (Show, Eq)

instance ToObject TypeNote where
  toObject note =
    [ "type" A..= ("Note" :: String)
    , "likes" A..= note.likes
    , "shares" A..= note.shares
    , "sensitive" A..= note.sensitive
    ]

instance A.FromJSON TypeNote where
  parseJSON =
    A.withObject "TypeNote" \value -> do
      likes <- value A..: "likes"
      shares <- value A..: "shares"
      replies <- value A..: "replies"
      sensitive <- value A..: "sensitive"
      pure TypeNote {..}

type Tag = Object TypeTag

data TypeTag
  = TypeTag
  { href :: Url
  }
  deriving (Show, Eq)

type Preview = Object TypePreview

data TypePreview = TypePreview
  deriving (Show, Eq)

type Share = Object TypeShare

data TypeShare = TypeShare deriving (Show, Eq)

instance ToObject TypeShare where
  toObject TypeShare =
    [ "type" A..= ("Share" :: String)
    ]

instance A.FromJSON TypeShare where
  parseJSON =
    A.withObject "TypeShare" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Share")
      pure TypeShare

-- * Activities

-- | An Activity is a superset of an Object with one of the following types,
-- <https://www.w3.org/TR/activitystreams-vocabulary/#activity-types>
-- and some additional fields.
type Activity t = Object (TypeActivity t)

data TypeActivity t
  = TypeActivity
  { actor :: Link
  , atype :: t
  , target :: Maybe AnyActivity
  , origin :: Maybe AnyActivity
  -- , result :: Maybe String
  -- , instrument :: Maybe String
  }
  deriving (Show, Eq)

instance (ToObject t) => ToObject (TypeActivity t) where
  toObject activity =
    [ "actor" A..= activity.actor
    ]
      <> [ pair
         | Just pair <-
            [ fmap ("target" A..=) activity.target
            , fmap ("origin" A..=) activity.origin
            ]
         ]
      <> toObject activity.atype

instance (A.FromJSON a) => A.FromJSON (TypeActivity a) where
  parseJSON object = do
    atype <- A.parseJSON object
    flip (A.withObject "TypeActivity") object \value -> do
      actor <- value A..: "actor"
      target <- value A..: "target"
      origin <- value A..: "origin"
      pure TypeActivity {..}

-- type Announce = Object (TypeActivity TypeAnnounce)
-- data TypeAnnounce = TypeAnnounce deriving Show
-- instance ToObject TypeAnnounce where
--   toObject TypeAnnounce =
--     [ "type" A..= ("Announce" :: String)
--     ]

type Create = Activity TypeCreate

data TypeCreate
  = TypeCreate
  { object :: Note
  }
  deriving (Show, Eq)

instance ToObject TypeCreate where
  toObject create =
    [ "type" A..= ("Create" :: String)
    , "object" A..= create.object
    ]

instance A.FromJSON TypeCreate where
  parseJSON =
    A.withObject "TypeCreate" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Create")
      object <- value A..: "object"
      pure TypeCreate {..}

type Follow = Object (TypeActivity TypeFollow)

data TypeFollow
  = TypeFollow
  { object :: LinkOrObject Actor
  }
  deriving (Show, Eq)

instance ToObject TypeFollow where
  toObject follow =
    [ "type" A..= ("Follow" :: String)
    , "object" A..= follow.object
    ]

instance A.FromJSON TypeFollow where
  parseJSON =
    A.withObject "TypeFollow" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Follow")
      object <- value A..: "object"
      pure TypeFollow {..}

-- | Undo
type Undo = Activity TypeUndo

data TypeUndo
  = TypeUndo
  { object :: AnyActivity
  }
  deriving (Show, Eq)

instance ToObject TypeUndo where
  toObject undo =
    [ "type" A..= ("Undo" :: String)
    , "object" A..= undo.object
    ]

instance A.FromJSON TypeUndo where
  parseJSON =
    A.withObject "TypeUndo" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Undo")
      object <- value A..: "object"
      pure TypeUndo {..}


--
type Like = Object (TypeActivity TypeLike)

data TypeLike = TypeLike deriving (Show, Eq)

instance ToObject TypeLike where
  toObject TypeLike =
    [ "type" A..= ("Like" :: String)
    ]

instance A.FromJSON TypeLike where
  parseJSON =
    A.withObject "TypeLike" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Like")
      pure TypeLike

data AnyActivity
  = -- ActivityAnnounce Announce
    ActivityCreate Create
  | ActivityUndo Undo
  | ActivityFollow Follow
  | --  | ActivityLike Like
    ActivityAccept Accept
  | ActivityReject Reject
  deriving (Show, Eq)

instance A.ToJSON AnyActivity where
  toJSON = \case
    --    ActivityAnnounce obj -> A.toJSON obj
    ActivityCreate obj -> A.toJSON obj
    ActivityUndo obj -> A.toJSON obj
    ActivityFollow obj -> A.toJSON obj
    --    ActivityLike obj -> A.toJSON obj
    ActivityAccept obj -> A.toJSON obj
    ActivityReject obj -> A.toJSON obj

instance A.FromJSON AnyActivity where
  parseJSON value =
    flip (A.withObject "AnyActivity") value \v -> do
      typ :: String <- v A..: "type"
      case typ of
        "Create" -> ActivityCreate <$> A.parseJSON value
        "Undo" -> ActivityUndo <$> A.parseJSON value
        "Follow" -> ActivityFollow <$> A.parseJSON value
        "Accept" -> ActivityAccept <$> A.parseJSON value
        "Reject" -> ActivityReject <$> A.parseJSON value
        _ -> fail ("Parsing '" <> typ <> "' not yet implemented.")

-- * Accept Reject Add Remove

type Accept = Object (TypeActivity TypeAccept)

data TypeAccept
  = TypeAccept
  { object :: AnyActivity
  }
  deriving (Show, Eq)

instance ToObject TypeAccept where
  toObject obj =
    [ "type" A..= ("Accept" :: String)
    , "object" A..= obj.object
    ]

instance A.FromJSON TypeAccept where
  parseJSON =
    A.withObject "TypeAccept" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Accept")
      object <- value A..: "object"
      pure TypeAccept {..}

type Reject = Object (TypeActivity TypeReject)

data TypeReject
  = TypeReject
  { object :: AnyActivity
  }
  deriving (Show, Eq)

instance ToObject TypeReject where
  toObject obj =
    [ "type" A..= ("Reject" :: String)
    , "object" A..= obj.object
    ]

instance A.FromJSON TypeReject where
  parseJSON =
    A.withObject "TypeReject" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Reject")
      object <- value A..: "object"
      pure TypeReject {..}

-- * Actors

-- | An Actor is an object that has one of the following types.
-- <https://www.w3.org/TR/activitystreams-vocabulary/#actor-types>
data Actor
  = ActorPerson Person
  deriving (Show, Eq)

instance A.FromJSON Actor where
  parseJSON =
    fmap ActorPerson . A.parseJSON

instance A.ToJSON Actor where
  toJSON = \case
    ActorPerson obj -> A.toJSON obj

instance ToObject Actor where
  toObject = \case
    ActorPerson obj -> toObject obj

-- | A Person is an object that has the type 'Person'.
type Person = Object TypePerson

instance A.FromJSON TypePerson where
  parseJSON =
    A.withObject "Person" \value -> do
      typ :: String <- value A..: "type"
      guard (typ == "Person")
      preferredUsername <- value A..: "preferredUsername"
      publicKey <- value A..: "publicKey"
      inbox <- value A..: "inbox"
      outbox <- value A..: "outbox"
      following <- value A..: "following"
      followers <- value A..: "followers"
      pure TypePerson {..}

data TypePerson
  = TypePerson
  { preferredUsername :: String
  , publicKey :: PublicKey
  , inbox :: Link
  , outbox :: Link
  , following :: Link
  , followers :: Link
  }
  deriving (Show, Eq)

instance ToObject TypePerson where
  toObject person =
    [ "type" A..= ("Person" :: String)
    , "preferredUsername" A..= person.preferredUsername
    , "publicKey" A..= person.publicKey
    , "inbox" A..= person.inbox
    , "outbox" A..= person.outbox
    , "following" A..= person.following
    , "followers" A..= person.followers
    ]

data PublicKey
  = PublicKey
  { pkid :: Url
  , owner :: Url
  , publicKeyPem :: Pem
  }
  deriving (Show, Eq)

instance A.ToJSON PublicKey where
  toJSON pk =
    A.object
      [ "id" A..= pk.pkid
      , "owner" A..= pk.owner
      , "publicKeyPem" A..= pk.publicKeyPem
      ]

instance A.FromJSON PublicKey where
  parseJSON =
    A.withObject "PublicKey" \value -> do
      pkid <- value A..: "id"
      owner <- value A..: "owner"
      publicKeyPem <- value A..: "publicKeyPem"
      pure PublicKey {..}

-- * Collections

type Collection e = Object (CollectionType (Unordered e))

type OrderedCollection e = Object (CollectionType (Ordered e))

type OrderedCollectionPage e = Object (CollectionType (OrderedPage e))

type Outbox = OrderedCollection AnyActivity

type OutboxPage = OrderedCollectionPage AnyActivity

type Followers = OrderedCollection Url
type FollowersPage = OrderedCollectionPage Url

data CollectionType t
  = CollectionType
  { ctype :: t
  , first :: Maybe Url
  , last :: Maybe Url
  , current :: Maybe Url
  }
  deriving (Show, Eq)

instance (ToObject t) => ToObject (CollectionType t) where
  toObject collection =
    toObject collection.ctype
      <> [ pair
         | Just pair <-
            [ fmap ("first" A..=) collection.first
            , fmap ("last" A..=) collection.last
            , fmap ("current" A..=) collection.current
            ]
         ]

instance (A.FromJSON t) => A.FromJSON (CollectionType t) where
  parseJSON value = do
    ctype <- A.parseJSON value
    flip (A.withObject "CollectionType") value \v -> do
      first <- v A..:? "first"
      last <- v A..:? "last"
      current <- v A..:? "current"
      pure CollectionType {..}

data Unordered e
  = UnorderedCollectionType
  { items :: [e]
  }
  deriving (Show, Eq)

instance (A.ToJSON e) => ToObject (Unordered e) where
  toObject collection =
    [ "type" A..= ("Collection" :: String)
    , "totalItems" A..= length collection.items
    , "items" A..= collection.items
    ]

instance (A.FromJSON e) => A.FromJSON (Unordered e) where
  parseJSON = do
    A.withObject "Unordered" \v -> do
      typ :: String <- v A..: "type"
      guard (typ == "Collection")
      items <- fromMaybe [] <$> v A..:? "items"
      pure UnorderedCollectionType {..}

data Ordered e
  = OrderedCollectionType
  { orderedItems :: [e]
  }
  deriving (Show, Eq)

instance (A.ToJSON e) => ToObject (Ordered e) where
  toObject collection =
    [ "type" A..= ("OrderedCollection" :: String)
    , "totalItems" A..= length collection.orderedItems
    , "orderedItems" A..= collection.orderedItems
    ]

instance (A.FromJSON e) => A.FromJSON (Ordered e) where
  parseJSON = do
    A.withObject "Ordered" \v -> do
      typ :: String <- v A..: "type"
      guard (typ == "OrderedCollection")
      orderedItems <- fromMaybe [] <$> v A..:? "orderedItems"
      pure OrderedCollectionType {..}

data OrderedPage e
  = OrderedCollectionPageType
  { partOf :: Url
  , prev :: Maybe Url
  , next :: Maybe Url
  , porderedItems :: [e]
  }
  deriving (Show, Eq)

instance (A.ToJSON e) => ToObject (OrderedPage e) where
  toObject page =
    [ "type" A..= ("OrderedCollectionPage" :: String)
    , "totalItems" A..= length page.porderedItems
    , "orderedItems" A..= page.porderedItems
    , "partOf" A..= page.partOf
    , "prev" A..= page.prev
    , "next" A..= page.next
    ]

instance (A.FromJSON e) => A.FromJSON (OrderedPage e) where
  parseJSON = do
    A.withObject "OrderedPage" \v -> do
      typ :: String <- v A..: "type"
      guard (typ == "OrderedCollectionPage")
      partOf <- v A..: "partOf"
      prev <- v A..:? "prev"
      next <- v A..:? "next"
      porderedItems <- fromMaybe [] <$> v A..:? "orderedItems"
      pure OrderedCollectionPageType {..}