#{show time}
#{msg}
#{intercalate " | " $ map BC.unpack ctypes}
                  #{decodeUtf8 body}
        |]

getSharerInboxR :: ShrIdent -> Handler TypedContent
getSharerInboxR _ = error "TODO implement getSharerInboxR"

getProjectInboxR :: ShrIdent -> PrjIdent -> Handler TypedContent
getProjectInboxR _ _ = error "TODO implement getProjectInboxR"

postSharerInboxR :: ShrIdent -> Handler ()
postSharerInboxR shrRecip = do
    federation <- getsYesod $ appFederation . appSettings
    unless federation badMethod
    contentTypes <- lookupHeaders "Content-Type"
    body <- requireJsonBody
    now <- liftIO getCurrentTime
    result <- go now contentTypes body
    recordActivity now result contentTypes body
    case result of
        Left _ -> sendResponseStatus badRequest400 ()
        Right _ -> return ()
    where
    go now ctypes (WithValue raw (Doc hActivity activity)) = runExceptT $ do
        verifyContentType
        HttpSigVerResult result <-
            ExceptT $
                first (T.pack . displayException) <$>
                    verifyRequestSignature now
        ActorDetail uSender iid _raid <- ExceptT $ pure $ first T.pack result
        let (hSender, luSender) = f2l uSender
        unless (hSender == hActivity) $
            throwE $ T.concat
                [ "Activity host <", hActivity
                , "> doesn't match signature key host <", hSender, ">"
                ]
        unless (activityActor activity == luSender) $
            throwE $ T.concat
                [ "Activity's actor <"
                , renderFedURI $ l2f hActivity $ activityActor activity
                , "> != Signature key's actor <", renderFedURI uSender, ">"
                ]
        handleSharerInbox now shrRecip iid raw activity
        where
        verifyContentType =
            case ctypes of
                [] -> throwE "Content-Type not specified"
                [x] | x == typeAS -> return ()
                    | x == typeAS2 -> return ()
                    | otherwise ->
                        throwE $ "Not a recognized AP Content-Type: " <>
                            case decodeUtf8' x of
                                Left _ -> T.pack (show x)
                                Right t -> t
                _ -> throwE "More than one Content-Type specified"
            where
            typeAS = "application/activity+json"
            typeAS2 =
                "application/ld+json; \
                \profile=\"https://www.w3.org/ns/activitystreams\""
    recordActivity now result contentTypes body = do
        acts <- getsYesod appActivities
        liftIO $ atomically $ modifyTVar' acts $ \ vec ->
            let msg = either id id result
                formattedBody = encodePretty $ wvRaw body
                item = ActivityReport now msg contentTypes formattedBody
                vec' = item `V.cons` vec
            in  if V.length vec' > 10
                    then V.init vec'
                    else vec'

postProjectInboxR :: ShrIdent -> PrjIdent -> Handler ()
postProjectInboxR _ _ = error "TODO implement postProjectInboxR"

{-
jsonField :: (FromJSON a, ToJSON a) => Field Handler a
jsonField = checkMMap fromTextarea toTextarea textareaField
    where
    toTextarea = Textarea . TL.toStrict . encodePrettyToLazyText
    fromTextarea = return . first T.pack . eitherDecodeStrict' . encodeUtf8 . unTextarea
-}

fedUriField
    :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m FedURI
fedUriField = Field
    { fieldParse = parseHelper $ \ t ->
        case parseFedURI t of
            Left e  -> Left $ MsgInvalidUrl $ T.pack e <> ": " <> t
            Right u -> Right u
    , fieldView = \theId name attrs val isReq ->
        [whamlet||]
    , fieldEnctype = UrlEncoded
    }

ticketField
    :: (Route App -> LocalURI) -> Field Handler (Text, ShrIdent, PrjIdent, Int)
ticketField encodeRouteLocal = checkMMap toTicket fromTicket fedUriField
    where
    toTicket uTicket = runExceptT $ do
        let (hTicket, luTicket) = f2l uTicket
        route <-
            case decodeRouteLocal luTicket of
                Nothing -> throwE ("Not a valid route" :: Text)
                Just r -> return r
        case route of
            TicketR shr prj num -> return (hTicket, shr, prj, num)
            _ -> throwE "Not a ticket route"
    fromTicket (h, shr, prj, num) =
        l2f h $ encodeRouteLocal $ TicketR shr prj num

