{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Run.Hash
  ( runHashCmds
  , getByteStringFromURL
  , SupportedSchemas (..)
  , allSchemas
  , httpsAndIpfsSchemas
  )
where

import           Cardano.Api
import qualified Cardano.Api.Ledger as L

import           Cardano.CLI.Commands.Hash (HashGoal (..))
import qualified Cardano.CLI.Commands.Hash as Cmd
import           Cardano.CLI.Read
import           Cardano.CLI.Types.Errors.HashCmdError
import           Cardano.Crypto.Hash (hashToTextAsHex)

import           Control.Exception (throw)
import           Control.Monad.Catch (Exception, Handler (Handler))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSL8
import           Data.Char (toLower)
import           Data.Function
import           Data.List (intercalate)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.IO as Text
import           Network.HTTP.Client (Response (..), httpLbs, newManager, requestFromURI)
import           Network.HTTP.Client.TLS (tlsManagerSettings)
import           Network.HTTP.Types (Status (statusCode), statusMessage)
import           Network.URI (URI (..), URIAuth (..), parseAbsoluteURI, pathSegments)
import qualified System.Environment as IO
import           System.FilePath ((</>))
import           System.FilePath.Posix (isDrive)

runHashCmds
  :: ()
  => Cmd.HashCmds
  -> ExceptT HashCmdError IO ()
runHashCmds :: HashCmds -> ExceptT HashCmdError IO ()
runHashCmds = \case
  Cmd.HashAnchorDataCmd HashAnchorDataCmdArgs
args -> HashAnchorDataCmdArgs -> ExceptT HashCmdError IO ()
runHashAnchorDataCmd HashAnchorDataCmdArgs
args
  Cmd.HashScriptCmd HashScriptCmdArgs
args -> HashScriptCmdArgs -> ExceptT HashCmdError IO ()
runHashScriptCmd HashScriptCmdArgs
args

runHashAnchorDataCmd
  :: ()
  => Cmd.HashAnchorDataCmdArgs
  -> ExceptT HashCmdError IO ()
runHashAnchorDataCmd :: HashAnchorDataCmdArgs -> ExceptT HashCmdError IO ()
runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{AnchorDataHashSource
toHash :: AnchorDataHashSource
toHash :: HashAnchorDataCmdArgs -> AnchorDataHashSource
toHash, HashGoal (SafeHash StandardCrypto AnchorData)
hashGoal :: HashGoal (SafeHash StandardCrypto AnchorData)
hashGoal :: HashAnchorDataCmdArgs
-> HashGoal (SafeHash StandardCrypto AnchorData)
hashGoal} = do
  AnchorData
anchorData <-
    ByteString -> AnchorData
L.AnchorData (ByteString -> AnchorData)
-> ExceptT HashCmdError IO ByteString
-> ExceptT HashCmdError IO AnchorData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case AnchorDataHashSource
toHash of
      Cmd.AnchorDataHashSourceBinaryFile File ProposalBinary 'In
fp -> do
        let path :: [Char]
path = File ProposalBinary 'In -> [Char]
forall content (direction :: FileDirection).
File content direction -> [Char]
unFile File ProposalBinary 'In
fp
        (IOException -> HashCmdError)
-> IO ByteString -> ExceptT HashCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT ([Char] -> IOException -> HashCmdError
HashReadFileError [Char]
path) (IO ByteString -> ExceptT HashCmdError IO ByteString)
-> IO ByteString -> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile [Char]
path
      Cmd.AnchorDataHashSourceTextFile File ProposalText 'In
fp -> do
        let path :: [Char]
path = File ProposalText 'In -> [Char]
forall content (direction :: FileDirection).
File content direction -> [Char]
unFile File ProposalText 'In
fp
        Text
text <- (IOException -> HashCmdError)
-> IO Text -> ExceptT HashCmdError IO Text
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT ([Char] -> IOException -> HashCmdError
HashReadFileError [Char]
path) (IO Text -> ExceptT HashCmdError IO Text)
-> IO Text -> ExceptT HashCmdError IO Text
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Text
Text.readFile [Char]
path
        ByteString -> ExceptT HashCmdError IO ByteString
forall a. a -> ExceptT HashCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT HashCmdError IO ByteString)
-> ByteString -> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
text
      Cmd.AnchorDataHashSourceText Text
