fedi/app/Main.hs

module Main where

import Data.SecureMem (secureMemFromByteString)
import Data.String (fromString)
import Database.Sqlite.Easy qualified as Sqlite
import Data.Aeson qualified as A
import Network.Wai.Handler.Warp (run, Port)
import Network.Wai.Middleware.HttpAuth (basicAuth)
import Network.Wai.Middleware.RequestLogger qualified as Logger
import System.Environment (getArgs)
import System.Environment (lookupEnv)
import Web.Twain qualified as Twain
import Fedi qualified as Fedi
import Data.Functor ((<&>))
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import qualified Data.Text as T
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad.IO.Class (liftIO)

import DB

data Command
  = Serve
  | Insert FilePath

main :: IO ()
main = do
  command <- getArgs >>= \case
    ["insert", file] -> pure (Insert file)
    ["serve"] -> pure Serve
    _ -> usageError

  case command of
    Insert file -> do
      insertNoteFromFile file
    Serve ->
      serve

insertNoteFromFile :: FilePath -> IO ()
insertNoteFromFile file = do
  connStr <- maybe "/tmp/jot_sqlite_db.sqlite" fromString <$> lookupEnv "FEDI_CONN_STRING"
  content <- T.readFile file

  detailsFile <- lookupEnv "FEDI_DETAILS"
    <&> maybe (error "missing FEDI_DETAILS") id

  details <- A.eitherDecodeFileStrict detailsFile
    <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id

  db <- mkDB connStr details

  db.insertNote NoteEntry
    { content = content
    , inReplyTo = Nothing
    , name = Nothing
    , url = Nothing
    }


serve :: IO ()
serve = do
  auth <- fmap (T.splitOn "," . T.pack) <$> lookupEnv "FEDI_AUTH"
  authMiddleware <-
    case auth of
      Nothing -> do
        putStrLn "Starting server with authentication disabled."
        pure id
      Just [user, pass] -> do
        putStrLn "Starting server with authentication enabled,"
        let
          username = secureMemFromByteString $ T.encodeUtf8 user
          password = secureMemFromByteString $ T.encodeUtf8 pass
        pure $ basicAuth
          ( \u p -> pure $
            secureMemFromByteString u == username
            && secureMemFromByteString p == password
          )
          "My Jot"
      Just{} -> usageError

  fediPort <- maybe 3001 read <$> lookupEnv "FEDI_PORT"
  conn <- maybe "/tmp/jot_sqlite_db.sqlite" fromString <$> lookupEnv "FEDI_CONN_STRING"
  putStrLn $ "and with connection string " <> show (Sqlite.unConnectionString conn) <> "."

  runServer fediPort authMiddleware =<< mkFediApp conn

usageError :: err
usageError =
  errorWithoutStackTrace $ unlines
    [ "Usage: fedi [ insert <FILE> | serve ]"
    , "Env vars:"
    , " - FEDI_PORT=<PORT>"
    , " - FEDI_DETAILS=<FILE>"
    , " - FEDI_CONN_STRING=<SQLITE_CONN_STR>"
    , " - FEDI_CONN_STRING=<SQLITE_CONN_STR>"
    , " - FEDI_AUTH=<user>,<password>"
    ]

-- | Run server at at specific port.
runServer :: Port -> Twain.Middleware -> Twain.Application -> IO ()
runServer port authMiddleware app = do
  putStrLn $ unwords
    [ "Running fedi at"
    , "http://localhost:" <> show port
    , "(ctrl-c to quit)"
    ]
  run port (Logger.logStdoutDev $ authMiddleware app)

-- | Application description.
mkFediApp :: Sqlite.ConnectionString -> IO Twain.Application
mkFediApp connStr = do
  detailsFile <- lookupEnv "FEDI_DETAILS"
    <&> maybe (error "missing FEDI_DETAILS") id

  details <- A.eitherDecodeFileStrict detailsFile
    <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id

  db <- mkDB connStr details

  pure $ foldr ($)
    (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
    (routes db detailsFile)


-- * Routes

routes :: DB -> FilePath -> [Twain.Middleware]
routes db detailsFile =
  [ -- Match actor
    Twain.get (Fedi.matchUser $ unsafePerformIO $ fetchUserDetails detailsFile) do
    details <- liftIO $ fetchUserDetails detailsFile
    Fedi.handleUser details

  , -- Match outbox
    Twain.get (Fedi.matchOutbox $ unsafePerformIO $ fetchUserDetails detailsFile) do
      details <- liftIO $ fetchUserDetails detailsFile
      notes <- map noteToCreate <$> liftIO db.getNotes
      Fedi.handleOutbox details notes

  , -- Match Create object
    Twain.get (Fedi.matchCreate $ unsafePerformIO $ fetchUserDetails detailsFile) do
      details <- liftIO $ fetchUserDetails detailsFile
      notes <- map noteToCreate <$> liftIO db.getNotes

      Fedi.handleCreate details notes

  , -- Match Note object
    Twain.get (Fedi.matchNote $ unsafePerformIO $ fetchUserDetails detailsFile) do
      details <- liftIO $ fetchUserDetails detailsFile
      notes <- map noteToCreate <$> liftIO db.getNotes
      Fedi.handleNote details notes

  , -- Match webfinger
    Twain.get Fedi.matchWebfinger do
    details <- liftIO $ fetchUserDetails detailsFile
    Fedi.handleWebfinger details
  ]

fetchUserDetails :: FilePath -> IO Fedi.UserDetails
fetchUserDetails detailsFile =
  A.eitherDecodeFileStrict detailsFile
    <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id

noteToCreate :: Fedi.Note -> Fedi.Activity
noteToCreate note =
    Fedi.Create
      { id =
        note.id <> "/create"
      , actor = note.actor
      , object = Fedi.NoteObject note
      }