activityForm :: Form ((Text, ShrIdent, PrjIdent, Int), Maybe FedURI, Text)
activityForm html = do
    enc <- getEncodeRouteLocal
    flip renderDivs html $ (,,)
        <$> areq (ticketField enc) "Ticket"      (Just deft)
        <*> aopt fedUriField       "Replying to" (Just $ Just defp)
        <*> areq textField         "Message"     (Just defmsg)
    where
    deft = ("forge.angeley.es", text2shr "fr33", text2prj "sandbox", 1)
    defp = FedURI "forge.angeley.es" "/s/fr33/m/2f1a7" ""
    defmsg = "Hi! I'm testing federation. Can you see my message? :)"

activityWidget :: ShrIdent -> Widget -> Enctype -> Widget
activityWidget shr widget enctype =
    [whamlet|
        
          This is a federation test page. Provide a recepient actor URI and
          message text, and a Create activity creating a new Note will be sent
          to the destination server.
        

          ^{widget}
          
    |]

getUserShrIdent :: Handler ShrIdent
getUserShrIdent = do
    Entity _ p <- requireVerifiedAuth
    s <- runDB $ get404 $ personIdent p
    return $ sharerIdent s

getPublishR :: Handler Html
getPublishR = do
    shr <- getUserShrIdent
    ((_result, widget), enctype) <- runFormPost activityForm
    defaultLayout $ activityWidget shr widget enctype

getOutboxR :: ShrIdent -> Handler TypedContent
getOutboxR = error "Not implemented yet"

getOutboxItemR :: ShrIdent -> KeyHashid OutboxItem -> Handler TypedContent
getOutboxItemR = error "Not implemented yet"

postOutboxR :: ShrIdent -> Handler Html
postOutboxR shrAuthor = do
    federation <- getsYesod $ appFederation . appSettings
    unless federation badMethod
    ((result, widget), enctype) <- runFormPost activityForm
    elmid <- runExceptT $ do
        ((hTicket, shrTicket, prj, num), muParent, msg) <-
            case result of
                FormMissing -> throwE "Field(s) missing"
                FormFailure _l -> throwE "Invalid input, see below"
                FormSuccess r -> return r
        encodeRouteFed <- getEncodeRouteFed
        encodeRouteLocal <- getEncodeRouteLocal
        let encodeRecipRoute = l2f hTicket . encodeRouteLocal
            uTicket = encodeRecipRoute $ TicketR shrTicket prj num
        now <- liftIO getCurrentTime
        let (hLocal, luAuthor) = f2l $ encodeRouteFed $ SharerR shrAuthor
            recips =
                [ ProjectR shrTicket prj
                , TicketParticipantsR shrTicket prj num
                , TicketTeamR shrTicket prj num
                ]
            note = Note
                { noteId        = Nothing
                , noteAttrib    = luAuthor
                , noteAudience  = Audience
                    { audienceTo      = map encodeRecipRoute recips
                    , audienceBto     = []
                    , audienceCc      = []
                    , audienceBcc     = []
                    , audienceGeneral = []
                    }
                , noteReplyTo   = Just $ fromMaybe uTicket muParent
                , noteContext   = Just uTicket
                , notePublished = Just now
                , noteContent   = msg
                }
        ExceptT $ handleOutboxNote hLocal note
    case elmid of
        Left err -> setMessage $ toHtml err
        Right lmid -> do
            lmkhid <- encodeKeyHashid lmid
            renderUrl <- getUrlRender
            let u = renderUrl $ MessageR shrAuthor lmkhid
            setMessage $ toHtml $ "Message created! ID: " <> u
    defaultLayout $ activityWidget shrAuthor widget enctype

getActorKey :: ((ActorKey, ActorKey, Bool) -> ActorKey) -> Route App -> Handler TypedContent
getActorKey choose route = selectRep $ provideAP $ do
    actorKey <-
        liftIO . fmap (actorKeyPublicBin . choose) . readTVarIO =<<
        getsYesod appActorKeys
    route2uri <- getEncodeRouteFed
    let (host, id_) = f2l $ route2uri route
    return $ Doc host PublicKey
        { publicKeyId       = id_
        , publicKeyExpires  = Nothing
        , publicKeyOwner    = OwnerInstance
        , publicKeyMaterial = actorKey
        --, publicKeyAlgo    = Just AlgorithmEd25519
        }

getActorKey1R :: Handler TypedContent
getActorKey1R = getActorKey (\ (k1, _, _) -> k1) ActorKey1R

getActorKey2R :: Handler TypedContent
getActorKey2R = getActorKey (\ (_, k2, _) -> k2) ActorKey2R