text -> ByteString -> ExceptT HashCmdError IO ByteString
forall a. a -> ExceptT HashCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT HashCmdError IO ByteString)
-> ByteString -> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
text
      Cmd.AnchorDataHashSourceURL Url
urlText ->
        ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
fetchURLToHashCmdError (ExceptT FetchURLError IO ByteString
 -> ExceptT HashCmdError IO ByteString)
-> ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ [SupportedSchemas] -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL [SupportedSchemas]
allSchemas (Text -> ExceptT FetchURLError IO ByteString)
-> Text -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ Url -> Text
L.urlToText Url
urlText
  let hash :: SafeHash StandardCrypto AnchorData
hash = AnchorData -> SafeHash StandardCrypto AnchorData
forall c. Crypto c => AnchorData -> SafeHash c AnchorData
L.hashAnchorData AnchorData
anchorData
  case HashGoal (SafeHash StandardCrypto AnchorData)
hashGoal of
    CheckHash SafeHash StandardCrypto AnchorData
expectedHash
      | SafeHash StandardCrypto AnchorData
hash SafeHash StandardCrypto AnchorData
-> SafeHash StandardCrypto AnchorData -> Bool
forall a. Eq a => a -> a -> Bool
/= SafeHash StandardCrypto AnchorData
expectedHash ->
          HashCmdError -> ExceptT HashCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (HashCmdError -> ExceptT HashCmdError IO ())
-> HashCmdError -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SafeHash StandardCrypto AnchorData
-> SafeHash StandardCrypto AnchorData -> HashCmdError
HashMismatchedHashError SafeHash StandardCrypto AnchorData
expectedHash SafeHash StandardCrypto AnchorData
hash
      | Bool
otherwise -> do
          IO () -> ExceptT HashCmdError IO ()
forall a. IO a -> ExceptT HashCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT HashCmdError IO ())
-> IO () -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Hashes match!"
    HashToFile File () 'Out
