diff --git a/app/Main.hs b/app/Main.hs index 157e0186750e0a957a19e66e419fb7cc993c332d..95edf3fc786f0447f00f74ec3fa092977dfd7542 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,6 @@ module Main where +import Control.Monad.Except (runExceptT) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as BL @@ -22,7 +23,7 @@ main = do let Right (CHKReader cap) = parse pCapability "<argv>" (T.pack readCap) -- Download & decode the shares - result <- download announcements cap announcementToImmutableStorageServer + result <- runExceptT $ download announcements cap announcementToImmutableStorageServer -- Show the result putStrLn "Your result:" diff --git a/download-sdmf/Main.hs b/download-sdmf/Main.hs index a42c2f1771e854a5e6e87c1932b633e875cc84cb..b6e3f8be284e1d8e6eb369c49464b911fa33a995 100644 --- a/download-sdmf/Main.hs +++ b/download-sdmf/Main.hs @@ -2,38 +2,41 @@ module Main where -import Control.Monad.Except (runExceptT) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as C8 -import qualified Data.ByteString.Lazy as BL +import Control.Monad.Except (ExceptT (ExceptT), MonadTrans (lift), runExceptT, withExceptT) +import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Text as T -import Data.Yaml (decodeEither') +import Data.Yaml (decodeFileEither) import System.Environment (getArgs) import Tahoe.Announcement (Announcements (..)) import Tahoe.Download (announcementToMutableStorageServer, download) -import Tahoe.SDMF (SDMF (..), pCapability, writerReader) +import Tahoe.SDMF (Reader, SDMF (..), pCapability, writerReader) import Text.Megaparsec (parse) +newtype Failed = Failed String + +instance Show Failed where + show (Failed s) = s + main :: IO () -main = do - [announcementPath, readCap] <- getArgs - -- Load server announcements - announcementsBytes <- B.readFile announcementPath - let Right (Announcements announcements) = decodeEither' announcementsBytes - - -- Accept & parse read capability - case parse pCapability "<argv>" (T.pack readCap) of - Left e -> print $ "Failed to parse cap: " <> show e - Right (SDMFVerifier _) -> C8.putStrLn "Nothing currently implemented for verifier caps." - Right (SDMFWriter rwcap) -> go announcements (writerReader rwcap) - Right (SDMFReader rocap) -> go announcements rocap +main = + either (putStrLn . ("Failed: " <>) . show) (BL.putStrLn . BL.append "Your result: ") + =<< ( runExceptT $ + do + [announcementPath, readCap] <- lift getArgs + -- Parse read capability + cap <- mightFail "Failed to parse capability: " . pure . parse pCapability "<argv>" . T.pack $ readCap + + -- Load server announcements + announcements <- mightFail "Failed to parse announcements: " $ decodeFileEither announcementPath + + case cap of + (SDMFVerifier _) -> ExceptT . pure . Left . Failed $ "Nothing implemented for verifier capabilities." + (SDMFWriter rwcap) -> go announcements (writerReader rwcap) + (SDMFReader rocap) -> go announcements rocap + ) where - go announcements cap = do - -- Download & decode the shares - result <- runExceptT $ download announcements cap announcementToMutableStorageServer - - -- Show the result - liftIO $ do - putStrLn "Your result:" - either print (C8.putStrLn . BL.toStrict) result + go :: Announcements -> Reader -> ExceptT Failed IO BL.ByteString + go (Announcements announcements) cap = withExceptT (Failed . ("Failed download: " <>) . show) $ download announcements cap announcementToMutableStorageServer + +mightFail :: (Functor m, Show a1) => String -> m (Either a1 a2) -> ExceptT Failed m a2 +mightFail s = withExceptT (Failed . (s <>) . show) . ExceptT diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal index edf629c4085b567f991ac16046da784005efa6fc..eebb17bc3965347a402a3961b909d77894c4a55c 100644 --- a/gbs-downloader.cabal +++ b/gbs-downloader.cabal @@ -158,6 +158,7 @@ executable download-chk , containers >=0.6.0.1 && <0.7 , gbs-downloader , megaparsec >=8.0 && <9.3 + , mtl >=2.2.2 && <2.4 , tahoe-chk >=0.2 && <0.3 , text >=1.2.3.1 && <1.3 , yaml >=0.11.5.0 && <0.11.9.0 || >=0.11.9.0.0 && <0.12 @@ -202,6 +203,7 @@ executable list-dircap , containers >=0.6.0.1 && <0.7 , gbs-downloader , megaparsec >=8.0 && <9.3 + , mtl >=2.2.2 && <2.4 , tahoe-chk >=0.2 && <0.3 , tahoe-directory >=0.1 && <0.2 , tahoe-ssk >=0.3 && <0.4 diff --git a/list-dircap/Main.hs b/list-dircap/Main.hs index c0adc747c73d34ba882233bf596f445a44d37074..a050462180c8b45e49f4c8a084fc3cb5563b1a88 100644 --- a/list-dircap/Main.hs +++ b/list-dircap/Main.hs @@ -10,6 +10,7 @@ import Tahoe.Announcement (Announcements (..)) import qualified Tahoe.Directory as TD import Text.Megaparsec (parse) +import Control.Monad.Except (runExceptT) import Tahoe.Download (announcementToImmutableStorageServer, announcementToMutableStorageServer, downloadDirectory) main :: IO () @@ -30,7 +31,7 @@ main = do where go announcements cap lookupServer = do -- Download & decode the shares - result <- downloadDirectory announcements cap lookupServer + result <- runExceptT $ downloadDirectory announcements cap lookupServer -- Show the result putStrLn "Your result:"