From c277a5956fb2bbeefc18def1ad57bad522508a77 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Wed, 3 May 2023 15:10:26 -0400
Subject: [PATCH] Successfully recover the contents of CHK
---
app/Main.hs | 14 ++++++++------
gbs-downloader.cabal | 1 +
src/Tahoe/Download.hs | 16 +++++++++++++---
3 files changed, 22 insertions(+), 9 deletions(-)
diff --git a/app/Main.hs b/app/Main.hs
index e07bda3..7566395 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 ba99ccd..a12f830 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 f853b41..b4fb3c9 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 =>
--
GitLab