outFile -> Maybe (File () 'Out)
-> SafeHash StandardCrypto AnchorData -> ExceptT HashCmdError IO ()
forall i.
Maybe (File () 'Out)
-> SafeHash StandardCrypto i -> ExceptT HashCmdError IO ()
writeHash (File () 'Out -> Maybe (File () 'Out)
forall a. a -> Maybe a
Just File () 'Out
outFile) SafeHash StandardCrypto AnchorData
hash
    HashGoal (SafeHash StandardCrypto AnchorData)
HashToStdout -> Maybe (File () 'Out)
-> SafeHash StandardCrypto AnchorData -> ExceptT HashCmdError IO ()
forall i.
Maybe (File () 'Out)
-> SafeHash StandardCrypto i -> ExceptT HashCmdError IO ()
writeHash Maybe (File () 'Out)
forall a. Maybe a
Nothing SafeHash StandardCrypto AnchorData
hash
 where
  writeHash :: Maybe (File () Out) -> L.SafeHash L.StandardCrypto i -> ExceptT HashCmdError IO ()
  writeHash :: forall i.
Maybe (File () 'Out)
-> SafeHash StandardCrypto i -> ExceptT HashCmdError IO ()
writeHash Maybe (File () 'Out)
mOutFile SafeHash StandardCrypto i
hash = do
    (FileError () -> HashCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> HashCmdError
HashWriteFileError (ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
        Maybe (File () 'Out) -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out) -> Text -> m (Either (FileError e) ())
writeTextOutput Maybe (File () 'Out)
mOutFile Text
text
   where
    text :: Text
text = Hash Blake2b_256 i -> Text
forall h a. Hash h a -> Text
hashToTextAsHex (Hash Blake2b_256 i -> Text)
-> (SafeHash StandardCrypto i -> Hash Blake2b_256 i)
-> SafeHash StandardCrypto i
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash StandardCrypto i -> Hash Blake2b_256 i
SafeHash StandardCrypto i -> Hash (HASH StandardCrypto) i
forall c i. SafeHash c i -> Hash (HASH c) i
L.extractHash (SafeHash StandardCrypto i -> Text)
-> SafeHash StandardCrypto i -> Text
forall a b. (a -> b) -> a -> b
$ SafeHash StandardCrypto i
hash

  fetchURLToHashCmdError
    :: ExceptT FetchURLError IO BS8.ByteString -> ExceptT HashCmdError IO BS8.ByteString
  fetchURLToHashCmdError :: ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
fetchURLToHashCmdError = (FetchURLError -> HashCmdError)
-> ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT FetchURLError -> HashCmdError
HashFetchURLError

data SupportedSchemas = FileSchema | HttpSchema | HttpsSchema | IpfsSchema
  deriving (Int -> SupportedSchemas -> ShowS
[SupportedSchemas] -> ShowS
SupportedSchemas -> [Char]
(Int -> SupportedSchemas -> ShowS)
-> (SupportedSchemas -> [Char])
-> ([SupportedSchemas] -> ShowS)
-> Show SupportedSchemas
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SupportedSchemas -> ShowS
showsPrec :: Int -> SupportedSchemas -> ShowS
$cshow :: SupportedSchemas -> [Char]
show :: SupportedSchemas -> [Char]
$cshowList :: [SupportedSchemas] -> ShowS
showList :: [SupportedSchemas] -> ShowS
Show, SupportedSchemas -> SupportedSchemas -> Bool
(SupportedSchemas -> SupportedSchemas -> Bool)
-> (SupportedSchemas -> SupportedSchemas -> Bool)
-> Eq SupportedSchemas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SupportedSchemas -> SupportedSchemas -> Bool
== :: SupportedSchemas -> SupportedSchemas -> Bool
$c/= :: SupportedSchemas -> SupportedSchemas -> Bool
/= :: SupportedSchemas -> SupportedSchemas -> Bool
Eq)

allSchemas :: [SupportedSchemas]
allSchemas :: [SupportedSchemas]
allSchemas = [SupportedSchemas
FileSchema, SupportedSchemas
HttpSchema, SupportedSchemas
HttpsSchema, SupportedSchemas
IpfsSchema]

httpsAndIpfsSchemas :: [SupportedSchemas]
httpsAndIpfsSchemas :: [SupportedSchemas]
httpsAndIpfsSchemas = [SupportedSchemas
HttpsSchema, SupportedSchemas
IpfsSchema]

getByteStringFromURL :: [SupportedSchemas] -> Text -> ExceptT FetchURLError IO BS.ByteString
getByteStringFromURL :: [SupportedSchemas] -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL [SupportedSchemas]
supportedSchemas Text
urlText = do
  let urlString :: [Char]
urlString = Text -> [Char]
Text.unpack Text
urlText
  URI
uri <- FetchURLError -> Maybe URI -> ExceptT FetchURLError IO URI
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe ([Char] -> FetchURLError
FetchURLInvalidURLError [Char]
urlString) (Maybe URI -> ExceptT FetchURLError IO URI)
-> Maybe URI -> ExceptT FetchURLError IO URI
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URI
parseAbsoluteURI [Char]
urlString
  case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
uriScheme URI
uri of
    [Char]
"file:"
      | SupportedSchemas
FileSchema SupportedSchemas -> [SupportedSchemas] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SupportedSchemas]
supportedSchemas ->
          let path :: [Char]
path = [[Char]] -> [Char]
uriPathToFilePath (URI -> [[Char]]
pathSegments URI
uri)
           in (IOException -> FetchURLError)
-> IO ByteString -> ExceptT FetchURLError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT ([Char] -> IOException -> FetchURLError
FetchURLReadFileError [Char]
path) (IO ByteString -> ExceptT FetchURLError IO ByteString)
-> IO ByteString -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile [Char]
path
    [Char]
"http:" | SupportedSchemas
HttpSchema SupportedSchemas -> [SupportedSchemas] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SupportedSchemas]
supportedSchemas -> URI -> ExceptT FetchURLError IO ByteString
getFileFromHttp URI
uri
    [Char]
"https:" | SupportedSchemas
HttpsSchema SupportedSchemas -> [SupportedSchemas] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SupportedSchemas]
supportedSchemas -> URI -> ExceptT FetchURLError IO ByteString
getFileFromHttp URI
uri
    [Char]
"ipfs:" | SupportedSchemas
IpfsSchema SupportedSchemas -> [SupportedSchemas] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SupportedSchemas]
supportedSchemas -> do
      URI
httpUri <- URI -> ExceptT FetchURLError IO URI
convertToHttp URI
uri
      URI -> ExceptT FetchURLError IO ByteString
getFileFromHttp URI
httpUri
    [Char]
unsupportedScheme -> FetchURLError -> ExceptT FetchURLError IO ByteString
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (FetchURLError -> ExceptT FetchURLError IO ByteString)
-> FetchURLError -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> FetchURLError
FetchURLUnsupportedURLSchemeError [Char]
unsupportedScheme
 where
  uriPathToFilePath :: [String] -> FilePath
  uriPathToFilePath :: [[Char]] -> [Char]
uriPathToFilePath allPath :: [[Char]]
allPath@([Char]
letter : [[Char]]
path) =
    if [Char] -> Bool
isDrive [Char]
letter
      then ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Char] -> ShowS
(</>) [Char]
letter [[Char]]
path
      else ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Char] -> ShowS
(</>) [Char]
"/" [[Char]]
allPath
  uriPathToFilePath [] = [Char]
"/"

  getFileFromHttp :: URI -> ExceptT FetchURLError IO BS.ByteString
  getFileFromHttp :: URI -> ExceptT FetchURLError IO ByteString
getFileFromHttp URI
uri = [Handler IO FetchURLError]
-> IO ByteString -> ExceptT FetchURLError IO ByteString
forall (f :: * -> *) (m :: * -> *) x a.
(Foldable f, MonadCatch m) =>
f (Handler m x) -> m a -> ExceptT x m a
handlesExceptT [Handler IO FetchURLError]
handlers (IO ByteString -> ExceptT FetchURLError IO ByteString)
-> IO ByteString -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO ByteString
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
    Request
request <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
requestFromURI URI
uri
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
    let status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response
    if Status -> Int
statusCode Status
status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
200
      then
        HttpRequestError -> IO ByteString
forall a e. Exception e => e -> a
throw (HttpRequestError -> IO ByteString)
-> HttpRequestError -> IO ByteString
forall a b. (a -> b) -> a -> b
$
          Int -> [Char] -> HttpRequestError
BadStatusCodeHRE
            (Status -> Int
statusCode Status
status)
            (ByteString -> [Char]
BS8.unpack (Status -> ByteString
statusMessage Status
status) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BSL8.unpack (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response))
      else ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response

  handlers :: [Handler IO FetchURLError]
  handlers :: [Handler IO FetchURLError]
handlers =
    [ (HttpRequestError -> HttpRequestError) -> Handler IO FetchURLError
forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> HttpRequestError) -> Handler m FetchURLError
mkHandler HttpRequestError -> HttpRequestError
forall a. a -> a
id
    , (HttpException -> HttpRequestError) -> Handler IO FetchURLError
forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> HttpRequestError) -> Handler m FetchURLError
mkHandler HttpException -> HttpRequestError
HttpExceptionHRE
    , (IOException -> HttpRequestError) -> Handler IO FetchURLError
forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> HttpRequestError) -> Handler m FetchURLError
mkHandler IOException -> HttpRequestError
IOExceptionHRE
    ]
   where
    mkHandler :: (Monad m, Exception e) => (e -> HttpRequestError) -> Handler m FetchURLError
    mkHandler :: forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> HttpRequestError) -> Handler m FetchURLError
