diff --git a/app/Main.hs b/app/Main.hs index e07bda381ed0b08c5ec090a0ade5f7d4d2cf3f49..7566395756a8cb30c3bc988210d27736a457d84a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,10 @@ module Main where import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Lazy as BL import qualified Data.Map.Strict as Map -import Data.Text +import qualified Data.Text as T import Data.Yaml (FromJSON (parseJSON), Value (Object), decodeEither', (.:)) import System.Environment (getArgs) import Tahoe.Announcement (StorageServerAnnouncement, StorageServerID) @@ -16,18 +18,18 @@ main = do -- Load server announcements announcementsBytes <- B.readFile announcementPath let Right (Announcements announcements) = decodeEither' announcementsBytes - print ("Your announcements:" :: Data.Text.Text) - print announcements + -- print ("Your announcements:" :: Data.Text.Text) + -- print announcements -- Accept & parse read capability - let Right (CHKReader cap) = parse pCapability "<argv>" (Data.Text.pack readCap) + let Right (CHKReader cap) = parse pCapability "<argv>" (T.pack readCap) -- Download & decode the shares result <- download announcements cap announcementToStorageServer -- Show the result - print ("Your result:" :: Data.Text.Text) - print result + putStrLn "Your result:" + either print (C8.putStrLn . BL.toStrict) result newtype Announcements = Announcements (Map.Map StorageServerID StorageServerAnnouncement) diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal index ba99ccdc3dd3591b308ad13ea25c1c38a816af35..a12f83034b52495858f7d2b2a41d17c39358c657 100644 --- a/gbs-downloader.cabal +++ b/gbs-downloader.cabal @@ -90,6 +90,7 @@ library , aeson , base ^>=4.14.3.0 , base32 + , base64 , binary , bytestring , connection diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs index f853b41272c400cf886a186f103f78cf9863b0c5..b4fb3c92fd1b7e081252d189c4a377285b66c7f1 100644 --- a/src/Tahoe/Download.hs +++ b/src/Tahoe/Download.hs @@ -18,14 +18,16 @@ import Control.Exception (throwIO) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Binary (decodeOrFail) import Data.ByteString.Base32 (encodeBase32Unpadded) +import Data.ByteString.Base64 (encodeBase64) import qualified Data.ByteString.Lazy as LB import Data.Either (isRight, partitionEithers) import Data.List (foldl') import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) import Network.Connection (TLSSettings (TLSSettingsSimple)) -import Network.HTTP.Client (Manager, ManagerSettings) +import Network.HTTP.Client (Manager, ManagerSettings (managerModifyRequest), Request (requestHeaders)) import Network.HTTP.Client.TLS (mkManagerSettings, newTlsManagerWith) import Network.URI (URI (..), URIAuth (..)) import Servant.Client (Scheme (Https), mkClientEnv, runClientM) @@ -246,11 +248,19 @@ https host port = } managerSettingsForService :: T.Text -> T.Text -> ManagerSettings -managerSettingsForService _ _ = - mkManagerSettings tlsSettings sockSettings +managerSettingsForService _ swissnum = + (mkManagerSettings tlsSettings sockSettings){managerModifyRequest = pure . authorize} where tlsSettings = TLSSettingsSimple True True True sockSettings = Nothing + authorize req = + req + { requestHeaders = + ( "Authorization" + , encodeUtf8 $ T.concat ["Tahoe-LAFS ", encodeBase64 . encodeUtf8 $ swissnum] + ) : + requestHeaders req + } newGBSManager :: MonadIO m =>