iyql 0.0.6 → 0.0.7
raw patch · 6 files changed
+67/−60 lines, 6 filesdep ~hoauth
Dependency ranges changed: hoauth
Files
- iyql.cabal +2/−2
- src/main/haskell/Yql/Core/Backend.hs +58/−51
- src/main/haskell/Yql/Data/Version.hs +1/−1
- src/main/haskell/Yql/UI/CLI/Commands/Login.hs +3/−2
- src/main/haskell/Yql/UI/Cli.hs +1/−2
- src/main/haskell/iyql.hs +2/−2
iyql.cabal view
@@ -1,5 +1,5 @@ name: iyql-version: 0.0.6+version: 0.0.7 category: Network license: GPL-3 license-file: LICENSE@@ -23,7 +23,7 @@ hs-source-dirs: src/main/haskell build-depends: haskell98 , base<5- , hoauth>=0.3.0+ , hoauth>=0.3.1 , directory>=1.0.1.0 , filepath>=1.1.0.3 , containers>=0.3.0.0
src/main/haskell/Yql/Core/Backend.hs view
@@ -52,7 +52,7 @@ import Network.OAuth.Consumer hiding (application) import qualified Network.OAuth.Http.Request as R import Network.OAuth.Http.Response-import Network.OAuth.Http.HttpClient+import Network.OAuth.Http.CurlHttpClient newtype OutputT m a = OutputT { unOutputT :: m (Either String a) } @@ -65,19 +65,19 @@ -- | Tells the minimum security level required to perform this -- statament.-descTablesIn :: (MonadIO m,HttpClient c,Yql y) => y -> c -> [String] -> Expression -> OutputT m Description-descTablesIn y c envs stmt = case stmt- of _ | desc stmt -> return $ foldr1 joinDesc (map (const $ Table "<<many>>" Any False) (tables stmt))- | usingMe stmt -> return $ foldr1 joinDesc (map (const $ Table "<<many>>" User False) (tables stmt))- | showTables stmt -> return (Table "<<dummy>>" Any False)- | otherwise -> fmap (foldr1 joinDesc) (mapM execDesc (tables stmt))+descTablesIn :: (MonadIO m,Yql y) => y -> [String] -> Expression -> OutputT m Description+descTablesIn y envs stmt = case stmt+ of _ | desc stmt -> return $ foldr1 joinDesc (map (const $ Table "<<many>>" Any False) (tables stmt))+ | usingMe stmt -> return $ foldr1 joinDesc (map (const $ Table "<<many>>" User False) (tables stmt))+ | showTables stmt -> return (Table "<<dummy>>" Any False)+ | otherwise -> fmap (foldr1 joinDesc) (mapM execDesc (tables stmt)) where parseXml xml = case (xmlParse xml) of Just doc -> case (readDescXml doc) of Just rst -> return rst Nothing -> fail $ "couldn't desc tables " ++ L.intercalate "," (tables stmt) Nothing -> fail "error parsing xml" - execDesc t = execute y c database (mkDesc stmt t) >>= parseXml+ execDesc t = execute y database (mkDesc stmt t) >>= parseXml where database = M.fromList [("request", F.function)] mkDesc (USE u a stmt') t = USE u a (mkDesc stmt' t)@@ -134,7 +134,10 @@ -- | Returns the endpoint this backend is pointing to endpoint :: y -> (String,Int) endpoint _ = ("query.yahooapis.com",80)- ++ -- | The OAuth application that is being used+ app :: y -> Application+ -- | Add a new env that is included in the request setenv :: y -> String -> y @@ -145,28 +148,30 @@ getenv :: y -> [String] -- | Returns the credentials that are used to perform the request.- credentials :: (MonadIO m,HttpClient c) => y -> c -> Security -> OAuthMonadT m ()+ credentials :: (MonadIO m) => y -> Security -> OAuthMonadT m () -- | Given an statement executes the query on yql. This function is -- able to decide whenever that query requires authentication -- [TODO]. If it does, it uses the oauth token in order to fullfil -- the request.- execute :: (MonadIO m,HttpClient c) => y -> c -> Database -> Expression -> OutputT m String- execute y c db stmt = do { mkRequest' <- fmap (execBefore_) (ld' db stmt)- ; mkResponse <- fmap execAfter_ (ld' db stmt)- ; mkOutput <- fmap execTransform_ (ld' db stmt)- ; tableDesc <- descTablesIn y c (R.find (=="env") . R.qString . mkRequest' $ emptyRequest) stmt- ; result <- lift $ runOAuth handleE NoToken $ do { credentials y c (security tableDesc)- ; url <- signRq2 HMACSHA1 (Just $ Realm "yahooapis.com") (fixRequest $ mkRequest' $ (myRequest tableDesc))- ; serviceRequest c url >>= return . Right . mkOutput . toString . mkResponse- }- ; case result- of Right v -> return v- Left err -> fail err- }+ execute :: (MonadIO m) => y -> Database -> Expression -> OutputT m String+ execute y db stmt = do { mkRequest' <- fmap (execBefore_) (ld' db stmt)+ ; mkResponse <- fmap execAfter_ (ld' db stmt)+ ; mkOutput <- fmap execTransform_ (ld' db stmt)+ ; tableDesc <- descTablesIn y (R.find (=="env") . R.qString . mkRequest' $ emptyRequest) stmt+ ; result <- lift $ runOAuth handleE token $ do { credentials y (security tableDesc) >> getToken+ ; url <- signRq2 HMACSHA1 (Just $ Realm "yahooapis.com") (fixRequest $ mkRequest' $ (myRequest tableDesc))+ ; serviceRequest CurlClient url >>= return . Right . mkOutput . toString . mkResponse+ }+ ; case result+ of Right v -> return v+ Left err -> fail err+ } where myRequest = mkRequest stmt (getenv y) + token = fromApplication (app y)+ fixRequest r = r { R.host = fst (endpoint y) , R.port = snd (endpoint y) }@@ -192,40 +197,42 @@ instance SessionMgr a => Yql (Backend a) where endpoint be = myEndpoint be + app = application+ setenv be e = be { defaultEnv = e : defaultEnv be } unsetenv be e = be { defaultEnv = L.delete e (defaultEnv be) } getenv = defaultEnv - credentials _ _ Any = putToken (TwoLegg (Application "no_ckey" "no_csec" OOB) R.empty)- credentials be _ App = ignite (application be)- credentials be c User = do { token_ <- liftIO (load (sessionMgr be))- ; reqUrl <- liftIO $ fmap (fromJust . R.parseURL) (tryUsrCfg "oauth_reqtoken_url" defReqUrl)- ; accUrl <- liftIO $ fmap (fromJust . R.parseURL) (tryUsrCfg "oauth_acctoken_url" defAccUrl)- ; case token_- of Nothing -> do { ignite (application be) - ; signRq2 PLAINTEXT Nothing reqUrl >>= oauthRequest c- ; cliAskAuthorization authUrl- ; signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest c- ; getToken >>= liftIO . save (sessionMgr be)- }- Just token- | threeLegged token -> do { putToken token- ; now <- liftIO getCurrentTime- ; offset <- liftIO $ fmap fromJust (mtime (sessionMgr be))- ; when (now >= expiration offset token) $- do { signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest c- ; getToken >>= liftIO . save (sessionMgr be)- }- }- | otherwise -> do { putToken token- ; signRq2 PLAINTEXT Nothing reqUrl >>= oauthRequest c- ; cliAskAuthorization authUrl- ; signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest c- ; getToken >>= liftIO . save (sessionMgr be)- }- }+ credentials _ Any = return ()+ credentials be App = ignite (application be)+ credentials be User = do { token_ <- liftIO (load (sessionMgr be))+ ; reqUrl <- liftIO $ fmap (fromJust . R.parseURL) (tryUsrCfg "oauth_reqtoken_url" defReqUrl)+ ; accUrl <- liftIO $ fmap (fromJust . R.parseURL) (tryUsrCfg "oauth_acctoken_url" defAccUrl)+ ; case token_+ of Nothing -> do { ignite (application be) + ; signRq2 PLAINTEXT Nothing reqUrl >>= oauthRequest CurlClient+ ; cliAskAuthorization authUrl+ ; signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest CurlClient+ ; getToken >>= liftIO . save (sessionMgr be)+ }+ Just token+ | threeLegged token -> do { putToken token+ ; now <- liftIO getCurrentTime+ ; offset <- liftIO $ fmap fromJust (mtime (sessionMgr be))+ ; when (now >= expiration offset token) $+ do { signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest CurlClient+ ; getToken >>= liftIO . save (sessionMgr be)+ }+ }+ | otherwise -> do { putToken token+ ; signRq2 PLAINTEXT Nothing reqUrl >>= oauthRequest CurlClient+ ; cliAskAuthorization authUrl+ ; signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest CurlClient+ ; getToken >>= liftIO . save (sessionMgr be)+ }+ } where defReqUrl = "https://api.login.yahoo.com/oauth/v2/get_request_token" defAccUrl = "https://api.login.yahoo.com/oauth/v2/get_token"
src/main/haskell/Yql/Data/Version.hs view
@@ -32,4 +32,4 @@ import Data.Version version :: Version-version = Version [0,0,6] ["alpha"]+version = Version [0,0,7] ["alpha"]
src/main/haskell/Yql/UI/CLI/Commands/Login.hs view
@@ -32,16 +32,17 @@ import Yql.Core.Types import Yql.UI.CLI.Command import Network.OAuth.Consumer-import Network.OAuth.Http.CurlHttpClient -- | Removes any saved oauth_token. login :: Yql y => y -> Command () login be = Command (const doc, exe) where doc = "Execute the oauth authorization flow to perform authenticated requests." - exe link _ = do { runOAuth handleE NoToken (credentials be CurlClient User)+ exe link _ = do { runOAuth handleE token (credentials be User) ; return () } where handleE err = case (lines err) of [] -> putStrLn $ link ++ ": error" (x:xs) -> putStrLn $ unlines ((link ++ ": " ++ x) : xs)+ + token = fromApplication (app be)
src/main/haskell/Yql/UI/Cli.hs view
@@ -29,7 +29,6 @@ import System import System.FilePath import System.Console.Haskeline-import Network.OAuth.Http.CurlHttpClient import Control.Monad.Trans import Yql.Data.Version import Yql.Data.Cfg (basedir)@@ -105,7 +104,7 @@ execYql :: Yql y => y -> String -> IO String execYql y input = case (parseYql input builder) of Left err -> return (show err)- Right stmt -> fmap (either id id) (unOutputT (execute y CurlClient funcDB stmt))+ Right stmt -> fmap (either id id) (unOutputT (execute y funcDB stmt)) execCmd :: (SessionMgr s,Yql y) => s -> y -> String -> InputT IO (Maybe y) execCmd s y input = case (parseCmd input)
src/main/haskell/iyql.hs view
@@ -38,8 +38,8 @@ config <- usrCfg iyql session (backend session config) where backend session config = YqlBackend (Application cfgCKey cfgCSec OOB) session (tryCfgs config "env" []) yqlEndpoint- where cfgCKey = tryCfg config "oauth_consumer_key" "<<no_ckey>>"- cfgCSec = tryCfg config "oauth_consumer_sec" "<<no_csec>>"+ where cfgCKey = tryCfg config "oauth_consumer_key" "iyql"+ cfgCSec = tryCfg config "oauth_consumer_sec" "" yqlEndpoint = let (host,port) = break (==':') (tryCfg config "endpoint" "query.yahooapis.com:80") in case port of [] -> (host,80)