mkHandler e -> HttpRequestError
x = (e -> m FetchURLError) -> Handler m FetchURLError
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((e -> m FetchURLError) -> Handler m FetchURLError)
-> (e -> m FetchURLError) -> Handler m FetchURLError
forall a b. (a -> b) -> a -> b
$ FetchURLError -> m FetchURLError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FetchURLError -> m FetchURLError)
-> (e -> FetchURLError) -> e -> m FetchURLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpRequestError -> FetchURLError
FetchURLGetFileFromHttpError (HttpRequestError -> FetchURLError)
-> (e -> HttpRequestError) -> e -> FetchURLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> HttpRequestError
x

  convertToHttp :: URI -> ExceptT FetchURLError IO URI
  convertToHttp :: URI -> ExceptT FetchURLError IO URI
convertToHttp URI
ipfsUri = do
    Maybe [Char]
mIpfsGatewayUriString <- (IOException -> FetchURLError)
-> IO (Maybe [Char]) -> ExceptT FetchURLError IO (Maybe [Char])
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT IOException -> FetchURLError
FetchURLReadEnvVarError (IO (Maybe [Char]) -> ExceptT FetchURLError IO (Maybe [Char]))
-> IO (Maybe [Char]) -> ExceptT FetchURLError IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
"IPFS_GATEWAY_URI"
    [Char]
