-- NIH Genomic Data Commons
{-# LANGUAGE OverloadedStrings #-}

module Bio.RealWorld.GDC
    (downloadData) where

import           Conduit
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import           Network.HTTP.Conduit

baseurl :: String
baseurl :: String
baseurl = String
"https://api.gdc.cancer.gov/"

-- | Download data
downloadData :: String    -- ^ UUID
             -> FilePath  -- ^ Output dir
             -> IO FilePath
downloadData :: String -> String -> IO String
downloadData String
uuid String
dir = do
     Request
request <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
     Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
     ResourceT IO String -> IO String
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO String -> IO String)
-> ResourceT IO String -> IO String
forall a b. (a -> b) -> a -> b
$ do
         Response (ConduitM () ByteString (ResourceT IO) ())
response <- Request
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
http Request
request Manager
manager
         let filename :: String
filename = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
T.breakOnEnd Text
"filename=" (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                ByteString -> String
B.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Content-Disposition" ([(HeaderName, ByteString)] -> Maybe ByteString)
-> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
                Response (ConduitM () ByteString (ResourceT IO) ())
-> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
response
         ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) () -> ResourceT IO ())
-> ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall body. Response body -> body
responseBody Response (ConduitM () ByteString (ResourceT IO) ())
response ConduitM () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| String -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
String -> ConduitT ByteString o m ()
sinkFileBS (String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
filename)
         String -> ResourceT IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filename
  where
    url :: String
url = String
baseurl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"data/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
uuid
{-# INLINE downloadData #-}