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 | serve ]" , "Env vars:" , " - FEDI_PORT=" , " - FEDI_DETAILS=" , " - FEDI_CONN_STRING=" , " - FEDI_CONN_STRING=" , " - FEDI_AUTH=," ] -- | 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 }