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 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 (encodeUtf8)
|
||||||
import Data.Text.Short (fromText, ShortText)
|
import Data.ByteString.Lazy (fromStrict)
|
||||||
import Data.ByteString (ByteString)
|
|
||||||
|
|
||||||
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
|
||||||
|
|
||||||
data User = User
|
|
||||||
{ username :: T.Text
|
|
||||||
, password :: ByteString
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
type API = Get '[HTML] Quote
|
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
|
|
||||||
|
|
||||||
|
|
||||||
api :: Proxy API
|
api :: Proxy API
|
||||||
api = Proxy
|
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
|
-- | TODO: readerT
|
||||||
server :: FilePath -> Server API
|
server :: FilePath -> Server API
|
||||||
@ -67,7 +36,6 @@ server dbf = randomQuote dbf
|
|||||||
:<|> listQuotes dbf
|
:<|> listQuotes dbf
|
||||||
:<|> randomQuote dbf
|
:<|> randomQuote dbf
|
||||||
:<|> randomQuote dbf
|
:<|> randomQuote dbf
|
||||||
:<|> const (addKoReader dbf)
|
|
||||||
|
|
||||||
-- | API begins here
|
-- | API begins here
|
||||||
randomQuote :: FilePath -> Handler Quote
|
randomQuote :: FilePath -> Handler Quote
|
||||||
@ -87,10 +55,15 @@ 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) (serve api $ server (appDbFile c))
|
||||||
where
|
|
||||||
ctx = checkBasicAuth (appUser c) (fromText $ appPassHash c):. EmptyContext
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -33,6 +33,7 @@
|
|||||||
devShells.default = pkgs.mkShell {
|
devShells.default = pkgs.mkShell {
|
||||||
buildInputs = with pkgs; [
|
buildInputs = with pkgs; [
|
||||||
haskellPackages.haskell-language-server # you must build it with your ghc to work
|
haskellPackages.haskell-language-server # you must build it with your ghc to work
|
||||||
|
haskellPackages.hoogle
|
||||||
ghcid
|
ghcid
|
||||||
hlint
|
hlint
|
||||||
ghc
|
ghc
|
||||||
|
@ -7,13 +7,10 @@ module Config
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
import Data.Text (Text)
|
|
||||||
|
|
||||||
data AppConfig = AppConfig
|
data AppConfig = AppConfig
|
||||||
{ appPort :: Int
|
{ appPort :: Int
|
||||||
, appDbFile :: FilePath
|
, appDbFile :: FilePath
|
||||||
, appUser :: Text
|
|
||||||
, appPassHash :: Text
|
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
appConfig :: Parser AppConfig
|
appConfig :: Parser AppConfig
|
||||||
@ -30,15 +27,6 @@ appConfig = AppConfig
|
|||||||
<> showDefault
|
<> showDefault
|
||||||
<> value "quotes.db"
|
<> value "quotes.db"
|
||||||
<> metavar "TARGET")
|
<> 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 :: ParserInfo AppConfig
|
||||||
parserOpts = info (appConfig <**> helper)
|
parserOpts = info (appConfig <**> helper)
|
||||||
|
@ -89,14 +89,6 @@ library
|
|||||||
-- Base language which the package is written in.
|
-- Base language which the package is written in.
|
||||||
default-language: Haskell2010
|
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
|
executable quotes-api
|
||||||
-- Import common warning flags.
|
-- Import common warning flags.
|
||||||
import: warnings
|
import: warnings
|
||||||
@ -123,10 +115,10 @@ executable quotes-api
|
|||||||
quotes-api,
|
quotes-api,
|
||||||
servant-blaze,
|
servant-blaze,
|
||||||
optparse-applicative,
|
optparse-applicative,
|
||||||
-- argon2,
|
|
||||||
text-short,
|
text-short,
|
||||||
bytestring,
|
bytestring,
|
||||||
QuickCheck,
|
QuickCheck,
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
hs-source-dirs: app
|
hs-source-dirs: app
|
||||||
|
|
||||||
@ -149,10 +141,10 @@ executable quotes-importer
|
|||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends:
|
build-depends:
|
||||||
base ^>=4.16.3.0,
|
base,
|
||||||
sqlite-simple ^>=0.4.18.0,
|
sqlite-simple,
|
||||||
text ^>=1.2.5.0,
|
text,
|
||||||
servant-server ^>=0.19.1,
|
servant-server,
|
||||||
wai,
|
wai,
|
||||||
warp,
|
warp,
|
||||||
aeson,
|
aeson,
|
||||||
@ -160,7 +152,6 @@ executable quotes-importer
|
|||||||
quotes-api,
|
quotes-api,
|
||||||
servant-blaze,
|
servant-blaze,
|
||||||
optparse-applicative,
|
optparse-applicative,
|
||||||
argon2 >= 1.3.0,
|
|
||||||
text-short,
|
text-short,
|
||||||
bytestring,
|
bytestring,
|
||||||
QuickCheck,
|
QuickCheck,
|
||||||
|
Loading…
Reference in New Issue
Block a user