dbalan/quotes-api
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Readwise on imoprter.

Browse Source
This commit is contained in:
Dhananjay Balan 2023-04-13 23:46:43 +02:00
parent 72b3e38980
commit 12099b5e9e
1 changed files with 9 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
app/Main.hs
View File

@ -11,15 +11,13 @@ import Servant
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Servant.HTML.Blaze import Servant.HTML.Blaze
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Encoding (decodeUtf8)
import Crypto.Argon2 import Crypto.Argon2
import Data.Text.Short (fromText, ShortText) import Data.Text.Short (fromText, ShortText)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.ByteString.Lazy (fromStrict)
import Api.Types import Api.Types
import qualified Parsers.KOReader as KO import qualified Parsers.KOReader as KO
import qualified Parsers.Readwise as RW
import Config import Config
import Options.Applicative import Options.Applicative
import Database import Database
@ -33,31 +31,30 @@ type API = Get '[HTML] Quote
:<|> "quotes" :> Get '[JSON] [Quote] :<|> "quotes" :> Get '[JSON] [Quote]
:<|> "quote" :> "random" :> Get '[JSON] Quote :<|> "quote" :> "random" :> Get '[JSON] Quote
:<|> "today" :> Get '[HTML] Quote :<|> "today" :> Get '[HTML] Quote
:<|> BasicAuth "update data" User :> ( "koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent :<|> BasicAuth "update data" User :> "koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent
:<|> "readwise" :> ReqBody '[PlainText] T.Text :> Post '[JSON] NoContent)
api :: Proxy API api :: Proxy API
api = Proxy api = Proxy
checkBasicAuth :: T.Text -> ShortText -> BasicAuthCheck User checkBasicAuth :: T.Text -> ShortText -> BasicAuthCheck User
checkBasicAuth user passhash = BasicAuthCheck $ \authData -> checkBasicAuth user passhash = BasicAuthCheck $ \authData ->
let username = decodeUtf8 (basicAuthUsername authData) let u = decodeUtf8 (basicAuthUsername authData)
password = basicAuthPassword authData p = basicAuthPassword authData
in in
case user == username of case user == u of
False -> return NoSuchUser False -> return NoSuchUser
True -> case verifyEncoded passhash password of True -> case verifyEncoded passhash p of
Argon2Ok -> return $ Authorized $ User username password Argon2Ok -> return $ Authorized $ User u p
_ -> return Unauthorized _ -> return Unauthorized
-- | TODO: readerT -- | TODO: readerT
server :: FilePath -> Server API server :: FilePath -> Server API
server dbf = randomQuote dbf server dbf = randomQuote dbf
:<|> listQuotes dbf :<|> listQuotes dbf
:<|> randomQuote dbf :<|> randomQuote dbf
:<|> randomQuote dbf :<|> randomQuote dbf
:<|> (\_ -> (addKoReader dbf :<|> addReadwise dbf)) :<|> const (addKoReader dbf)
-- | API begins here -- | API begins here
randomQuote :: FilePath -> Handler Quote randomQuote :: FilePath -> Handler Quote
@ -77,14 +74,6 @@ addKoReader db hl = do
liftIO $ insertQts db (KO.parse hl) liftIO $ insertQts db (KO.parse hl)
pure NoContent pure NoContent
addReadwise :: FilePath -> T.Text -> Handler NoContent
addReadwise db hl = do
let
qts = RW.parse (fromStrict $ encodeUtf8 hl)
liftIO $ print $ show qts
pure NoContent
runApp :: AppConfig -> IO () runApp :: AppConfig -> IO ()
runApp c = run (appPort c) (serveWithContext api ctx $ server (appDbFile c)) runApp c = run (appPort c) (serveWithContext api ctx $ server (appDbFile c))
where where