Remove authenticated API: Migrte importing to an API
> Mostly because its less awkward to operate.
This commit is contained in:
parent
e045575dda
commit
062a76c8ba
49
app/Main.hs
49
app/Main.hs
@ -11,55 +11,24 @@ import Servant
|
||||
import Control.Monad.IO.Class
|
||||
import Servant.HTML.Blaze
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
|
||||
import Data.Text.Short (fromText, ShortText)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.ByteString.Lazy (fromStrict)
|
||||
|
||||
import Api.Types
|
||||
import qualified Parsers.KOReader as KO
|
||||
import qualified Parsers.Readwise as RW
|
||||
import Config
|
||||
import Options.Applicative
|
||||
import Database
|
||||
|
||||
data User = User
|
||||
{ username :: T.Text
|
||||
, password :: ByteString
|
||||
} deriving (Show, Eq)
|
||||
|
||||
type API = Get '[HTML] Quote
|
||||
:<|> "quotes" :> Get '[JSON] [Quote]
|
||||
:<|> "quote" :> "random" :> Get '[JSON] Quote
|
||||
:<|> "today" :> Get '[HTML] Quote
|
||||
:<|> BasicAuth "update data" User :> "koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent
|
||||
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
{-
|
||||
checkBasicAuth :: T.Text -> ShortText -> BasicAuthCheck User
|
||||
checkBasicAuth user passhash = BasicAuthCheck $ \authData ->
|
||||
let u = decodeUtf8 (basicAuthUsername authData)
|
||||
p = basicAuthPassword authData
|
||||
in
|
||||
case user == u of
|
||||
False -> return NoSuchUser
|
||||
True -> case verifyEncoded passhash p of
|
||||
Argon2Ok -> return $ Authorized $ User u p
|
||||
_ -> return Unauthorized
|
||||
|
||||
-}
|
||||
checkBasicAuth :: T.Text -> ShortText -> BasicAuthCheck User
|
||||
checkBasicAuth _ _ = BasicAuthCheck $ \_ -> return NoSuchUser
|
||||
|
||||
initDb :: FilePath -> IO ()
|
||||
initDb dbFile = withConnection dbFile $ \conn ->
|
||||
execute_ conn
|
||||
[sql|CREATE TABLE IF NOT EXISTS quotes ( quote text non null
|
||||
, author text
|
||||
, title text
|
||||
, page text
|
||||
, chapter text
|
||||
, created_on integer);|]
|
||||
|
||||
-- | TODO: readerT
|
||||
server :: FilePath -> Server API
|
||||
@ -67,7 +36,6 @@ server dbf = randomQuote dbf
|
||||
:<|> listQuotes dbf
|
||||
:<|> randomQuote dbf
|
||||
:<|> randomQuote dbf
|
||||
:<|> const (addKoReader dbf)
|
||||
|
||||
-- | API begins here
|
||||
randomQuote :: FilePath -> Handler Quote
|
||||
@ -87,10 +55,15 @@ addKoReader db hl = do
|
||||
liftIO $ insertQts db (KO.parse hl)
|
||||
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 c = run (appPort c) (serveWithContext api ctx $ server (appDbFile c))
|
||||
where
|
||||
ctx = checkBasicAuth (appUser c) (fromText $ appPassHash c):. EmptyContext
|
||||
runApp c = run (appPort c) (serve api $ server (appDbFile c))
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
@ -33,6 +33,7 @@
|
||||
devShells.default = pkgs.mkShell {
|
||||
buildInputs = with pkgs; [
|
||||
haskellPackages.haskell-language-server # you must build it with your ghc to work
|
||||
haskellPackages.hoogle
|
||||
ghcid
|
||||
hlint
|
||||
ghc
|
||||
|
@ -7,13 +7,10 @@ module Config
|
||||
) where
|
||||
|
||||
import Options.Applicative
|
||||
import Data.Text (Text)
|
||||
|
||||
data AppConfig = AppConfig
|
||||
{ appPort :: Int
|
||||
, appDbFile :: FilePath
|
||||
, appUser :: Text
|
||||
, appPassHash :: Text
|
||||
} deriving (Show, Eq)
|
||||
|
||||
appConfig :: Parser AppConfig
|
||||
@ -30,15 +27,6 @@ appConfig = AppConfig
|
||||
<> showDefault
|
||||
<> value "quotes.db"
|
||||
<> metavar "TARGET")
|
||||
<*> strOption
|
||||
( long "user"
|
||||
<> help "basic auth user (for writes)"
|
||||
<> showDefault
|
||||
<> value "root"
|
||||
<> metavar "USER")
|
||||
<*> strOption
|
||||
( long "password"
|
||||
<> help "password hash for basic auth user, generate with argon2")
|
||||
|
||||
parserOpts :: ParserInfo AppConfig
|
||||
parserOpts = info (appConfig <**> helper)
|
||||
|
@ -89,14 +89,6 @@ library
|
||||
-- Base language which the package is written in.
|
||||
default-language: Haskell2010
|
||||
|
||||
executable importer
|
||||
import: warnings
|
||||
main-is: Main.hs
|
||||
hs-source-dirs: importer
|
||||
default-language: Haskell2010
|
||||
build-depends:
|
||||
base,
|
||||
text
|
||||
executable quotes-api
|
||||
-- Import common warning flags.
|
||||
import: warnings
|
||||
@ -123,10 +115,10 @@ executable quotes-api
|
||||
quotes-api,
|
||||
servant-blaze,
|
||||
optparse-applicative,
|
||||
-- argon2,
|
||||
text-short,
|
||||
bytestring,
|
||||
QuickCheck,
|
||||
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: app
|
||||
|
||||
@ -149,10 +141,10 @@ executable quotes-importer
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends:
|
||||
base ^>=4.16.3.0,
|
||||
sqlite-simple ^>=0.4.18.0,
|
||||
text ^>=1.2.5.0,
|
||||
servant-server ^>=0.19.1,
|
||||
base,
|
||||
sqlite-simple,
|
||||
text,
|
||||
servant-server,
|
||||
wai,
|
||||
warp,
|
||||
aeson,
|
||||
@ -160,7 +152,6 @@ executable quotes-importer
|
||||
quotes-api,
|
||||
servant-blaze,
|
||||
optparse-applicative,
|
||||
argon2 >= 1.3.0,
|
||||
text-short,
|
||||
bytestring,
|
||||
QuickCheck,
|
||||
|
Loading…
Reference in New Issue
Block a user