hercules-ci-api-core 0.1.5.1 → 0.1.6.0

raw patch · 9 files changed

+84/−15 lines, 9 filesdep +openapi3dep +servant-openapi3PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: openapi3, servant-openapi3

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• hercules-ci-api-core.cabal +4/−1
• src/Hercules/API/DayOfWeek.hs +3/−2
• src/Hercules/API/Id.hs +23/−1
• src/Hercules/API/Name.hs +13/−1
• src/Hercules/API/Prelude.hs +2/−0
• src/Hercules/API/Sensitive.hs +22/−0
• src/Hercules/API/Servant.hs +1/−1
• src/Hercules/Error.hs +9/−9

@@ -4,6 +4,13 @@  The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) +## [0.1.6.0] - 2024-02-12++### Added++- OpenAPI 3 support+- `newtype Sensitive`, a generic wrapper with a constant `Show` instance+ ## [0.1.5.1] - 2023-06-28  ### Added

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           hercules-ci-api-core-version:        0.1.5.1+version:        0.1.6.0 synopsis:       Types and convenience modules use across Hercules CI API packages category:       API, CI, Testing, DevOps, Nix homepage:       https://github.com/hercules-ci/hercules-ci-agent#readme@@ -24,6 +24,7 @@       Hercules.API.Id       Hercules.API.Name       Hercules.API.Prelude+      Hercules.API.Sensitive       Hercules.API.Servant       Hercules.Error   hs-source-dirs:@@ -47,7 +48,9 @@     , memory     , lifted-base     , monad-control+    , openapi3     , servant >=0.14.1+    , servant-openapi3     , servant-auth     , servant-auth-swagger     , servant-swagger

@@ -22,6 +22,7 @@ import Control.DeepSeq (NFData) import Data.Aeson (FromJSON, ToJSON) import Data.Maybe (fromJust)+import qualified Data.OpenApi as O3 import Data.Swagger (ToSchema) import qualified Data.Time import GHC.Generics (Generic)@@ -29,7 +30,7 @@  -- | Day of week representation used in the API. data DayOfWeek = Mon | Tue | Wed | Thu | Fri | Sat | Sun-  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema, O3.ToSchema)  -- | Conversion to @time@ package representation. toTime :: DayOfWeek -> Data.Time.DayOfWeek@@ -52,7 +53,7 @@ fromTime Data.Time.Sunday = Sun  -- | Conversion to integers where 'Mon' -> 1, 'Sun' -> 7-toNum :: Num n => DayOfWeek -> n+toNum :: (Num n) => DayOfWeek -> n toNum Mon = 1 toNum Tue = 2 toNum Wed = 3

@@ -1,3 +1,4 @@+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} @@ -14,6 +15,7 @@ import Data.Aeson.Types (toJSONKeyText) import Data.Function ((&)) import Data.Hashable (Hashable (..))+import qualified Data.OpenApi as O3 import Data.Swagger   ( NamedSchema (NamedSchema),     ParamSchema,@@ -25,6 +27,7 @@     type_,   ) import Data.Text (Text)+import Data.Typeable (Typeable) import Data.UUID (UUID) import qualified Data.UUID as UUID import GHC.Generics (Generic)@@ -32,7 +35,8 @@ import Prelude  newtype Id (a :: k) = Id {idUUID :: UUID}-  deriving (Generic, Eq, Ord, NFData)+  deriving (Generic, Eq, Ord, Typeable)+  deriving newtype (NFData)  instance Hashable (Id a) where   hashWithSalt s (Id uuid) =@@ -75,6 +79,8 @@ instance FromHttpApiData (Id a) where   parseUrlPiece = fmap Id . parseUrlPiece +-- Swagger 2+ instance ToSchema (Id a) where   declareNamedSchema = pure . NamedSchema Nothing . paramSchemaToSchema @@ -83,3 +89,19 @@     (mempty :: ParamSchema t)       & type_ ?~ SwaggerString       & format ?~ "uuid"++-- OpenAPI 3++instance forall k (a :: k). (Typeable a, Typeable k) => O3.ToSchema (Id a) where+  declareNamedSchema _ =+    pure $+      O3.NamedSchema (Just "Id") $+        mempty+          & O3.type_ ?~ O3.OpenApiString+          & O3.format ?~ "uuid"++instance O3.ToParamSchema (Id a) where+  toParamSchema _ =+    mempty+      & O3.type_ ?~ O3.OpenApiString+      & O3.format ?~ "uuid"

