Factor out readAndDecodeShelleyGenesis

IntersectMBO · Dec 24, 2021 · 24f63a0 · 24f63a0
1 parent add1b9d
commit 24f63a0
Showing 1 changed file with 25 additions and 6 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs
@@ -9,7 +9,9 @@
 
 module Cardano.CLI.Shelley.Run.Genesis
   ( ShelleyGenesisCmdError(..)
+  , ShelleyGenesisReadError(..)
   , readShelleyGenesis
+  , readAndDecodeShelleyGenesis
   , readAlonzoGenesis
   , renderShelleyGenesisCmdError
   , runGenesisCmd
@@ -97,8 +99,10 @@ data ShelleyGenesisCmdError
   | ShelleyGenesisCmdPoolCmdError !ShelleyPoolCmdError
   | ShelleyGenesisCmdStakeAddressCmdError !ShelleyStakeAddressCmdError
   | ShelleyGenesisCmdCostModelsError !FilePath
+  | ShelleyGenesisCmdReadError !ShelleyGenesisReadError
   deriving Show
 
+-- TODO: This should be an instance of Error
 renderShelleyGenesisCmdError :: ShelleyGenesisCmdError -> Text
 renderShelleyGenesisCmdError err =
   case err of
@@ -133,6 +137,7 @@ renderShelleyGenesisCmdError err =
     ShelleyGenesisCmdStakeAddressCmdError e -> renderShelleyStakeAddressCmdError e
     ShelleyGenesisCmdCostModelsError fp ->
       "Cost model is invalid: " <> Text.pack fp
+    ShelleyGenesisCmdReadError genReadError -> Text.pack $ displayError genReadError
 
 runGenesisCmd :: GenesisCmd -> ExceptT ShelleyGenesisCmdError IO ()
 runGenesisCmd (GenesisKeyGenGenesis vk sk) = runGenesisKeyGenGenesis vk sk
@@ -695,18 +700,13 @@ readShelleyGenesis
   -> (ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley)
   -> ExceptT ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
 readShelleyGenesis fpath adjustDefaults = do
-    readAndDecode
+    (firstExceptT ShelleyGenesisCmdReadError . newExceptT $ readAndDecodeShelleyGenesis fpath)
       `catchError` \err ->
         case err of
           ShelleyGenesisCmdGenesisFileError (FileIOError _ ioe)
             | isDoesNotExistError ioe -> writeDefault
           _                           -> left err
   where
-    readAndDecode = do
-      lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath
-      firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack)
-        . hoistEither $ Aeson.eitherDecode' lbs
-
     defaults :: ShelleyGenesis StandardShelley
     defaults = adjustDefaults shelleyGenesisDefaults
 
@@ -715,6 +715,25 @@ readShelleyGenesis fpath adjustDefaults = do
         LBS.writeFile fpath (encodePretty defaults)
       return defaults
 
+instance Error ShelleyGenesisReadError where
+  displayError (ShelleyGenesisReadError fe) = displayError fe
+  displayError (ShelleyGenesisDecodeError fp err) =
+    "Error while decoding Shelley genesis at: " <> fp <>
+    " Error: " <> Text.unpack err
+
+
+data ShelleyGenesisReadError = ShelleyGenesisReadError !(FileError IOException)
+                             | ShelleyGenesisDecodeError !FilePath !Text
+                             deriving Show
+
+readAndDecodeShelleyGenesis
+  :: FilePath
+  -> IO (Either ShelleyGenesisReadError (ShelleyGenesis StandardShelley))
+readAndDecodeShelleyGenesis fpath = runExceptT $ do
+  lbs <- handleIOExceptT (ShelleyGenesisReadError . FileIOError fpath) $ LBS.readFile fpath
+  firstExceptT (ShelleyGenesisDecodeError fpath . Text.pack)
+    . hoistEither $ Aeson.eitherDecode' lbs
+
 updateTemplate
     :: SystemStart
     -- Genesis delegation (not stake-based):