diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 9a1964e039a..7bdc91a9618 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -63,6 +63,7 @@ library Cardano.Wallet.Api.Types Cardano.Wallet.DB Cardano.Wallet.DB.MVar + Cardano.Environment Cardano.Wallet.Network Cardano.Wallet.Primitive.AddressDerivation Cardano.Wallet.Primitive.AddressDiscovery @@ -130,6 +131,7 @@ test-suite unit Cardano.Wallet.ApiSpec Cardano.Wallet.DB.MVarSpec Cardano.Wallet.DBSpec + Cardano.EnvironmentSpec Cardano.Wallet.NetworkSpec Cardano.Wallet.Primitive.AddressDerivationSpec Cardano.Wallet.Primitive.AddressDiscoverySpec diff --git a/lib/core/src/Cardano/Environment.hs b/lib/core/src/Cardano/Environment.hs new file mode 100644 index 00000000000..4629973a122 --- /dev/null +++ b/lib/core/src/Cardano/Environment.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} + +-- | Helpers for reading ENV vars using 'unsafePerformIO' with readable error +-- messages. +-- +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +module Cardano.Environment + ( + ErrMissingOrInvalidEnvVar(..) + , unsafeLookupEnv + ) where + +import Prelude + +import Control.Exception + ( Exception (..), throwIO ) +import Data.Text + ( Text ) +import Data.Text.Class + ( FromText (..), TextDecodingError (..) ) +import Fmt + ( Buildable (..), nameF, padLeftF, pretty ) +import System.Environment + ( getProgName, lookupEnv ) +import System.IO.Unsafe + ( unsafePerformIO ) + +import qualified Data.Text as T + + +-- | Fatal exception thrown when a required ENV var is missing upon start-up. +data ErrMissingOrInvalidEnvVar = ErrMissingOrInvalidEnvVar + { name :: String + , command :: String + , additionalContext :: Maybe (String, TextDecodingError) + } + +instance Show ErrMissingOrInvalidEnvVar where + show = displayException + +-- | Produces a nice terminal output so that the error is very readable. +-- +-- @ +-- $ NETWORK=patate cardano-wallet-launcher +-- Starting... +-- cardano-wallet-launcher: Missing or invalid ENV var: +-- +-- ENV[NETWORK] = patate +-- | +-- | +-- *--> patate is neither "mainnet", "testnet" nor "staging" +-- +-- @ +-- +-- @ +-- $ cardano-wallet-launcher +-- Starting... +-- cardano-wallet-launcher: Missing or invalid ENV var: +-- +-- ENV[NETWORK] = ? +-- +-- What about trying to provide a valid ENV var `NETWORK=value cardano-wallet-launcher` ? +-- @ +instance Exception ErrMissingOrInvalidEnvVar where + displayException (ErrMissingOrInvalidEnvVar n cmd ctx) = pretty $ mempty + <> nameF "Missing or invalid ENV var" + ( "\n ENV[" <> build n <> "] = " <> ctxF ) + where + ctxF = case ctx of + Nothing -> "?" + <> "\n\nWhat about trying to provide a valid ENV var " + <> "`" <> build n <> "=value " <> build cmd <> "` ?" + Just (v, err) -> + let + pad = length n + (length v `div` 2) + 11 + in + build v + <> "\n " <> padLeftF @Text pad ' ' "| " + <> "\n " <> padLeftF @Text pad ' ' "| " + <> "\n " <> padLeftF @Text pad ' ' "*--> " + <> build err + +-- | Lookup the environment for a given variable +unsafeLookupEnv + :: FromText a + => String + -> a +unsafeLookupEnv k = unsafePerformIO $ do + cmd <- getProgName + v <- lookupEnv k >>= \case + Just v -> return v + Nothing -> throwIO $ ErrMissingOrInvalidEnvVar + { name = k + , command = cmd + , additionalContext = Nothing + } + case fromText (T.pack v) of + Right a -> return a + Left err -> throwIO $ ErrMissingOrInvalidEnvVar + { name = k + , command = cmd + , additionalContext = Just (v, err) + } diff --git a/lib/core/test/unit/Cardano/EnvironmentSpec.hs b/lib/core/test/unit/Cardano/EnvironmentSpec.hs new file mode 100644 index 00000000000..eba1e3ecd30 --- /dev/null +++ b/lib/core/test/unit/Cardano/EnvironmentSpec.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.EnvironmentSpec + ( spec + ) where + +import Prelude + +import Cardano.Environment + ( ErrMissingOrInvalidEnvVar (..), unsafeLookupEnv ) +import Data.Maybe + ( isNothing ) +import Data.Text.Class + ( FromText (..), TextDecodingError (..), ToText (..) ) +import GHC.Generics + ( Generic ) +import System.Environment + ( setEnv, unsetEnv ) +import Test.Hspec + ( Spec, describe, it, shouldThrow ) +import Test.QuickCheck + ( Arbitrary (..) ) +import Test.QuickCheck.Arbitrary.Generic + ( genericArbitrary, genericShrink ) + +import qualified Data.Text as T + +spec :: Spec +spec = do + describe "ErrMissingOrInvalidEnvVar (Show / displayException)" $ do + let errNoAdditionalContext = ErrMissingOrInvalidEnvVar + { name = "PATATE" + , command = "my-command" + , additionalContext = Nothing + } + let errWithAdditionalContext = ErrMissingOrInvalidEnvVar + { name = "PATATE" + , command = "my-command" + , additionalContext = Just + ("💩" + , TextDecodingError + { getTextDecodingError = "not a valid value" } + ) + } + it (show errNoAdditionalContext) True + it (show errWithAdditionalContext) True + + describe "unsafeLookupEnv" $ do + it "throws with no context when variable isn't present" $ do + unsetEnv "PATATE" -- Just in case + let io = + unsafeLookupEnv @Network "PATATE" `seq` (return ()) + let selector (ErrMissingOrInvalidEnvVar n _ c) = + n == "PATATE" && isNothing c + io `shouldThrow` selector + + it "throws with extra context when variable is present but invalid" $ do + setEnv "PATATE" "not-a-network" + let ctx = + ( "not-a-network" + , TextDecodingError "not-a-network is neither \"mainnet\",\ + \ \"testnet\" nor \"staging\"." + ) + let selector (ErrMissingOrInvalidEnvVar n _ c) = + n == "PATATE" && c == Just ctx + let io = + unsafeLookupEnv @Network "PATATE" `seq` (return ()) + io `shouldThrow` selector + +{------------------------------------------------------------------------------- + Types +-------------------------------------------------------------------------------} + +data Network = Mainnet | Testnet | Staging + deriving Generic + +instance Arbitrary Network where + arbitrary = genericArbitrary + shrink = genericShrink + +instance FromText Network where + fromText = \case + "mainnet" -> Right Mainnet + "testnet" -> Right Testnet + "staging" -> Right Staging + s -> Left $ TextDecodingError $ T.unpack s + <> " is neither \"mainnet\", \"testnet\" nor \"staging\"." + +instance ToText Network where + toText = \case + Mainnet -> "mainnet" + Testnet -> "testnet" + Staging -> "staging" diff --git a/lib/http-bridge/cardano-wallet-http-bridge.cabal b/lib/http-bridge/cardano-wallet-http-bridge.cabal index 016cd40d908..99ccfcfff12 100644 --- a/lib/http-bridge/cardano-wallet-http-bridge.cabal +++ b/lib/http-bridge/cardano-wallet-http-bridge.cabal @@ -42,7 +42,6 @@ library , cryptonite , digest , exceptions - , fmt , http-api-data , http-client , http-media diff --git a/lib/http-bridge/src/Cardano/Environment/HttpBridge.hs b/lib/http-bridge/src/Cardano/Environment/HttpBridge.hs index fd44b734f76..cf97b93ace7 100644 --- a/lib/http-bridge/src/Cardano/Environment/HttpBridge.hs +++ b/lib/http-bridge/src/Cardano/Environment/HttpBridge.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeApplications #-} -- | -- Copyright: © 2018-2019 IOHK @@ -23,112 +22,21 @@ module Cardano.Environment.HttpBridge , network , ProtocolMagic(..) , protocolMagic - - -- * Internals - , ErrMissingOrInvalidEnvVar(..) - , unsafeLookupEnv ) where import Prelude -import Control.Exception - ( Exception (..), throwIO ) +import Cardano.Environment + ( unsafeLookupEnv ) import Data.Int ( Int32 ) -import Data.Text - ( Text ) import Data.Text.Class ( FromText (..), TextDecodingError (..), ToText (..) ) -import Fmt - ( Buildable (..), nameF, padLeftF, pretty ) import GHC.Generics ( Generic ) -import System.Environment - ( getProgName, lookupEnv ) -import System.IO.Unsafe - ( unsafePerformIO ) import qualified Data.Text as T - --- | Fatal exception thrown when a required ENV var is missing upon start-up. -data ErrMissingOrInvalidEnvVar = ErrMissingOrInvalidEnvVar - { name :: String - , command :: String - , additionalContext :: Maybe (String, TextDecodingError) - } - -instance Show ErrMissingOrInvalidEnvVar where - show = displayException - --- | Produces a nice terminal output so that the error is very readable. --- --- @ --- $ NETWORK=patate cardano-wallet-launcher --- Starting... --- cardano-wallet-launcher: Missing or invalid ENV var: --- --- ENV[NETWORK] = patate --- | --- | --- *--> patate is neither "mainnet", "testnet" nor "staging" --- --- @ --- --- @ --- $ cardano-wallet-launcher --- Starting... --- cardano-wallet-launcher: Missing or invalid ENV var: --- --- ENV[NETWORK] = ? --- --- What about trying to provide a valid ENV var `NETWORK=value cardano-wallet-launcher` ? --- @ -instance Exception ErrMissingOrInvalidEnvVar where - displayException (ErrMissingOrInvalidEnvVar n cmd ctx) = pretty $ mempty - <> nameF "Missing or invalid ENV var" - ( "\n ENV[" <> build n <> "] = " <> ctxF ) - where - ctxF = case ctx of - Nothing -> "?" - <> "\n\nWhat about trying to provide a valid ENV var " - <> "`" <> build n <> "=value " <> build cmd <> "` ?" - Just (v, err) -> - let - pad = length n + (length v `div` 2) + 11 - in - build v - <> "\n " <> padLeftF @Text pad ' ' "| " - <> "\n " <> padLeftF @Text pad ' ' "| " - <> "\n " <> padLeftF @Text pad ' ' "*--> " - <> build err - --- | Lookup the environment for a given variable -unsafeLookupEnv - :: FromText a - => String - -> a -unsafeLookupEnv k = unsafePerformIO $ do - cmd <- getProgName - v <- lookupEnv k >>= \case - Just v -> return v - Nothing -> throwIO $ ErrMissingOrInvalidEnvVar - { name = k - , command = cmd - , additionalContext = Nothing - } - case fromText (T.pack v) of - Right a -> return a - Left err -> throwIO $ ErrMissingOrInvalidEnvVar - { name = k - , command = cmd - , additionalContext = Just (v, err) - } - -{------------------------------------------------------------------------------- - Environment --------------------------------------------------------------------------------} - -- | Available network options. data Network = Mainnet | Testnet | Staging deriving (Generic, Show, Eq, Enum) diff --git a/lib/http-bridge/test/unit/Cardano/Environment/HttpBridgeSpec.hs b/lib/http-bridge/test/unit/Cardano/Environment/HttpBridgeSpec.hs index d4f30e72689..053ef97b5e4 100644 --- a/lib/http-bridge/test/unit/Cardano/Environment/HttpBridgeSpec.hs +++ b/lib/http-bridge/test/unit/Cardano/Environment/HttpBridgeSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -8,17 +7,11 @@ module Cardano.Environment.HttpBridgeSpec where import Prelude import Cardano.Environment.HttpBridge - ( ErrMissingOrInvalidEnvVar (..), Network, unsafeLookupEnv ) -import Data.Maybe - ( isNothing ) + ( Network ) import Data.Proxy ( Proxy (..) ) -import Data.Text.Class - ( TextDecodingError (..) ) -import System.Environment - ( setEnv, unsetEnv ) import Test.Hspec - ( Spec, describe, it, shouldThrow ) + ( Spec, describe ) import Test.QuickCheck ( Arbitrary (..) ) import Test.QuickCheck.Arbitrary.Generic @@ -31,46 +24,6 @@ spec = do describe "Can perform roundtrip textual encoding & decoding" $ do textRoundtrip $ Proxy @Network - describe "ErrMissingOrInvalidEnvVar (Show / displayException)" $ do - let errNoAdditionalContext = ErrMissingOrInvalidEnvVar - { name = "PATATE" - , command = "my-command" - , additionalContext = Nothing - } - let errWithAdditionalContext = ErrMissingOrInvalidEnvVar - { name = "PATATE" - , command = "my-command" - , additionalContext = Just - ("💩" - , TextDecodingError - { getTextDecodingError = "not a valid value" } - ) - } - it (show errNoAdditionalContext) True - it (show errWithAdditionalContext) True - - describe "unsafeLookupEnv" $ do - it "throws with no context when variable isn't present" $ do - unsetEnv "PATATE" -- Just in case - let io = - unsafeLookupEnv @Network "PATATE" `seq` (return ()) - let selector (ErrMissingOrInvalidEnvVar n _ c) = - n == "PATATE" && isNothing c - io `shouldThrow` selector - - it "throws with extra context when variable is present but invalid" $ do - setEnv "PATATE" "not-a-network" - let ctx = - ( "not-a-network" - , TextDecodingError "not-a-network is neither \"mainnet\",\ - \ \"testnet\" nor \"staging\"." - ) - let selector (ErrMissingOrInvalidEnvVar n _ c) = - n == "PATATE" && c == Just ctx - let io = - unsafeLookupEnv @Network "PATATE" `seq` (return ()) - io `shouldThrow` selector - {------------------------------------------------------------------------------- Arbitrary Instances -------------------------------------------------------------------------------} diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index 5e3f2b46077..e8f0e7e6df2 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/lib/jormungandr/cardano-wallet-jormungandr.cabal @@ -34,7 +34,6 @@ library build-depends: base , cardano-wallet-core - , fmt -- , binary -- , bytestring -- , cardano-crypto @@ -78,4 +77,5 @@ test-suite unit Main.hs other-modules: Cardano.Wallet.Binary.JormungandrSpec + Cardano.Environment.JormungandrSpec Spec diff --git a/lib/jormungandr/src/Cardano/Environment/Jormungandr.hs b/lib/jormungandr/src/Cardano/Environment/Jormungandr.hs index 3e227d05ef8..1b8c846f65f 100644 --- a/lib/jormungandr/src/Cardano/Environment/Jormungandr.hs +++ b/lib/jormungandr/src/Cardano/Environment/Jormungandr.hs @@ -1,7 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeApplications #-} - -- | -- Copyright: © 2018-2019 IOHK -- License: MIT @@ -23,112 +21,21 @@ module Cardano.Environment.Jormungandr , network , ProtocolMagic(..) , protocolMagic - - -- * Internals - , ErrMissingOrInvalidEnvVar(..) - , unsafeLookupEnv ) where import Prelude -import Control.Exception - ( Exception (..), throwIO ) +import Cardano.Environment + ( unsafeLookupEnv ) import Data.Int ( Int32 ) -import Data.Text - ( Text ) import Data.Text.Class ( FromText (..), TextDecodingError (..), ToText (..) ) -import Fmt - ( Buildable (..), nameF, padLeftF, pretty ) import GHC.Generics ( Generic ) -import System.Environment - ( getProgName, lookupEnv ) -import System.IO.Unsafe - ( unsafePerformIO ) import qualified Data.Text as T - --- | Fatal exception thrown when a required ENV var is missing upon start-up. -data ErrMissingOrInvalidEnvVar = ErrMissingOrInvalidEnvVar - { name :: String - , command :: String - , additionalContext :: Maybe (String, TextDecodingError) - } - -instance Show ErrMissingOrInvalidEnvVar where - show = displayException - --- | Produces a nice terminal output so that the error is very readable. --- --- @ --- $ NETWORK=patate cardano-wallet-launcher --- Starting... --- cardano-wallet-launcher: Missing or invalid ENV var: --- --- ENV[NETWORK] = patate --- | --- | --- *--> patate is neither "mainnet", "testnet" nor "staging" --- --- @ --- --- @ --- $ cardano-wallet-launcher --- Starting... --- cardano-wallet-launcher: Missing or invalid ENV var: --- --- ENV[NETWORK] = ? --- --- What about trying to provide a valid ENV var `NETWORK=value cardano-wallet-launcher` ? --- @ -instance Exception ErrMissingOrInvalidEnvVar where - displayException (ErrMissingOrInvalidEnvVar n cmd ctx) = pretty $ mempty - <> nameF "Missing or invalid ENV var" - ( "\n ENV[" <> build n <> "] = " <> ctxF ) - where - ctxF = case ctx of - Nothing -> "?" - <> "\n\nWhat about trying to provide a valid ENV var " - <> "`" <> build n <> "=value " <> build cmd <> "` ?" - Just (v, err) -> - let - pad = length n + (length v `div` 2) + 11 - in - build v - <> "\n " <> padLeftF @Text pad ' ' "| " - <> "\n " <> padLeftF @Text pad ' ' "| " - <> "\n " <> padLeftF @Text pad ' ' "*--> " - <> build err - --- | Lookup the environment for a given variable -unsafeLookupEnv - :: FromText a - => String - -> a -unsafeLookupEnv k = unsafePerformIO $ do - cmd <- getProgName - v <- lookupEnv k >>= \case - Just v -> return v - Nothing -> throwIO $ ErrMissingOrInvalidEnvVar - { name = k - , command = cmd - , additionalContext = Nothing - } - case fromText (T.pack v) of - Right a -> return a - Left err -> throwIO $ ErrMissingOrInvalidEnvVar - { name = k - , command = cmd - , additionalContext = Just (v, err) - } - -{------------------------------------------------------------------------------- - Environment --------------------------------------------------------------------------------} - -- | Available network options. data Network = Mainnet | Testnet deriving (Generic, Show, Eq, Enum) diff --git a/lib/jormungandr/test/unit/Cardano/Environment/JormungandrSpec.hs b/lib/jormungandr/test/unit/Cardano/Environment/JormungandrSpec.hs new file mode 100644 index 00000000000..56ae4d87f1c --- /dev/null +++ b/lib/jormungandr/test/unit/Cardano/Environment/JormungandrSpec.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Environment.JormungandrSpec where + +import Prelude + +import Cardano.Environment.Jormungandr + ( Network ) +import Data.Proxy + ( Proxy (..) ) +import Test.Hspec + ( Spec, describe ) +import Test.QuickCheck + ( Arbitrary (..) ) +import Test.QuickCheck.Arbitrary.Generic + ( genericArbitrary, genericShrink ) +import Test.Text.Roundtrip + ( textRoundtrip ) + +spec :: Spec +spec = do + describe "Can perform roundtrip textual encoding & decoding" $ do + textRoundtrip $ Proxy @Network + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +instance Arbitrary Network where + arbitrary = genericArbitrary + shrink = genericShrink