-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
36 changed files
with
612 additions
and
314 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -2,3 +2,5 @@ cradle: | |
| stack: | ||
| - path: "./src" | ||
| component: "auth-service-core:lib" | ||
| - path: "./openApi" | ||
| component: "api-definition" | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,14 @@ | ||
| {-# LANGUAGE LambdaCase #-} | ||
|
|
||
| module Main where | ||
|
|
||
| import AuthService.OpenAPI | ||
| import System.Environment | ||
| import System.Exit | ||
| import System.IO | ||
|
|
||
| main :: IO () | ||
| main = do | ||
| getArgs >>= \case | ||
| [ path ] -> writeDefinition path | ||
| _ -> hPutStrLn stderr "Missing argument: filepath" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,15 @@ | ||
| module AuthService.OpenAPI where | ||
|
|
||
| import qualified AuthService.Api as API | ||
|
|
||
| import qualified Data.Aeson as Aeson | ||
| import qualified Data.ByteString.Lazy as BSL | ||
| import Data.Data ( Proxy(..) ) | ||
|
|
||
| import Servant.OpenApi | ||
|
|
||
| apiDefinition :: BSL.ByteString | ||
| apiDefinition = Aeson.encode $ toOpenApi (Proxy :: Proxy API.Api) | ||
|
|
||
| writeDefinition :: FilePath -> IO () | ||
| writeDefinition path = BSL.writeFile path apiDefinition |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,83 @@ | ||
| {-# language DerivingVia #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE UndecidableInstances #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE NamedFieldPuns #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE AllowAmbiguousTypes#-} | ||
|
|
||
| -- Generator for OpenAPI schemata | ||
|
|
||
| module AuthService.OpenAPI.Schema where | ||
|
|
||
| import qualified Data.Aeson as Aeson | ||
| import qualified Data.Char as Char | ||
| import Data.Data (Typeable, Proxy(..)) | ||
| import GHC.Generics | ||
| import qualified Data.OpenApi.Internal.Schema as OpenApi | ||
| import qualified Data.OpenApi.ParamSchema as OpenApi | ||
|
|
||
| import Helpers (dropPrefix) | ||
| import Data.Aeson (camelTo2) | ||
|
|
||
| -- Wrapper for `deriving via` | ||
| newtype JSONStruct a = JSONStruct a deriving Show | ||
|
|
||
| fieldLabelModifier :: forall a m f. (Generic a, Datatype m | ||
| , Rep a ~ M1 D m f) | ||
| => String -> String | ||
| fieldLabelModifier = | ||
| let (n, ns) = case datatypeName @m undefined of | ||
| (c : cs) -> (c, cs) | ||
| _ -> error "Empty datatypeName" | ||
| in camelTo2 '_' . dropPrefix (Char.toLower n : ns) | ||
|
|
||
| -- This *requires* TypeApplications to be called, the `a` type parameter needs | ||
| -- to be passed explicitly | ||
| options | ||
| :: forall a m f. (Generic a, Datatype m | ||
| , Rep a ~ M1 D m f) | ||
| => Aeson.Options | ||
| options = | ||
| Aeson.defaultOptions {Aeson.fieldLabelModifier = fieldLabelModifier @a } | ||
|
|
||
|
|
||
| instance (Generic a | ||
| , Aeson.GToJSON' Aeson.Value Aeson.Zero f | ||
| , Aeson.GToJSON' Aeson.Encoding Aeson.Zero f | ||
| , Datatype m, Rep a ~ M1 D m f) => Aeson.ToJSON (JSONStruct a) where | ||
|
|
||
|
|
||
| toJSON (JSONStruct x) = Aeson.genericToJSON (options @a) x | ||
| toEncoding (JSONStruct x) = Aeson.genericToEncoding (options @a) x | ||
|
|
||
|
|
||
| instance (Generic a, Aeson.GFromJSON Aeson.Zero (Rep a) | ||
| , Datatype m, Rep a ~ M1 D m f | ||
| ) => Aeson.FromJSON (JSONStruct a) where | ||
| parseJSON x = JSONStruct <$> Aeson.genericParseJSON (options @a) x | ||
|
|
||
| schemaOptions | ||
| :: forall a m f. (Generic a, Datatype m | ||
| , Rep a ~ M1 D m f) | ||
| => OpenApi.SchemaOptions | ||
| schemaOptions = | ||
| let (n, ns) = case datatypeName @m undefined of | ||
| (c : cs) -> (c, cs) | ||
| _ -> error "Empty datatypeName" | ||
| fieldLabelModifier = dropPrefix (Char.toLower n : ns) | ||
| in OpenApi.defaultSchemaOptions {OpenApi.fieldLabelModifier } | ||
|
|
||
| instance (Generic a, Typeable a | ||
| , Datatype m, Rep a ~ M1 D m f | ||
| , OpenApi.GToSchema (Rep a) | ||
| ) | ||
| => OpenApi.ToSchema (JSONStruct a) where | ||
|
|
||
| declareNamedSchema _ = OpenApi.genericDeclareNamedSchema options (Proxy @a) | ||
| where | ||
| options = OpenApi.defaultSchemaOptions { OpenApi.fieldLabelModifier | ||
| = fieldLabelModifier @a | ||
| } |
Oops, something went wrong.