ipfsGatewayUriString <- FetchURLError -> Maybe [Char] -> ExceptT FetchURLError IO [Char]
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe FetchURLError
FetchURLIpfsGatewayNotSetError Maybe [Char]
mIpfsGatewayUriString
    URI
ipfsGatewayUri <-
      FetchURLError -> Maybe URI -> ExceptT FetchURLError IO URI
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe ([Char] -> FetchURLError
FetchURLInvalidURLError [Char]
ipfsGatewayUriString) (Maybe URI -> ExceptT FetchURLError IO URI)
-> Maybe URI -> ExceptT FetchURLError IO URI
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URI
parseAbsoluteURI [Char]
ipfsGatewayUriString
    URI -> ExceptT FetchURLError IO URI
forall a. a -> ExceptT FetchURLError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> ExceptT FetchURLError IO URI)
-> URI -> ExceptT FetchURLError IO URI
forall a b. (a -> b) -> a -> b
$
      URI
ipfsGatewayUri
        { uriPath =
            '/'
              : intercalate
                "/"
                ( pathSegments ipfsGatewayUri
                    ++ ["ipfs"]
                    ++ maybe [] (\URIAuth
ipfsAuthority -> [URIAuth -> [Char]
uriRegName URIAuth
ipfsAuthority]) (uriAuthority ipfsUri)
                    ++ pathSegments ipfsUri
                )
        }

runHashScriptCmd
  :: ()
  => Cmd.HashScriptCmdArgs
  -> ExceptT HashCmdError IO ()
runHashScriptCmd :: HashScriptCmdArgs -> ExceptT HashCmdError IO ()
runHashScriptCmd Cmd.HashScriptCmdArgs{toHash :: HashScriptCmdArgs -> ScriptFile
Cmd.toHash = File [Char]
toHash, Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: HashScriptCmdArgs -> Maybe (File () 'Out)
mOutFile} = do
  ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <-
    [Char] -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
[Char] -> t m ScriptInAnyLang
readFileScriptInAnyLang [Char]
toHash
      ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
    -> ExceptT HashCmdError IO ScriptInAnyLang)
-> ExceptT HashCmdError IO ScriptInAnyLang
forall a b. a -> (a -> b) -> b
& (FileError ScriptDecodeError -> HashCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT HashCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ([Char] -> FileError ScriptDecodeError -> HashCmdError
HashReadScriptError [Char]
toHash)
  (FileError () -> HashCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> HashCmdError
HashWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ())
-> (ScriptHash -> ExceptT (FileError ()) IO ())
-> ScriptHash
-> ExceptT HashCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> (ScriptHash -> IO (Either (FileError ()) ()))
-> ScriptHash
-> ExceptT (FileError ()) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (File () 'Out) -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out) -> Text -> m (Either (FileError e) ())
writeTextOutput Maybe (File () 'Out)
mOutFile
    (Text -> IO (Either (FileError ()) ()))
-> (ScriptHash -> Text)
-> ScriptHash
-> IO (Either (FileError ()) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText
    (ScriptHash -> ExceptT HashCmdError IO ())
-> ScriptHash -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script