129 lines
3.7 KiB
Haskell
129 lines
3.7 KiB
Haskell
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.Routed qualified as Wai
|
|
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 Data.Functor ((<&>))
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Data.Text.IO as T
|
|
import qualified Data.Text as T
|
|
|
|
import DB
|
|
import Routes
|
|
|
|
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/fediserve_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
|
|
|
|
note <- db.insertNote NoteEntry
|
|
{ content = content
|
|
, inReplyTo = Nothing
|
|
, name = Nothing
|
|
, url = Nothing
|
|
}
|
|
|
|
putStrLn "Inserted."
|
|
print note
|
|
|
|
|
|
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 Fediserve"
|
|
Just{} -> usageError
|
|
|
|
fediPort <- maybe 3001 read <$> lookupEnv "FEDI_PORT"
|
|
conn <- maybe "/tmp/fediserve_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_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)"
|
|
]
|
|
auth <- Wai.routedMiddleware matchAdmin <$> pure authMiddleware
|
|
run port (Logger.logStdoutDev $ auth app)
|
|
|
|
|
|
matchAdmin :: [T.Text] -> Bool
|
|
matchAdmin = any (=="admin")
|
|
|
|
-- | 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)
|