@@ -1,3 +1,4 @@+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} @@ -10,19 +11,22 @@ import Control.DeepSeq (NFData) import Data.Aeson import Data.Hashable (Hashable (..))+import qualified Data.OpenApi as O3 import Data.Proxy import Data.Swagger   ( ToParamSchema (..),     ToSchema (..),   ) import Data.Text (Text)+import Data.Typeable (Typeable) import GHC.Generics (Generic) import Web.HttpApiData import Prelude  -- | A slug. Display names are simply 'Text'. newtype Name (a :: k) = Name {nameText :: Text}-  deriving (Generic, Eq, Ord, NFData)+  deriving (Generic, Eq, Ord, Typeable)+  deriving newtype (NFData)  instance Hashable (Name a) @@ -54,3 +58,11 @@  invmap :: (a -> b) -> proxy a -> Proxy b invmap _ _ = Proxy++-- OpenAPI 3++instance forall k (a :: k). (Typeable a, Typeable k) => O3.ToSchema (Name a) where+  declareNamedSchema = O3.declareNamedSchema . invmap nameText++instance O3.ToParamSchema (Name a) where+  toParamSchema = O3.toParamSchema . invmap nameText

@@ -14,6 +14,7 @@      -- * Type classes     Generic,+    Typeable,     NFData (..),     ToJSON,     FromJSON,@@ -39,6 +40,7 @@ import Data.Swagger (ToSchema) import Data.Text (Text) import Data.Time (UTCTime)+import Data.Typeable (Typeable) import GHC.Generics (Generic) import Hercules.API.Id (Id) import Hercules.API.Name (Name)

@@ -0,0 +1,22 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Hercules.API.Sensitive where++import Data.Aeson (FromJSON, ToJSON)+import Data.Functor.Identity (Identity (Identity))+import GHC.Generics (Generic)+import Prelude++-- | newtype wrapper to avoid leaking sensitive data through 'Show'+newtype Sensitive a = Sensitive {reveal :: a}+  deriving (Generic)+  deriving newtype (Eq, Ord, Monoid, Semigroup, ToJSON, FromJSON)+  deriving (Functor, Applicative, Monad) via Identity++-- | @const "<sensitive>"@+instance Show (Sensitive a) where+  show _ = "<sensitive>"++revealContainer :: (Functor f) => Sensitive (f a) -> f (Sensitive a)+revealContainer (Sensitive fa) = Sensitive <$> fa

@@ -68,7 +68,7 @@ -- compiler that rightfully warns about throwing away a do notation -- result. By specialising, we make sure that we still get warnings -- if the result type changes in the future. (We'll get an error)-noContent :: Functor m => m Servant.API.NoContent -> m ()+noContent :: (Functor m) => m Servant.API.NoContent -> m () noContent = void  -- | A reference to the @subapi@ parameter in 'Substitute'

@@ -16,16 +16,16 @@ escalateAs :: (Exception exc, MonadThrow m) => (l -> exc) -> Either l a -> m a escalateAs f = either (throwM . f) pure -safeLiftedCatch :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a+safeLiftedCatch :: (MonadBaseControl IO m) => m a -> (SomeException -> m a) -> m a safeLiftedCatch m h =-  Control.Exception.Lifted.catch m $-    \e ->+  Control.Exception.Lifted.catch m+    $ \e ->       if Control.Exception.Safe.isSyncException (e :: SomeException)         then h e         else Control.Exception.Lifted.throw e  safeLiftedHandle ::-  MonadBaseControl IO m =>+  (MonadBaseControl IO m) =>   (SomeException -> m a) ->   m a ->   m a@@ -34,7 +34,7 @@ exponential :: (Enum a, Floating a) => [a] exponential = map exp [1, 2 ..] -cap :: Ord a => a -> [a] -> [a]+cap :: (Ord a) => a -> [a] -> [a] cap v = map (min v)  retry ::@@ -48,10 +48,10 @@     loop [] = io     loop (delay : delays) = safeLiftedCatch io $ \e -> do       logLocM WarningS $ "Retrying on exception: " <> logStr (show e)-      when (delay >= 0.000001) $-        liftIO $-          threadDelay-            (floor $ delay * 1000 * 1000)+      when (delay >= 0.000001)+        $ liftIO+        $ threadDelay+          (floor $ delay * 1000 * 1000)       loop delays  -- | ~5 minute exponential backoff