{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

#if !defined(mingw32_HOST_OS)
#define UNIX
#endif

-- | Internal utils for the other Api modules
--
module Cardano.Api.Utils
  ( (?!)
  , (?!.)
  , formatParsecError
  , failEither
  , failEitherWith
  , noInlineMaybeToStrictMaybe
  , note
  , parseFilePath
  , readFileBlocking
  , renderEra
  , runParsecParser
  , textShow
  , writeSecrets

    -- ** CLI option parsing
  , bounded
  ) where

import           Control.Exception (bracket)
import           Control.Monad (forM_, when)
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as LBS
import           Data.Maybe.Strict
import           Data.Text (Text)
import qualified Data.Text as Text
import           GHC.IO.Handle.FD (openFileBlocking)
import qualified Options.Applicative as Opt
import           System.FilePath ((</>))
import           System.IO (IOMode (ReadMode), hClose)
import qualified Text.Parsec as Parsec
import qualified Text.Parsec.String as Parsec
import qualified Text.ParserCombinators.Parsec.Error as Parsec
import           Text.Printf (printf)
#ifdef UNIX
import           System.Posix.Files (ownerReadMode, setFileMode)
#else
import           System.Directory (emptyPermissions, readable, setPermissions)
#endif

import           Cardano.Api.Eras
import           Options.Applicative (ReadM)
import           Options.Applicative.Builder (eitherReader)
import qualified Text.Read as Read

(?!) :: Maybe a -> e -> Either e a
Maybe a
Nothing ?! :: forall a e. Maybe a -> e -> Either e a
?! e
e = forall a b. a -> Either a b
Left e
e
Just a
x  ?! e
_ = forall a b. b -> Either a b
Right a
x

(?!.) :: Either e a -> (e -> e') -> Either e' a
Left  e
e ?!. :: forall e a e'. Either e a -> (e -> e') -> Either e' a
?!. e -> e'
f = forall a b. a -> Either a b
Left (e -> e'
f e
e)
Right a
x ?!. e -> e'
_ = forall a b. b -> Either a b
Right a
x

{-# NOINLINE noInlineMaybeToStrictMaybe #-}
noInlineMaybeToStrictMaybe :: Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe :: forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe a
Nothing = forall a. StrictMaybe a
SNothing
noInlineMaybeToStrictMaybe (Just a
x) = forall a. a -> StrictMaybe a
SJust a
x

formatParsecError :: Parsec.ParseError -> String
formatParsecError :: ParseError -> FilePath
formatParsecError ParseError
err =
  FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> [Message]
-> FilePath
Parsec.showErrorMessages FilePath
"or" FilePath
"unknown parse error"
    FilePath
"expecting" FilePath
"unexpected" FilePath
"end of input"
    forall a b. (a -> b) -> a -> b
$ ParseError -> [Message]
Parsec.errorMessages ParseError
err

runParsecParser :: Parsec.Parser a -> Text -> Aeson.Parser a
runParsecParser :: forall a. Parser a -> Text -> Parser a
runParsecParser Parser a
parser Text
input =
  case forall s t a.
Stream s Identity t =>
Parsec s () a -> FilePath -> s -> Either ParseError a
Parsec.parse (Parser a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof) FilePath
"" (Text -> FilePath
Text.unpack Text
input) of
    Right a
txin -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
txin
    Left ParseError
parseError -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
formatParsecError ParseError
parseError

failEither :: MonadFail m => Either String a -> m a
failEither :: forall (m :: * -> *) a. MonadFail m => Either FilePath a -> m a
failEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure

failEitherWith :: MonadFail m => (e -> String) -> Either e a -> m a
failEitherWith :: forall (m :: * -> *) e a.
MonadFail m =>
(e -> FilePath) -> Either e a -> m a
failEitherWith e -> FilePath
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FilePath
f) forall (f :: * -> *) a. Applicative f => a -> f a
pure

note :: MonadFail m => String -> Maybe a -> m a
note :: forall (m :: * -> *) a. MonadFail m => FilePath -> Maybe a -> m a
note FilePath
msg = \case
  Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
msg
  Just a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

parseFilePath :: String -> String -> Opt.Parser FilePath
parseFilePath :: FilePath -> FilePath -> Parser FilePath
parseFilePath FilePath
optname FilePath
desc =
  forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
    ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
optname
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"FILEPATH"
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
desc
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (FilePath -> Completer
Opt.bashCompleter FilePath
"file")
    )

