diff --git a/BlastHTTP.cabal b/BlastHTTP.cabal --- a/BlastHTTP.cabal +++ b/BlastHTTP.cabal @@ -1,13 +1,5 @@ --- Initial cmcv.cabal generated by cabal init. For further documentation, --- see http://haskell.org/cabal/users-guide/ name: BlastHTTP --- The package version. See the Haskell package versioning policy (PVP) --- for standards guiding when and how versions should be incremented. --- http://www.haskell.org/haskellwiki/Package_versioning_policy --- PVP summary: +-+------- breaking API changes --- | | +----- non-breaking API additions --- | | | +--- code changes with no API change -version: 1.2.1 +version: 1.3.0 synopsis: Libary to interface with the NCBI blast REST interface description: Searches for a provided nucleotide or protein sequence with the NCBI Blast REST service and returns a blast result in xml format as BlastResult datatype. . @@ -20,34 +12,27 @@ license-file: LICENSE author: Florian Eggenhofer maintainer: florian.eggenhofer@univie.ac.at --- copyright: +copyright: Florian Eggenhofer homepage: https://github.com/eggzilla/BlastHTTP category: Bioinformatics - build-type: Simple cabal-version: >=1.8 +Tested-With: GHC == 8.0.2, GHC == 8.2.2 extra-source-files: README.md changelog - + source-repository head type: git location: https://github.com/eggzilla/BlastHTTP source-repository this type: git - location: https://github.com/eggzilla/BlastHTTP/tree/1.2.1 - tag: 1.2.1 + location: https://github.com/eggzilla/BlastHTTP/tree/1.3.0 + tag: 1.3.0 library - -- Modules exported by the library. exposed-modules: Bio.BlastHTTP - - -- Modules included in this library but not exported. - -- other-modules: - - -- Other library packages from which modules are imported. - build-depends: base >=4.5 && <5, transformers, bytestring, conduit, HTTP, http-conduit, hxt, network, mtl, blastxml, biocore, biofasta - ghc-options: -Wall -O2 - -- Directories containing source files. + build-depends: base >=4.5 && <5, transformers, bytestring, conduit, HTTP, http-conduit, hxt, network, mtl, blastxml, biocore, biofasta, BiobaseBlast >=0.2.1.0, either-unwrap + ghc-options: -Wall hs-source-dirs: src diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,4 +1,8 @@ -*-change-log-*- +1.3.0 Florian Eggenhofer 12. March 2018 + * Added tabular format request use BiobaseBlast attoparsec parser + * Improved travis testing + * Compatibility with http-conduit-2.3.0 1.2.1 Florian Eggenhofer 12. November 2016 * Changed used NCBI URL to HTTPS 1.2.0 Florian Eggenhofer 20. April 2015 diff --git a/src/Bio/BlastHTTP.hs b/src/Bio/BlastHTTP.hs --- a/src/Bio/BlastHTTP.hs +++ b/src/Bio/BlastHTTP.hs @@ -2,7 +2,7 @@ -- | Searches a provided sequence with the NCBI Blast REST service and returns a blast result in xml format as BlastResult. -- --- The function blastHTTP takes the BlastHTTPQuery datatype as argument, which contains following elements: +-- The function blastHTTP takes the BlastHTTPQuery datatype as argument, which contains following elements: -- -- 1. program: Selects the blast-program to be used for the query. Example values are blastn, blastp, blastx,.. If Nothing is used as argument the function will default to blastn. Type: Maybe String -- @@ -18,13 +18,15 @@ -- -- If you plan to submit more than 20 searches in one session, please look up the Usage Guidelines in the webservice information . module Bio.BlastHTTP ( BlastHTTPQuery (..), - blastHTTP) where + blastHTTP, + blastTabularHTTP, + ) where -import Network.HTTP.Conduit -import qualified Data.ByteString.Lazy.Char8 as L8 +import Network.HTTP.Conduit +import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Char8 as B import qualified Control.Monad as CM -import Bio.BlastXML +import Bio.BlastXML import Text.XML.HXT.Core import Network import Data.List @@ -33,8 +35,12 @@ import Bio.Core.Sequence import Bio.Sequence.Fasta import Network.HTTP.Base +import Biobase.BLAST.Import +import Biobase.BLAST.Types +import qualified Data.Either.Unwrap as E +import Data.Int -data BlastHTTPQuery = BlastHTTPQuery +data BlastHTTPQuery = BlastHTTPQuery { provider :: Maybe String , program :: Maybe String , database :: Maybe String @@ -46,17 +52,17 @@ -- | Parse HTML results into Xml Tree datastructure parseHTML :: String -> IOStateArrow s0 b0 XmlTree -parseHTML = readString [withParseHTML yes, withWarnings no] +parseHTML = readString [withParseHTML yes, withWarnings no] -- | Gets all subtrees with the specified id attribute atId :: ArrowXml a => String -> a XmlTree XmlTree atId elementId = deep (isElem >>> hasAttrValue "id" (== elementId)) - --- | Send query and parse RID from retrieved HTML + +-- | Send query and parse RID from retrieved HTML startSession :: String -> String -> String -> String -> Maybe String -> IO String startSession provider' program' database' querySequences' optionalArguments' - | provider' == "ebi" = startSessionEBI program' database' querySequences' optionalArguments' - | otherwise = startSessionNCBI program' database' querySequences' optionalArguments' + | provider' == "ebi" = startSessionEBI program' database' querySequences' optionalArguments' + | otherwise = startSessionNCBI program' database' querySequences' optionalArguments' startSessionEBI :: String -> String -> String -> Maybe String -> IO String startSessionEBI program' database' querySequences' optionalArguments' = do @@ -78,7 +84,7 @@ putStrLn "Making HTTP request" res <- do --initReq <- parseUrl "http://postcatcher.in/catchers/541811052cb53502000001a7" - initReq <- parseUrl "http://www.ebi.ac.uk/Tools/services/rest/ncbiblast/run" + initReq <- parseUrlThrow "http://www.ebi.ac.uk/Tools/services/rest/ncbiblast/run" let req = (flip urlEncodedBody) initReq $ [ ("email", "florian.eggenhofer@univie.ac.at") , ("program", (B.pack program')) @@ -86,22 +92,22 @@ , ("stype", "dna") , ("sequence", (B.pack querySequences')) ] - withManager $ httpLbs req + newManager tlsManagerSettings >>= httpLbs req { method = "POST" } putStrLn "EBI Response" print res putStrLn "EBI Response Body" print (responseBody res) - return (responseBody res) + return (responseBody res) -- | Send query with or without optional arguments and return response HTML sendQueryNCBI :: String -> String -> String -> Maybe String -> IO L8.ByteString sendQueryNCBI program' database' querySequences' optionalArguments' | isJust optionalArguments' = simpleHttp ("https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?CMD=Put&PROGRAM=" ++ program' ++ "&DATABASE=" ++ database' ++ fromJust optionalArguments' ++ "&QUERY=" ++ querySequences') | otherwise = simpleHttp ("https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?CMD=Put&PROGRAM=" ++ program' ++ "&DATABASE=" ++ database' ++ "&QUERY=" ++ querySequences') - + -- | Retrieve session status with RID -retrieveSessionStatus :: String -> String -> IO String +retrieveSessionStatus :: String -> String -> IO String retrieveSessionStatus provider' rid = do if provider' == "ebi" then do @@ -113,8 +119,8 @@ statusXml <- withSocketsDo $ simpleHttp ("https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?CMD=Get&FORMAT_OBJECT=SearchInfo&RID=" ++ rid) let statusXMLString = L8.unpack statusXml return statusXMLString - --- | Retrieve result in blastxml format with RID + +-- | Retrieve result in blastxml format with RID retrieveResult :: String -> String -> IO (Either String BlastResult) retrieveResult provider' rid = do if provider' == "ebi" @@ -123,13 +129,30 @@ resultXML <- parseXML statusXml return (Right resultXML) else do - statusXml <- withSocketsDo $ simpleHttp ("https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?RESULTS_FILE=on&RID=" ++ rid ++ "&FORMAT_TYPE=XML&FORMAT_OBJECT=Alignment&CMD=Get") - resultXML <- parseXML statusXml - return (Right resultXML) - + resultResponse <- withSocketsDo $ simpleHttp ("http://www.ncbi.nlm.nih.gov/blast/Blast.cgi?RESULTS_FILE=on&RID=" ++ rid ++ "&FORMAT_TYPE=XML&FORMAT_OBJECT=Alignment&CMD=Get") + resultXML <- parseXML resultResponse + let rightXML = Right resultXML + return rightXML + +-- | Retrieve result in blast tabular format with RID +retrieveTabularResult :: String -> String -> IO (Either String [BlastTabularResult]) +retrieveTabularResult provider' rid = do + if provider' == "ebi" + then do + resultResponse <- withSocketsDo $ simpleHttp ("http://www.ebi.ac.uk/Tools/services/rest/ncbiblast/result/" ++ rid ++ "/Tabular") + let resultHeaderLessResponse = L8.drop (0 :: Int64) resultResponse + let resultTabular = parseTabularHTTPBlasts resultHeaderLessResponse + return (Right resultTabular) + else do + resultResponse <- withSocketsDo $ simpleHttp ("https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?RESULTS_FILE=on&RID=" ++ rid ++ "&FORMAT_TYPE=Tabular&FORMAT_OBJECT=Alignment&CMD=Get") + let resultHeaderLessResponse = L8.drop (60 :: Int64) resultResponse + let resultTabular = parseTabularHTTPBlasts resultHeaderLessResponse + return (Right resultTabular) + + -- | Check if job results are ready and then retrieves results -- If a walltime in microseconds was set query retrieval will termiate after it is consumed and return a Left result -checkSessionStatus :: String -> String -> Maybe Int -> Int -> IO (Either String BlastResult) +checkSessionStatus :: String -> String -> Maybe Int -> Int -> IO (Either String String) checkSessionStatus provider' rid walltime consumedTime = do threadDelay 120000000 status <- retrieveSessionStatus provider' rid @@ -138,20 +161,20 @@ waitOrRetrieve provider' status rid walltime consumedTime else do if (consumedTime < (fromJust walltime)) - then do + then do waitOrRetrieve provider' status rid walltime (consumedTime + 120000000) - else do + else do let exceptionMessage = "BLASTHTTP: Query did not return result within walltime" return (Left exceptionMessage) -waitOrRetrieve :: String -> String -> String -> Maybe Int -> Int -> IO (Either String BlastResult) +waitOrRetrieve :: String -> String -> String -> Maybe Int -> Int -> IO (Either String String) waitOrRetrieve provider' status rid walltime consumedTime | provider' == "ebi" = waitOrRetrieveEBI status rid walltime consumedTime | otherwise = waitOrRetrieveNCBI status rid walltime consumedTime -waitOrRetrieveEBI :: String -> String -> Maybe Int -> Int -> IO (Either String BlastResult) +waitOrRetrieveEBI :: String -> String -> Maybe Int -> Int -> IO (Either String String) waitOrRetrieveEBI status rid walltime consumedTime - | "FINISHED" `isInfixOf` status = retrieveResult "ebi" rid + | "FINISHED" `isInfixOf` status = return (Right rid) -- retrieveResult ouputFormat "ebi" rid | "FAILURE" `isInfixOf` status = do let exceptionMessage = "BLASTHTTP: The EBI blast job failed." return (Left exceptionMessage) @@ -164,9 +187,9 @@ -- RUNNING | otherwise = checkSessionStatus "ebi" rid walltime consumedTime -waitOrRetrieveNCBI :: String -> String -> Maybe Int -> Int -> IO (Either String BlastResult) +waitOrRetrieveNCBI :: String -> String -> Maybe Int -> Int -> IO (Either String String) waitOrRetrieveNCBI status rid walltime consumedTime - | "Status=READY" `isInfixOf` status = retrieveResult "ncbi" rid + | "Status=READY" `isInfixOf` status = return (Right rid) -- retrieveResult "ncbi" rid | "Status=FAILURE" `isInfixOf` status = do let exceptionMessage = "Search $rid failed; please report to blast-help at ncbi.nlm.nih.gov.\n" return (Left exceptionMessage) @@ -180,16 +203,19 @@ let exceptionMessage = "Status has unexpected value " ++ status ++ " - aborting blast search\n" return (Left exceptionMessage) --- | Sends Query and retrieves result on reaching READY status, will return exeption message if no query sequence has been provided -performQuery :: String -> String -> String -> [Sequence] -> Maybe String -> Maybe Int -> IO (Either String BlastResult) +-- | Sends Query and retrieves result on reaching READY status, will return exeption message if no query sequence has been provided +performQuery :: String -> String -> String -> [Sequence] -> Maybe String -> Maybe Int -> IO (Either String BlastResult) performQuery provider' program' database' querySequences' optionalArgumentMaybe walltime - | null querySequences' = do + | null querySequences' = do let exceptionMessage = "Error - no query sequence provided" return (Left exceptionMessage) | otherwise = do let sequenceString = urlEncode (concatMap showSequenceString querySequences') rid <- startSession provider' program' database' sequenceString optionalArgumentMaybe - checkSessionStatus provider' rid walltime (0 :: Int) + sessionStatus <- checkSessionStatus provider' rid walltime (0 :: Int) + if E.isRight sessionStatus + then retrieveResult provider' rid + else return (Left (E.fromLeft sessionStatus)) showSequenceString :: Sequence -> String showSequenceString fastaSequence = sequenceString @@ -204,13 +230,43 @@ blastHTTP (BlastHTTPQuery provider' program' database' querySequences' optionalArguments' walltime') = do let defaultProvider = "ncbi" let defaultProgram = "blastn" - let defaultDatabase = "refseq_genomic" + let defaultDatabase = "refseq_genomic" let defaultWalltime = Nothing let selectedProvider = fromMaybe defaultProvider provider' let selectedProgram = fromMaybe defaultProgram program' - let selectedDatabase = fromMaybe defaultDatabase database' + let selectedDatabase = fromMaybe defaultDatabase database' let selectedWalltime = maybe defaultWalltime Just walltime' --walltime of 1h in microseconds --let walltime = Just (7200000000 ::Int) performQuery selectedProvider selectedProgram selectedDatabase querySequences' optionalArguments' selectedWalltime +-- | Retrieve Blast results in Blast tabular format from the NCBI REST Blast interface +-- The querySequence has to be provided, all other parameters are optional and can be set to Nothing +-- optionalArguments is attached to the query as is .e.g: "&ALIGNMENTS=250" +blastTabularHTTP :: BlastHTTPQuery -> IO (Either String [BlastTabularResult]) +blastTabularHTTP (BlastHTTPQuery provider' program' database' querySequences' optionalArguments' walltime') = do + let defaultProvider = "ncbi" + let defaultProgram = "blastn" + let defaultDatabase = "refseq_genomic" + let defaultWalltime = Nothing + let selectedProvider = fromMaybe defaultProvider provider' + let selectedProgram = fromMaybe defaultProgram program' + let selectedDatabase = fromMaybe defaultDatabase database' + let selectedWalltime = maybe defaultWalltime Just walltime' + --walltime of 1h in microseconds + --let walltime = Just (7200000000 ::Int) + performTabularQuery selectedProvider selectedProgram selectedDatabase querySequences' optionalArguments' selectedWalltime + +-- | Sends Query and retrieves result on reaching READY status, will return exeption message if no query sequence has been provided +performTabularQuery :: String -> String -> String -> [Sequence] -> Maybe String -> Maybe Int -> IO (Either String [BlastTabularResult]) +performTabularQuery provider' program' database' querySequences' optionalArgumentMaybe walltime + | null querySequences' = do + let exceptionMessage = "Error - no query sequence provided" + return (Left exceptionMessage) + | otherwise = do + let sequenceString = urlEncode (concatMap showSequenceString querySequences') + rid <- startSession provider' program' database' sequenceString (Just (maybe "&FORMAT_TYPE=TABULAR" ("&FORMAT_TYPE=TABULAR" ++) optionalArgumentMaybe)) + sessionStatus <- checkSessionStatus provider' rid walltime (0 :: Int) + if E.isRight sessionStatus + then retrieveTabularResult provider' rid + else return (Left (E.fromLeft sessionStatus))