writeSecrets :: FilePath -> [Char] -> [Char] -> (a -> BS.ByteString) -> [a] -> IO ()
writeSecrets :: forall a.
FilePath
-> FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
writeSecrets FilePath
outDir FilePath
prefix FilePath
suffix a -> ByteString
secretOp [a]
xs =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [Int
0::Int ..]) forall a b. (a -> b) -> a -> b
$
  \(a
secret, Int
nr)-> do
    let filename :: FilePath
filename = FilePath
outDir FilePath -> FilePath -> FilePath
</> FilePath
prefix forall a. Semigroup a => a -> a -> a
<> FilePath
"." forall a. Semigroup a => a -> a -> a
<> forall r. PrintfType r => FilePath -> r
printf FilePath
"%03d" Int
nr forall a. Semigroup a => a -> a -> a
<> FilePath
"." forall a. Semigroup a => a -> a -> a
<> FilePath
suffix
    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
filename forall a b. (a -> b) -> a -> b
$ a -> ByteString
secretOp a
secret
#ifdef UNIX
    FilePath -> FileMode -> IO ()
setFileMode    FilePath
filename FileMode
ownerReadMode
#else
    setPermissions filename (emptyPermissions {readable = True})
#endif

readFileBlocking :: FilePath -> IO BS.ByteString
readFileBlocking :: FilePath -> IO ByteString
readFileBlocking FilePath
path = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
  (FilePath -> IOMode -> IO Handle
openFileBlocking FilePath
path IOMode
ReadMode)
  Handle -> IO ()
hClose
  (\Handle
fp -> do
    -- An arbitrary block size.
    let blockSize :: Int
blockSize = Int
4096
    let go :: Builder -> IO Builder
go Builder
acc = do
          ByteString
next <- Handle -> Int -> IO ByteString
BS.hGet Handle
fp Int
blockSize
          if ByteString -> Bool
BS.null ByteString
next
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
acc
          else Builder -> IO Builder
go (Builder
acc forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
next)
    Builder
contents <- Builder -> IO Builder
go forall a. Monoid a => a
mempty
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString Builder
contents)

textShow :: Show a => a -> Text
textShow :: forall a. Show a => a -> Text
textShow = FilePath -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show

renderEra :: AnyCardanoEra -> Text
renderEra :: AnyCardanoEra -> Text
renderEra (AnyCardanoEra CardanoEra era
ByronEra)   = Text
"Byron"
renderEra (AnyCardanoEra CardanoEra era
ShelleyEra) = Text
"Shelley"
renderEra (AnyCardanoEra CardanoEra era
AllegraEra) = Text
"Allegra"
renderEra (AnyCardanoEra CardanoEra era
MaryEra)    = Text
"Mary"
renderEra (AnyCardanoEra CardanoEra era
AlonzoEra)  = Text
"Alonzo"
renderEra (AnyCardanoEra CardanoEra era
BabbageEra) = Text
"Babbage"
renderEra (AnyCardanoEra CardanoEra era
ConwayEra)  = Text
"Conway"

bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded :: forall a. (Bounded a, Integral a, Show a) => FilePath -> ReadM a
bounded FilePath
t = forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ \FilePath
s -> do
  Integer
i <- forall a. Read a => FilePath -> Either FilePath a
Read.readEither @Integer FilePath
s
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @a)) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath
t forall a. Semigroup a => a -> a -> a
<> FilePath
" must not be less than " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show (forall a. Bounded a => a
minBound @a)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @a)) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath
t forall a. Semigroup a => a -> a -> a
<> FilePath
" must not greater than " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show (forall a. Bounded a => a
maxBound @a)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)