From afbb0886d6d3ba40c0d07bc22b7e7227fd196ea7 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Mon, 18 Mar 2024 14:24:13 +0100 Subject: [PATCH] Incremental updates --- .gitlab-ci.yml | 5 +- Dockerfile.build | 4 +- Makefile | 8 +- README.md | 2 - SAML.md | 5 +- auth-service-core/Makefile | 14 +- auth-service-core/auth-service-core.cabal | 16 +- auth-service-core/hie.yaml | 2 + auth-service-core/openApi/Main.hs | 14 + auth-service-core/src/AuthService/Api.hs | 7 +- auth-service-core/src/AuthService/OpenAPI.hs | 15 + .../src/AuthService/OpenAPI/Schema.hs | 83 ++++ .../src/AuthService/SignedHeaders.hs | 25 +- auth-service-core/src/AuthService/Types.hs | 413 ++++++++++-------- auth-service-core/src/Helpers.hs | 2 +- auth-service-core/src/SignedAuth/Headers.hs | 6 + auth-service-core/stack.lts18.yaml | 7 +- auth-service-core/stack.lts22.yaml | 15 + auth-service-core/stack.yaml | 2 +- auth-service-core/test-suite/Main.hs | 9 +- devel/docker-compose.yaml | 2 +- docker/stack-deployimage/Dockerfile | 25 -- proxy/Dockerfile | 4 +- proxy/nginx.conf.m4 | 3 +- scripts/registry-login | 11 +- service/Dockerfile | 2 +- service/src/Api.hs | 27 +- service/src/Backend.hs | 5 +- service/src/Run.hs | 1 + service/src/SAML.hs | 62 ++- service/src/SAML/Config.hs | 31 +- service/src/Types.hs | 11 +- service/src/Util.hs | 4 - service/stack.dockerhub.yaml | 2 +- service/stack.yaml | 21 +- tests/test | 61 ++- 36 files changed, 612 insertions(+), 314 deletions(-) create mode 100644 auth-service-core/openApi/Main.hs create mode 100644 auth-service-core/src/AuthService/OpenAPI.hs create mode 100644 auth-service-core/src/AuthService/OpenAPI/Schema.hs create mode 100644 auth-service-core/stack.lts22.yaml delete mode 100644 docker/stack-deployimage/Dockerfile diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 3dba4c4..9d2b634 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -12,6 +12,7 @@ variables: build: stage: build + image: registry.nejla.com/nejla-ab/docker-images/nejla-build:f9e4283c2ac701a26cc8a21a0782f5dbd51c446e before_script: - eval $(ssh-agent -s) - ssh-add <(echo "$AUTHSERVICE_SSH_PRIVKEY") @@ -23,10 +24,12 @@ build: - scripts/registry-login script: - make -C service dist/auth-service tests + - make dist/openapi.json artifacts: paths: - service/dist - dist/doc + - dist/openapi.json cache: paths: - '.stack-cache' @@ -118,7 +121,7 @@ test-backend: POSTGRES_HOST_AUTH_METHOD: trust DB_HOST: database services: - - name: postgres:10.13 + - name: postgres:16 alias: database - name: mailhog/mailhog:latest alias: mailhog diff --git a/Dockerfile.build b/Dockerfile.build index 14fb759..8e75032 100644 --- a/Dockerfile.build +++ b/Dockerfile.build @@ -1,7 +1,7 @@ # Dockerfile that builds the service from source # E.g. for publication on Dockerhub -FROM haskell:8.10.7 as build +FROM haskell:9.6.4 as build RUN export DEBIAN_FRONTEND=noninteractive && \ apt-get update && \ @@ -16,7 +16,7 @@ WORKDIR /service RUN mkdir /dist && \ stack --stack-yaml stack.dockerhub.yaml build --install-ghc --copy-bins --local-bin-path /dist -j2 -FROM ubuntu:focal +FROM ubuntu:jammy RUN export DEBIAN_FRONTEND=noninteractive && \ apt-get update && \ diff --git a/Makefile b/Makefile index d1e174c..82c6971 100644 --- a/Makefile +++ b/Makefile @@ -9,7 +9,7 @@ PROXY_IMAGE=$(REGISTRY)/$(PROXY_IMAGE_NAME) COMPOSE=docker-compose -f devel/docker-compose.yaml --project-directory=$(PWD) .PHONY: all -all: auth-service-proxy.image dist/doc +all: auth-service-proxy.image dist/doc dist/openapi.json $(MAKE) -C service all .PHONY: dist/doc @@ -23,6 +23,12 @@ dist/doc: # pandoc Doc/API.md -o dist/doc/index.html cp -f Doc/API.html dist/doc/index.html +.PHONY: dist/openapi.json +dist/openapi.json: + $(MAKE) -C auth-service-core dist/openapi.json + mkdir -p dist + cp -f auth-service-core/dist/openapi.json dist/openapi.json + .PHONY: service/image service/image: $(MAKE) -C service image diff --git a/README.md b/README.md index 230a128..e289549 100644 --- a/README.md +++ b/README.md @@ -618,8 +618,6 @@ auth-service supports single sign-on via SAML 2.0. **SP-initiated** and **IdP-initiated** login flows are supported via **POST response bindings** (again to `/api/sso/assert`) if `allow_unsolicited_responses` is set to `true`. -The IdP **must not require client signatures**. - Three attributes are supported, of which two are required. The **name** and **email** attributes are **required**. The **role** attribute is **optional**. Multiple role attributes may be specified; however, joined values are **not** diff --git a/SAML.md b/SAML.md index 3c4c0cf..7d7eb99 100644 --- a/SAML.md +++ b/SAML.md @@ -67,6 +67,8 @@ that should have SAML enabled. signed assertions. (the "realm certificate") * `config`: a simple "key=value" encoded configuration for the instance, with the following fields: + * `request-signing.key.pem` (optional): RSA private key file for signing authn + requests. If this file is missing, requests signing is disabled. |Option|Required|Type|Default|Description| |------|--------|----|-------|-----------| @@ -76,6 +78,7 @@ that should have SAML enabled. |`redirect_after_login`| No| String| `/`| URL to redirect after SAML login succeeds| |`allow_unencrypted_assertions`| No| Boolean| false| Accept unencrypted assertions from the IdP (encrypted assertions are always accepted). Note that the encryption key still needs to be set.| |`allow_unsolicited_responses`| No| Boolean| false| Accept unsolicited auth responses,e.g. IdP-initiated SSO.| +|`request_signing_digest`| No| String | sha256 | Digest to use when signing authentication requests. Has to be one of `sha1` or `sha256` but the use of `sha1` is discouraged. Example for the `config` file: ``` @@ -91,4 +94,4 @@ redirect_after_login=/index.html ## Testing SAML SSO: If the example server is running, you can navigate your browser to -`http://localhost:8000/api/sso/login` to test the SSO login +`http://localhost:8000/api/sso/login` to test the SSO login. diff --git a/auth-service-core/Makefile b/auth-service-core/Makefile index ea32835..5d8663f 100644 --- a/auth-service-core/Makefile +++ b/auth-service-core/Makefile @@ -8,32 +8,36 @@ build-env-file:=$(env-file) endif include $(build-env-file) +.PHONY: all +all: dist/openapi-gen dist/doc dist/openapi.json srcfiles:=$(shell find src -type f) test-srcfiles = $(shell find test-suite -type f) -dist/lib: $(srcfiles) $(test-srcfiles) auth-service-core.cabal stack.yaml +dist/openapi-gen: $(srcfiles) $(test-srcfiles) auth-service-core.cabal stack.yaml rm -f stack.yaml.lock mkdir -p ./dist stack build --install-ghc --test --no-run-tests \ ${stack_args} \ ${stack_build_args} \ - --haddock --no-haddock-deps --haddock-hyperlink-source - git rev-parse HEAD > dist/lib + --haddock --no-haddock-deps --haddock-hyperlink-source \ + --copy-bins --local-bin-path ./dist -dist/doc: dist/lib +dist/doc: dist/openapi-gen rm -rf dist/doc cp -fr $(shell stack path ${stack_args} --dist-dir)/doc/html/auth-service-core \ dist/doc +dist/openapi.json: dist/openapi-gen + dist/openapi-gen dist/openapi.json # Tests ####### tests = dist/tests/tests -$(tests): dist/tests/% : dist/lib $(srcfiles) $(test-srcfiles) auth-service-core.cabal stack.yaml +$(tests): dist/tests/% : dist/openapi-gen $(srcfiles) $(test-srcfiles) auth-service-core.cabal stack.yaml mkdir -p dist/tests cp "$(shell stack ${stack_args} path --dist-dir)/build/$(notdir $@)/$(notdir $@)" dist/tests/ diff --git a/auth-service-core/auth-service-core.cabal b/auth-service-core/auth-service-core.cabal index c2ef358..d2ad21b 100644 --- a/auth-service-core/auth-service-core.cabal +++ b/auth-service-core/auth-service-core.cabal @@ -19,6 +19,7 @@ library exposed-modules: AuthService.Types , AuthService.Api , AuthService.SignedHeaders + , AuthService.OpenAPI , SignedAuth , SignedAuth.Headers , SignedAuth.JWS @@ -27,6 +28,7 @@ library , SignedAuth.Util other-modules: Compat , Helpers + , AuthService.OpenAPI.Schema other-extensions: DeriveDataTypeable build-depends: base >=4.9 , aeson >=1.0 @@ -49,8 +51,8 @@ library , path-pieces , servant , servant-server - , servant-swagger - , swagger2 + , servant-openapi3 + , openapi3 , text >=1.2 , time , uuid @@ -71,6 +73,15 @@ library -Wno-name-shadowing +executable openapi-gen + main-is: Main.hs + hs-source-dirs: openApi + ghc-options: + build-depends: base + , auth-service-core + default-language: Haskell2010 + + test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs @@ -84,6 +95,7 @@ test-suite tests , bytestring , containers , hedgehog + , hspec , hspec-hedgehog , lens , lens-aeson diff --git a/auth-service-core/hie.yaml b/auth-service-core/hie.yaml index c58504c..86de10b 100644 --- a/auth-service-core/hie.yaml +++ b/auth-service-core/hie.yaml @@ -2,3 +2,5 @@ cradle: stack: - path: "./src" component: "auth-service-core:lib" + - path: "./openApi" + component: "api-definition" diff --git a/auth-service-core/openApi/Main.hs b/auth-service-core/openApi/Main.hs new file mode 100644 index 0000000..f2fe35c --- /dev/null +++ b/auth-service-core/openApi/Main.hs @@ -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" diff --git a/auth-service-core/src/AuthService/Api.hs b/auth-service-core/src/AuthService/Api.hs index cf4cfd3..618d54c 100644 --- a/auth-service-core/src/AuthService/Api.hs +++ b/auth-service-core/src/AuthService/Api.hs @@ -23,7 +23,9 @@ type SSOLoginAPI = "sso" :> "login" , Header "Cache-Control" Text , Header "Pragma" Text ] - NoContent) + SamlLoginRequest) + +type SSOEnabledAPI = "sso" :> "enabled" :> Get '[ JSON ] SsoEnabled type SSOAssertAPI = "sso" :> "assert" :> Header "X-Instance" InstanceID @@ -140,7 +142,8 @@ type ServiceAPI = "service" -- Interface -------------------------------------------------------------------------------- -type Api = LoginAPI +type Api = SSOEnabledAPI + :<|> LoginAPI :<|> SSOLoginAPI :<|> SSOAssertAPI :<|> CheckTokenAPI diff --git a/auth-service-core/src/AuthService/OpenAPI.hs b/auth-service-core/src/AuthService/OpenAPI.hs new file mode 100644 index 0000000..96e3432 --- /dev/null +++ b/auth-service-core/src/AuthService/OpenAPI.hs @@ -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 diff --git a/auth-service-core/src/AuthService/OpenAPI/Schema.hs b/auth-service-core/src/AuthService/OpenAPI/Schema.hs new file mode 100644 index 0000000..ceb0d6b --- /dev/null +++ b/auth-service-core/src/AuthService/OpenAPI/Schema.hs @@ -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 + } diff --git a/auth-service-core/src/AuthService/SignedHeaders.hs b/auth-service-core/src/AuthService/SignedHeaders.hs index cd66ee5..bc9d805 100644 --- a/auth-service-core/src/AuthService/SignedHeaders.hs +++ b/auth-service-core/src/AuthService/SignedHeaders.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} + {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE OverloadedStrings #-} @@ -48,7 +49,6 @@ module AuthService.SignedHeaders import Control.Lens -import Control.Monad import qualified Control.Monad.Catch as Ex import Control.Monad.Logger import Control.Monad.Trans @@ -61,7 +61,6 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding.Error as Text import Data.Time.Clock -import qualified Data.UUID as UUID import GHC.TypeLits (symbolVal, Symbol, KnownSymbol) import qualified Network.HTTP.Types as HTTP import Network.Wai (requestHeaders, Request) @@ -74,8 +73,8 @@ import qualified SignedAuth.Nonce as Nonce import qualified SignedAuth.Sign as Sign import AuthService.Types -import qualified Data.Swagger.ParamSchema as Swagger -import qualified Servant.Swagger as Swagger +import qualified Data.OpenApi.ParamSchema as OpenApi +import qualified Servant.OpenApi as OpenApi import Helpers import Servant.Server.Internal.Delayed (Delayed(..)) @@ -263,11 +262,11 @@ newtype AuthCredentials (required :: Requiredness) a = AuthCredentials a makePrisms ''AuthCredentials -instance Swagger.ToParamSchema (AuthCredentials required a) where - toParamSchema _ = Swagger.toParamSchema (Proxy :: Proxy String) +instance OpenApi.ToParamSchema (AuthCredentials required a) where + toParamSchema _ = OpenApi.toParamSchema (Proxy :: Proxy String) -instance Swagger.HasSwagger rest => Swagger.HasSwagger (AuthCredentials required a :> rest) where - toSwagger _ = Swagger.toSwagger (Proxy :: Proxy (Header "X-Auth" String :> rest)) +instance OpenApi.HasOpenApi rest => OpenApi.HasOpenApi (AuthCredentials required a :> rest) where + toOpenApi _ = OpenApi.toOpenApi (Proxy :: Proxy (Header "X-Auth" String :> rest)) type instance IsElem' e (AuthCredentials required a :> s) = IsElem e s @@ -409,7 +408,7 @@ instance ( HasServer api context Just authHeader -> case checkRole (Proxy :: Proxy r) (authHeader ^. roles) of Nothing -> delayedFailFatal err403 - Just role -> return () + Just _role -> return () -- Adds auth check that doesn't return anything addAuthCheck_ Delayed{..} new = @@ -421,10 +420,10 @@ instance ( HasServer api context hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s -instance Swagger.ToParamSchema (HasRole r required) where - toParamSchema _ = Swagger.toParamSchema (Proxy :: Proxy String) +instance OpenApi.ToParamSchema (HasRole r required) where + toParamSchema _ = OpenApi.toParamSchema (Proxy :: Proxy String) -instance Swagger.HasSwagger rest => Swagger.HasSwagger (HasRole r required :> rest) where - toSwagger _ = Swagger.toSwagger (Proxy :: Proxy (Header "X-Auth" String :> rest)) +instance OpenApi.HasOpenApi rest => OpenApi.HasOpenApi (HasRole r required :> rest) where + toOpenApi _ = OpenApi.toOpenApi (Proxy :: Proxy (Header "X-Auth" String :> rest)) type instance IsElem' e (HasRole r required :> s) = IsElem e s diff --git a/auth-service-core/src/AuthService/Types.hs b/auth-service-core/src/AuthService/Types.hs index bd081cb..a2edc1a 100644 --- a/auth-service-core/src/AuthService/Types.hs +++ b/auth-service-core/src/AuthService/Types.hs @@ -1,314 +1,351 @@ -- All rights reserved - {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StrictData #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} module AuthService.Types where +import AuthService.OpenAPI.Schema + import Control.Lens + import Data.Aeson import Data.Aeson.TH -import Data.ByteString (ByteString) +import Data.ByteString ( ByteString ) import Data.ByteString.Conversion import Data.Data +import qualified Data.OpenApi as OpenApi import Data.String -import Data.Text (Text) +import Data.Text ( Text ) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Time.Clock (UTCTime) +import Data.Time.Clock ( UTCTime ) import qualified Data.UUID as UUID + +import GHC.Generics ( Generic ) + +import Helpers + import qualified Web.FormUrlEncoded as Form import Web.HttpApiData import Web.PathPieces -import Helpers - -newtype InstanceID = InstanceID { unInstanceID :: UUID.UUID } - deriving ( Show, Read, Eq, Ord, Typeable, Data - ) +newtype InstanceID = + InstanceID + { unInstanceID :: UUID.UUID + } + deriving ( Show, Read, Eq, Ord, Typeable, Data + , OpenApi.ToParamSchema , OpenApi.ToSchema) makePrisms ''InstanceID instance PathPiece InstanceID where - fromPathPiece = fmap InstanceID . UUID.fromText - toPathPiece = Text.pack . UUID.toString . unInstanceID + fromPathPiece = fmap InstanceID . UUID.fromText + + toPathPiece = Text.pack . UUID.toString . unInstanceID instance ToHttpApiData InstanceID where - toUrlPiece = toPathPiece + toUrlPiece = toPathPiece instance FromHttpApiData InstanceID where - parseUrlPiece txt = - case fromPathPiece txt of - Nothing -> Left $ "Could not parse user id " <> txt - Just uuid -> Right uuid + parseUrlPiece txt = case fromPathPiece txt of + Nothing -> Left $ "Could not parse user id " <> txt + Just uuid -> Right uuid -newtype UserID = UserID { unUserID :: UUID.UUID } - deriving ( Show, Read, Eq, Ord, Typeable, Data - ) +newtype UserID = + UserID + { unUserID :: UUID.UUID + } + deriving ( Show, Read, Eq, Ord, Typeable + , OpenApi.ToParamSchema, OpenApi.ToSchema) makePrisms ''UserID instance ToJSON InstanceID where - toJSON (InstanceID uid) = toJSON $ UUID.toText uid + toJSON (InstanceID uid) = toJSON $ UUID.toText uid instance FromJSON InstanceID where - parseJSON v = do - txt <- parseJSON v - case UUID.fromText txt of - Nothing -> fail $ "Can't parse UUID " <> Text.unpack txt - Just uuid -> return $ InstanceID uuid + parseJSON v = do + txt <- parseJSON v + case UUID.fromText txt of + Nothing -> fail $ "Can't parse UUID " <> Text.unpack txt + Just uuid -> return $ InstanceID uuid instance ToByteString InstanceID where - builder = builder . Text.encodeUtf8 . UUID.toText . unInstanceID + builder = builder . Text.encodeUtf8 . UUID.toText . unInstanceID instance PathPiece UserID where - fromPathPiece = fmap UserID . UUID.fromText - toPathPiece = Text.pack . UUID.toString . unUserID + fromPathPiece = fmap UserID . UUID.fromText + + toPathPiece = Text.pack . UUID.toString . unUserID instance ToHttpApiData UserID where - toUrlPiece = toPathPiece + toUrlPiece = toPathPiece instance FromHttpApiData UserID where - parseUrlPiece txt = - case fromPathPiece txt of - Nothing -> Left $ "Could not parse user id " <> txt - Just uuid -> Right uuid + parseUrlPiece txt = case fromPathPiece txt of + Nothing -> Left $ "Could not parse user id " <> txt + Just uuid -> Right uuid instance ToJSON UserID where - toJSON (UserID uid) = toJSON $ UUID.toText uid + toJSON (UserID uid) = toJSON $ UUID.toText uid instance FromJSON UserID where - parseJSON v = do - txt <- parseJSON v - case UUID.fromText txt of - Nothing -> fail $ "Can't parse UUID " <> Text.unpack txt - Just uuid -> return $ UserID uuid + parseJSON v = do + txt <- parseJSON v + case UUID.fromText txt of + Nothing -> fail $ "Can't parse UUID " <> Text.unpack txt + Just uuid -> return $ UserID uuid instance ToByteString UserID where - builder = builder . Text.encodeUtf8 . UUID.toText . unUserID + builder = builder . Text.encodeUtf8 . UUID.toText . unUserID -newtype Name = Name{ unName :: Text} - deriving ( Show, Read, Eq, Ord, Typeable, Data, PathPiece - , ToJSON, FromJSON - , IsString, ToByteString - , ToHttpApiData, FromHttpApiData - ) +newtype Name = + Name + { unName :: Text + } + deriving ( Show, Read, Eq, Ord, Typeable, Data, PathPiece, ToJSON, FromJSON + , IsString, ToByteString, ToHttpApiData, FromHttpApiData + , OpenApi.ToParamSchema, OpenApi.ToSchema ) makePrisms ''Name -newtype Password = Password{ unPassword :: Text} - deriving ( Show, Read, Eq, Ord, Typeable, Data - , ToJSON, FromJSON - , IsString - , ToHttpApiData, FromHttpApiData - ) +newtype Password = + Password + { unPassword :: Text + } + deriving ( Show, Read, Eq, Ord, Typeable, Data, ToJSON, FromJSON, IsString + , ToHttpApiData, FromHttpApiData, OpenApi.ToParamSchema + , OpenApi.ToSchema + ) makePrisms ''Password -newtype PasswordHash = PasswordHash{ unPasswordHash :: ByteString} - deriving ( Show, Eq, Ord, Typeable, Data - ) +newtype PasswordHash = + PasswordHash + { unPasswordHash :: ByteString + } + deriving ( Show, Eq, Ord, Typeable, Data) makePrisms ''PasswordHash -newtype Email = Email{ unEmail :: Text} - deriving ( Show, Eq, Ord, Typeable, Data - , ToJSON, FromJSON - , IsString - , ToHttpApiData, FromHttpApiData - ) +newtype Email = + Email + { unEmail :: Text + } + deriving ( Show, Eq, Ord, Typeable, Data, ToJSON, FromJSON, IsString + , ToHttpApiData, FromHttpApiData, OpenApi.ToSchema) makePrisms ''Email -newtype Phone = Phone { unPhone :: Text} - deriving ( Show, Eq, Ord, Typeable, Data - , ToJSON, FromJSON - , IsString - , ToHttpApiData, FromHttpApiData - ) +newtype Phone = + Phone + { unPhone :: Text + } + deriving ( Show, Eq, Ord, Typeable, Data, ToJSON, FromJSON, IsString + , ToHttpApiData, FromHttpApiData, OpenApi.ToSchema ) makePrisms ''Phone -newtype B64Token = B64Token { unB64Token :: Text } - deriving ( Show, Read, Eq, Ord, Typeable, Data, PathPiece - , ToByteString - , ToHttpApiData, FromHttpApiData - , ToJSON, FromJSON - ) +newtype B64Token = + B64Token + { unB64Token :: Text + } + deriving ( Show, Read, Eq, Ord, Typeable, Data, PathPiece, ToByteString + , ToHttpApiData, FromHttpApiData, ToJSON, FromJSON, OpenApi.ToSchema ) makePrisms ''B64Token +instance OpenApi.ToParamSchema B64Token where + toParamSchema _ = OpenApi.toParamSchema (Proxy :: Proxy String) + type Role = Text -data AuthHeader = AuthHeader { authHeaderUserID :: Text - , authHeaderEmail :: Email - , authHeaderName :: Name - , authHeaderRoles :: [Role] - } +data AuthHeader = + AuthHeader + { authHeaderUserID :: Text + , authHeaderEmail :: Email + , authHeaderName :: Name + , authHeaderRoles :: [Role] + } + deriving ( Generic ) + deriving ( ToJSON, FromJSON, OpenApi.ToSchema ) via (JSONStruct AuthHeader) makeLensesWith camelCaseFields ''AuthHeader -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "authHeader"} ''AuthHeader -------------------------------------------------------------------------------- -- User -------------------------------------------------------------------------------- +data AddUser = + AddUser + { addUserUuid :: Maybe UserID + , addUserEmail :: Email + , addUserPassword :: Password + , addUserName :: Name + , addUserPhone :: Maybe Phone + , addUserInstances :: [InstanceID] + , addUserRoles :: [Text] + } + deriving ( Show, Generic ) + deriving ( ToJSON, FromJSON, OpenApi.ToSchema ) via (JSONStruct AddUser) - -data AddUser = AddUser { addUserUuid :: Maybe UserID - , addUserEmail :: Email - , addUserPassword :: Password - , addUserName :: Name - , addUserPhone :: Maybe Phone - , addUserInstances :: [InstanceID] - , addUserRoles :: [Text] - } deriving (Show) - -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "addUser"} ''AddUser makeLensesWith camelCaseFields ''AddUser +data ReturnUser = + ReturnUser + { returnUserUser :: Text + , returnUserRoles :: [Role] + } + deriving ( Show, Eq, Generic ) + deriving ( ToJSON, FromJSON, OpenApi.ToSchema ) via (JSONStruct ReturnUser) -data ReturnUser = ReturnUser { returnUserUser :: Text - , returnUserRoles :: [Role] - } - deriving (Show, Eq) - -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "returnUser"} - ''ReturnUser makeLensesWith camelCaseFields ''ReturnUser -data ReturnInstance = ReturnInstance { returnInstanceName :: Text - , returnInstanceId :: InstanceID - } deriving ( Show, Read, Eq, Ord - , Typeable, Data ) +data ReturnInstance = + ReturnInstance + { returnInstanceName :: Text + , returnInstanceId :: InstanceID + } + deriving (Generic, Show, Read, Eq, Ord, Typeable, Data ) + deriving ( ToJSON, FromJSON + , OpenApi.ToSchema ) via (JSONStruct ReturnInstance) makeLensesWith camelCaseFields ''ReturnInstance -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "returnInstance"} - ''ReturnInstance - -data ReturnUserInfo = ReturnUserInfo { returnUserInfoId :: Text - , returnUserInfoEmail :: Email - , returnUserInfoName :: Name - , returnUserInfoPhone :: Maybe Phone - , returnUserInfoInstances :: [ReturnInstance] - , returnUserInfoRoles :: [Text] - , returnUserInfoDeactivate :: Maybe UTCTime - } deriving Show +data ReturnUserInfo = + ReturnUserInfo + { returnUserInfoId :: Text + , returnUserInfoEmail :: Email + , returnUserInfoName :: Name + , returnUserInfoPhone :: Maybe Phone + , returnUserInfoInstances :: [ReturnInstance] + , returnUserInfoRoles :: [Text] + , returnUserInfoDeactivate :: Maybe UTCTime + } + deriving (Generic, Show ) + deriving ( ToJSON, FromJSON + , OpenApi.ToSchema ) via (JSONStruct ReturnUserInfo) -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "returnUserInfo"} - ''ReturnUserInfo makeLensesWith camelCaseFields ''ReturnUserInfo -- | User info if found -data FoundUserInfo = FoundUserInfo - { foundUserInfoId :: Text +data FoundUserInfo = + FoundUserInfo + { foundUserInfoId :: Text , foundUserInfoInfo :: Maybe ReturnUserInfo - } deriving Show + } + deriving (Generic, Show ) + deriving ( ToJSON, FromJSON + , OpenApi.ToSchema ) via (JSONStruct FoundUserInfo) -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "foundUserInfo"} - ''FoundUserInfo makeLensesWith camelCaseFields ''FoundUserInfo +data Login = + Login + { loginUser :: Email + , loginPassword :: Password + , loginOtp :: Maybe Password + } + deriving (Generic, Show, Eq, Ord, Typeable, Data ) + deriving ( ToJSON, FromJSON, OpenApi.ToSchema ) via (JSONStruct Login) -data Login = Login { loginUser :: Email - , loginPassword :: Password - , loginOtp :: Maybe Password - } deriving ( Show, Eq, Ord, Typeable, Data ) - -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "login"} ''Login makeLensesWith camelCaseFields ''Login -data ReturnLogin = ReturnLogin { returnLoginToken :: B64Token - , returnLoginInstances :: [ReturnInstance] - } deriving ( Show, Read, Eq, Ord - , Typeable, Data ) +data ReturnLogin = + ReturnLogin + { returnLoginToken :: B64Token + , returnLoginInstances :: [ReturnInstance] + } + deriving (Generic, Show, Read, Eq, Ord, Typeable, Data ) + deriving ( ToJSON, FromJSON , OpenApi.ToSchema ) via (JSONStruct ReturnLogin) makeLensesWith camelCaseFields ''ReturnLogin -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "returnLogin"} - ''ReturnLogin +data ChangePassword = + ChangePassword + { changePasswordOldPassword :: Password + , changePasswordNewPassword :: Password + , changePasswordOtp :: Maybe Password + } + deriving (Generic, Show, Eq, Ord, Typeable, Data ) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) via (JSONStruct ChangePassword) -data ChangePassword = ChangePassword { changePasswordOldPassword :: Password - , changePasswordNewPassword :: Password - , changePasswordOtp :: Maybe Password - } deriving ( Show, Eq, Ord, Typeable, Data ) - -deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "changePassword"} - ''ChangePassword makeLensesWith camelCaseFields ''ChangePassword -------------------------------------------------------------------------------- -- Password Reset -------------------------------------------------------------------------------- - newtype PasswordResetRequest = PasswordResetRequest { passwordResetRequestEmail :: Email - } deriving (Show) + } + deriving (Generic, Show ) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) + via (JSONStruct PasswordResetRequest) makeLensesWith camelCaseFields ''PasswordResetRequest -deriveJSON - defaultOptions {fieldLabelModifier = dropPrefix "passwordResetRequest"} - ''PasswordResetRequest newtype ResetTokenInfo = ResetTokenInfo { resetTokenInfoEmail :: Email - } deriving (Show) + } + deriving (Generic, Show ) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) + via (JSONStruct ResetTokenInfo) + makeLensesWith camelCaseFields ''ResetTokenInfo -deriveJSON - defaultOptions {fieldLabelModifier = dropPrefix "resetTokenInfo"} - ''ResetTokenInfo data PasswordReset = PasswordReset - { passwordResetToken :: Text - , passwordResetOtp :: Maybe Password + { passwordResetToken :: Text + , passwordResetOtp :: Maybe Password , passwordResetNewPassword :: Password - } deriving (Show) + } + deriving (Generic, Show ) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) + via (JSONStruct PasswordReset) makeLensesWith camelCaseFields ''PasswordReset -deriveJSON - defaultOptions {fieldLabelModifier = dropPrefix "passwordReset"} - ''PasswordReset -------------------------------------------------------------------------------- -- Account Creation -------------------------------------------------------------------------------- - data CreateAccount = CreateAccount - { createAccountEmail :: Email + { createAccountEmail :: Email , createAccountPassword :: Password - , createAccountName :: Name - , createAccountPhone :: Maybe Phone - } deriving (Show) + , createAccountName :: Name + , createAccountPhone :: Maybe Phone + } + deriving (Generic, Show ) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) + via (JSONStruct CreateAccount) + makeLensesWith camelCaseFields ''CreateAccount -deriveJSON - defaultOptions {fieldLabelModifier = dropPrefix "createAccount"} - ''CreateAccount -------------------------------------------------------------------------------- -- Account Disabling ----------------------------------------------------------- -------------------------------------------------------------------------------- - -data DeactivateAt = DeactivateNow - | DeactivateAt UTCTime - deriving (Show) +data DeactivateAt + = DeactivateNow + | DeactivateAt UTCTime + deriving (Generic, Show ) instance ToJSON DeactivateAt where toJSON DeactivateNow = String "now" @@ -318,31 +355,55 @@ instance FromJSON DeactivateAt where parseJSON (String "now") = return DeactivateNow parseJSON v = DeactivateAt <$> parseJSON v +instance OpenApi.ToSchema DeactivateAt where + declareNamedSchema _ = OpenApi.declareNamedSchema (Proxy @Text) + makePrisms ''DeactivateAt newtype DeactivateUser = DeactivateUser { deactivateUserDeactivateAt :: DeactivateAt - } deriving (Show) + } + deriving (Generic, Show ) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) + via (JSONStruct DeactivateUser) -makeLensesWith camelCaseFields ''DeactivateUser -deriveJSON - defaultOptions {fieldLabelModifier = camelTo2 '_' . dropPrefix "deactivateUser"} - ''DeactivateUser +makeLensesWith camelCaseFields ''DeactivateUser -------------------------------------------------------------------------------- -- SAML sso -------------------------------------------------------------------- -------------------------------------------------------------------------------- +newtype SamlLoginRequest = + SamlLoginRequest + { samlLoginRequestLocation :: Text + } deriving (Generic) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) + via (JSONStruct SamlLoginRequest) + + +makeLensesWith camelCaseFields ''SamlLoginRequest + +newtype SsoEnabled = + SsoEnabled + { ssoEnabledEnabled :: Bool + } + deriving (Generic) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) + via (JSONStruct SsoEnabled) + + +makeLensesWith camelCaseFields ''SsoEnabled data SamlResponse = SamlResponse - { samlResponseBody :: Text + { samlResponseBody :: Text , samlResponseRelayState :: Maybe Text - } deriving (Show) + } + deriving (Show, Generic) + deriving (OpenApi.ToSchema) via (JSONStruct SamlResponse) instance Form.FromForm SamlResponse where fromForm f = - SamlResponse - <$> Form.parseUnique "SAMLResponse" f + SamlResponse <$> Form.parseUnique "SAMLResponse" f <*> Form.parseMaybe "RelayState" f diff --git a/auth-service-core/src/Helpers.hs b/auth-service-core/src/Helpers.hs index a0c8693..beb8d17 100644 --- a/auth-service-core/src/Helpers.hs +++ b/auth-service-core/src/Helpers.hs @@ -13,7 +13,7 @@ dropPrefix :: [Char] -> [Char] -> [Char] dropPrefix pre str= case pre `List.stripPrefix` str of Just (n:ns) -> toLower n : ns - _ -> error "prefix now found" + _ -> error "prefix not found" debug :: MonadIO m => Text -> m () debug = liftIO . Text.hPutStrLn stderr diff --git a/auth-service-core/src/SignedAuth/Headers.hs b/auth-service-core/src/SignedAuth/Headers.hs index e5ab221..6977a06 100644 --- a/auth-service-core/src/SignedAuth/Headers.hs +++ b/auth-service-core/src/SignedAuth/Headers.hs @@ -5,15 +5,21 @@ import Control.Lens import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BSL +import Data.Data (Proxy(..)) import Data.Time.Clock.POSIX (getPOSIXTime) import SignedAuth.JWS import SignedAuth.Nonce import SignedAuth.Sign +import qualified Data.OpenApi as OpenApi + -- JSON-encoded payload signed as JWS newtype JWS a = JWS ByteString +instance OpenApi.ToParamSchema (JWS a) where + toParamSchema _ = OpenApi.toParamSchema (Proxy :: Proxy String) + encodeHeaders :: Aeson.ToJSON payload => PrivateKey -> NoncePool -> payload -> IO (JWS payload) encodeHeaders key noncePool payload = do diff --git a/auth-service-core/stack.lts18.yaml b/auth-service-core/stack.lts18.yaml index e4b5986..54859b5 100644 --- a/auth-service-core/stack.lts18.yaml +++ b/auth-service-core/stack.lts18.yaml @@ -7,8 +7,9 @@ packages: - . nix: - packages: - - zlib - - openssl # For tests + shell-file: ../shell.nix + +docker: + enable: false allow-newer: true diff --git a/auth-service-core/stack.lts22.yaml b/auth-service-core/stack.lts22.yaml new file mode 100644 index 0000000..9915c32 --- /dev/null +++ b/auth-service-core/stack.lts22.yaml @@ -0,0 +1,15 @@ +resolver: lts-22.12 + +# extra-deps: +# - base64-bytestring-1.2.0.1 + +packages: + - . + +nix: + shell-file: ../shell.nix + +docker: + enable: false + +allow-newer: true diff --git a/auth-service-core/stack.yaml b/auth-service-core/stack.yaml index d5bc7a9..9c430a9 120000 --- a/auth-service-core/stack.yaml +++ b/auth-service-core/stack.yaml @@ -1 +1 @@ -stack.lts18.yaml \ No newline at end of file +stack.lts22.yaml \ No newline at end of file diff --git a/auth-service-core/test-suite/Main.hs b/auth-service-core/test-suite/Main.hs index 135c996..bf2998a 100644 --- a/auth-service-core/test-suite/Main.hs +++ b/auth-service-core/test-suite/Main.hs @@ -8,6 +8,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text +import Test.Hspec (Spec, describe, it, shouldBe) import qualified Test.Tasty import Test.Tasty.Hspec @@ -24,10 +25,10 @@ import UnliftIO.Temporary import System.Process.Typed (runProcess_, proc) import qualified Data.Char as Char -import qualified SignedAuth.Headers as Headers -import qualified SignedAuth.JWS as JWS -import qualified SignedAuth.Nonce as Nonce -import qualified SignedAuth.Sign as Sign +import qualified SignedAuth.Headers as Headers +import qualified SignedAuth.JWS as JWS +import qualified SignedAuth.Nonce as Nonce +import qualified SignedAuth.Sign as Sign readKeys :: IO (Sign.PrivateKey, Sign.PublicKey) readKeys = withSystemTempDirectory "signed-auth-test." $ \path -> do diff --git a/devel/docker-compose.yaml b/devel/docker-compose.yaml index e7b7a82..d01bb7b 100644 --- a/devel/docker-compose.yaml +++ b/devel/docker-compose.yaml @@ -68,7 +68,7 @@ services: links: - auth-service-backend # Link upstream containers to their instance IDs - - upstream:de305d54-75b4-431b-adb2-eb6b9e546014 + - upstream:657b5108-7559-4b8e-a643-dd0cc29b9e34 environment: # - SESSION_COOKIES=false - NORATELIMIT=true diff --git a/docker/stack-deployimage/Dockerfile b/docker/stack-deployimage/Dockerfile deleted file mode 100644 index 1ec6962..0000000 --- a/docker/stack-deployimage/Dockerfile +++ /dev/null @@ -1,25 +0,0 @@ -# @IMAGE auth-service-baseimage -# @VERSION 20180524-01 - -From ubuntu:xenial - -RUN export DEBIAN_FRONTEND=noninteractive && \ - apt-get update && \ - apt-get -y install \ - build-essential \ - libgmp10 \ - libicu-dev \ - libpq-dev \ - locales \ - netcat \ - msmtp-mta \ - ssh-client && \ - locale-gen en_US.UTF-8 - -ENV LC_ALL=en_US.UTF-8 -ENV LANG=en_US.UTF-8 -ENV LANGUAGE=en_US.UTF-8 - -EXPOSE 80 - -CMD /app/run.sh diff --git a/proxy/Dockerfile b/proxy/Dockerfile index 3250d92..5b11f77 100644 --- a/proxy/Dockerfile +++ b/proxy/Dockerfile @@ -1,4 +1,4 @@ -FROM nginx +FROM nginx:1.25 RUN apt-get update &&\ @@ -8,7 +8,7 @@ RUN apt-get update &&\ dnsmasq \ gettext-base \ m4 \ - netcat \ + netcat-openbsd \ && \ rm -rf /var/lib/apt/lists/* diff --git a/proxy/nginx.conf.m4 b/proxy/nginx.conf.m4 index bdb7a9f..731c397 100644 --- a/proxy/nginx.conf.m4 +++ b/proxy/nginx.conf.m4 @@ -28,6 +28,7 @@ events { http { ifdef(`NORATELIMIT', `', ` limit_req_zone $binary_remote_addr zone=login:10m rate=2r/m; + limit_req_zone $binary_remote_addr zone=sso:10m rate=1r/s; limit_req_zone $binary_remote_addr zone=service:10m rate=5r/s; limit_req zone=service burst=10; limit_req_status 429; # Too Many Requests @@ -128,7 +129,7 @@ http { } ifdef(`NORATELIMIT', `', ` - limit_req zone=login burst=10 nodelay;') + limit_req zone=sso burst=10 nodelay;') proxy_pass http://AUTH_SERVICE/sso/; proxy_set_header X-Original-URI $request_uri; proxy_set_header X-Instance $instance; diff --git a/scripts/registry-login b/scripts/registry-login index 66bad1d..111d152 100755 --- a/scripts/registry-login +++ b/scripts/registry-login @@ -2,6 +2,11 @@ set -e -[[ -n $REGISTRY ]] || fail "REGISTRY is undefined" -[[ -n $CI_BUILD_TOKEN ]] || fail "CI_BUILD_TOKE is undefined" -docker login -u gitlab-ci-token -p $CI_BUILD_TOKEN $CI_REGISTRY_IMAGE +fail() { + echo "$*" >&2 + exit 1 +} + +[[ -n $CI_REGISTRY ]] || fail "CI_REGISTRY is undefined" +[[ -n $CI_JOB_TOKEN ]] || fail "CI_JOB_TOKEN is undefined" +docker login -u gitlab-ci-token -p "$CI_JOB_TOKEN" "$CI_REGISTRY" diff --git a/service/Dockerfile b/service/Dockerfile index 1a20239..c83e7ca 100644 --- a/service/Dockerfile +++ b/service/Dockerfile @@ -1,7 +1,7 @@ # @IMAGE auth-service-service # @VERSION 20200114-01 -FROM ubuntu:focal as baseimage +FROM ubuntu:jammy as baseimage RUN export DEBIAN_FRONTEND=noninteractive && \ apt-get update && \ diff --git a/service/src/Api.hs b/service/src/Api.hs index 13fca91..46f168d 100644 --- a/service/src/Api.hs +++ b/service/src/Api.hs @@ -16,6 +16,7 @@ import Backend import Control.Lens hiding (Context) import qualified Control.Monad.Catch as Ex import Control.Monad.Except +import Control.Monad.Trans (lift, liftIO) import Data.Aeson (encode) import qualified Data.List as List import qualified Data.Map.Strict as Map @@ -100,6 +101,13 @@ serveLogin pool st loginReq = loginHandler , errHeaders = [] } +serveSSOEnabledAPI :: ConnectionPool -> ApiState -> Server SSOEnabledAPI +serveSSOEnabledAPI _pool st = + case configSamlConfig (apiStateConfig st) of + Nothing -> return $ SsoEnabled False + Just{} -> return $ SsoEnabled True + + serveSSOAssertAPI :: ConnectionPool -> ApiState -> Server SSOAssertAPI serveSSOAssertAPI pool st Nothing _ = do liftHandler $ runAPI pool st $ @@ -139,12 +147,24 @@ serveSSOLoginAPI pool st (Just inst) = do Just samlConf -> do let audience = samlInstanceConfigAudience samlConf baseUrl = samlInstanceConfigIdPBaseUrl samlConf - param <- liftHandler . runAPI pool st $ SAML.ssoLoginHandler audience + -- SAML request "destination" is required when the request is signed + destination = Just baseUrl + digest = samlInstanceConfigRequestSigningDigest samlConf + param <- case samlInstanceConfigRequestSigningKey samlConf of + -- Request signing disabled + Nothing -> + liftHandler . runAPI pool st $ SAML.ssoLoginHandler + audience destination + Just key -> + liftHandler . runAPI pool st + $ SAML.ssoLoginSignedHandler audience destination digest + key + let location = [i|#{baseUrl}?#{param}|] :: Text return $ - addHeader @"Location" ([i|#{baseUrl}?#{param}|] :: Text) + addHeader @"Location" location $ addHeader @"Cache-Control" ("no-cache, no-store" :: Text) $ addHeader @"Pragma" ("no-cache" :: Text) - NoContent + SamlLoginRequest {samlLoginRequestLocation = location} serveLogout :: ConnectionPool -> ApiState -> Server LogoutAPI @@ -445,6 +465,7 @@ serveAPI pool noncePool conf secrets = , apiStateNoncePool = noncePool } in serve apiPrx $ serveStatus + :<|> serveSSOEnabledAPI pool ctx :<|> serveLogin pool ctx :<|> serveSSOLoginAPI pool ctx :<|> serveSSOAssertAPI pool ctx diff --git a/service/src/Backend.hs b/service/src/Backend.hs index 5908e8f..fe70814 100644 --- a/service/src/Backend.hs +++ b/service/src/Backend.hs @@ -13,6 +13,7 @@ module Backend import Control.Arrow ((***)) import Control.Lens hiding (from) import Control.Monad +import Control.Monad.Trans (MonadIO, lift, liftIO) import qualified Control.Monad.Catch as Ex import Control.Monad.Except import qualified Crypto.BCrypt as BCrypt @@ -535,7 +536,7 @@ login timeframe remoteAddress maxAttempts where logFailed :: API (Either LoginError b) -> Log.AuthFailedReason - -> ExceptT LoginError (App ApiState 'Privileged 'ReadCommitted) b + -> ExceptT LoginError (App ApiState 'Privileged 'NC.ReadCommitted) b logFailed m reason = do lift m >>= \case Left e -> do @@ -762,7 +763,7 @@ checkTokenInstance request tok inst , Log.instanceId = inst } return Nothing - +-- Not an SSO token checkTokenInstance request tok inst = do mbUsr <- getUserByToken tok case mbUsr of diff --git a/service/src/Run.hs b/service/src/Run.hs index 07e09aa..468162a 100644 --- a/service/src/Run.hs +++ b/service/src/Run.hs @@ -6,6 +6,7 @@ module Run where import Control.Lens +import Control.Monad (unless) import Control.Monad.Logger import Control.Monad.Reader import qualified Data.Char as Char diff --git a/service/src/SAML.hs b/service/src/SAML.hs index bf29cfb..9fb3489 100644 --- a/service/src/SAML.hs +++ b/service/src/SAML.hs @@ -12,6 +12,11 @@ module SAML where import Control.Monad.Except +import Control.Monad (unless) +import Control.Monad.Trans (MonadIO, lift, liftIO) +import Crypto.Hash.Algorithms (SHA1(..), SHA256(..)) +import qualified Crypto.PubKey.RSA as RSA (PrivateKey) +import qualified Crypto.PubKey.RSA.PKCS15 as RSA import Data.ByteString (ByteString) import qualified Data.ByteString.Base64 as B64 import Data.Functor @@ -21,11 +26,15 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Time.Clock (getCurrentTime, addUTCTime) +import Data.Time.Clock (UTCTime) import qualified Data.UUID as UUID import qualified Database.Esqueleto as E import qualified Database.Persist as P import NejlaCommon (SV) +import Network.HTTP.Types (urlEncode) import qualified Network.Wai.SAML2 as SAML +import qualified Network.Wai.SAML2.Request as SAML +import qualified Network.Wai.SAML2.Response as SAML import qualified Network.Wai.SAML2.Validation as SAML import qualified Network.Wai.SAML2.Request as AuthnRequest @@ -70,11 +79,20 @@ config2SamlConf cfg = -- AuthnRequest ---------------------------------------------------------------- -------------------------------------------------------------------------------- -ssoLoginHandler :: Text -> API ByteString -ssoLoginHandler issuer = do - request <- liftIO $ AuthnRequest.issueAuthnRequest issuer +pruneSsoRequestTokens :: UTCTime -> API () +pruneSsoRequestTokens now = do + -- Delete IDs older than one hour + runDB . E.delete . E.from $ \(srid :: SV DB.SamlRequestId) -> + E.where_ (srid E.^. DB.SamlRequestIdCreated E.<. E.val (addUTCTime (-3600) now)) + +ssoLoginHandler :: Text -> Maybe Text -> API ByteString +ssoLoginHandler issuer destination = do + request' <- liftIO $ AuthnRequest.issueAuthnRequest issuer + let request = request' { SAML.authnRequestDestination = destination } now <- liftIO getCurrentTime + -- Don't let tokens accumulate in the absence of successful logins + pruneSsoRequestTokens now _ <- runDB $ P.insert DB.SamlRequestId { DB.samlRequestIdRequestId = AuthnRequest.authnRequestID request , DB.samlRequestIdCreated = now @@ -82,7 +100,34 @@ ssoLoginHandler issuer = do return $ "SAMLRequest=" <> AuthnRequest.renderUrlEncodingDeflate request - +ssoLoginSignedHandler :: + Text + -> Maybe Text + -> RequestSigningDigest + -> RSA.PrivateKey + -> API ByteString +ssoLoginSignedHandler issuer destination digest privateKey = do + query <- ssoLoginHandler issuer destination + let sigAlg = case digest of + RequestSigningDigestSHA1 -> "http://www.w3.org/2000/09/xmldsig#rsa-sha1" + RequestSigningDigestSHA256 -> + "http://www.w3.org/2001/04/xmldsig-more#rsa-sha256" + sigAlgParam :: Text + sigAlgParam = [i|SigAlg=#{urlEncode True sigAlg}|] + let sigString :: ByteString + sigString = [i|#{query}&#{sigAlgParam}|] + mbSig <- liftIO $ + case digest of + RequestSigningDigestSHA1 -> + RSA.signSafer (Just SHA1) privateKey sigString + RequestSigningDigestSHA256 -> + RSA.signSafer (Just SHA256) privateKey sigString + case mbSig of + Left err -> error (show err) + Right sigBs -> do + let sigB64 = B64.encode sigBs + sig = urlEncode True sigB64 + return [i|#{sigString}&Signature=#{sig}|] data SSOResult = SSOInvalid @@ -140,10 +185,7 @@ createSsoToken userId email' userName instId instName roles' = do checkAssertionInResponseTo :: Text -> ExceptT SSOResult API () checkAssertionInResponseTo requestId = do now <- liftIO getCurrentTime - -- Delete IDs older than one hour - lift . runDB . E.delete . E.from $ \(srid :: SV DB.SamlRequestId) -> - E.where_ (srid E.^. DB.SamlRequestIdCreated E.<. E.val (addUTCTime (-3600) now)) - + lift $ pruneSsoRequestTokens now -- Find and delete request ID deleted <- lift . runDB $ E.deleteCount . E.from $ \(srid :: SV DB.SamlRequestId) -> E.where_ (srid E.^. DB.SamlRequestIdRequestId E.==. E.val requestId) @@ -166,8 +208,8 @@ ssoAssertHandler cfg response = runExceptT $ do lift . Log.logDebug $ (either (const "could not decode Base64") Text.decodeUtf8 . B64.decode . Text.encodeUtf8 $ samlResponseBody response) throwError SSOInvalid - Right r -> do - return r + Right (assertion, r) -> + return (assertion, SAML.responseInResponseTo r) -- Reference [InResponseTo] -- diff --git a/service/src/SAML/Config.hs b/service/src/SAML/Config.hs index aab045b..11b092e 100644 --- a/service/src/SAML/Config.hs +++ b/service/src/SAML/Config.hs @@ -7,7 +7,8 @@ module SAML.Config where -import Control.Monad.Logger (logError, MonadLogger) +import qualified Control.Monad.Catch as Ex +import Control.Monad.Logger (logError, logInfo, MonadLogger) import Control.Monad.Trans import qualified Data.ByteString as BS import qualified Data.Configurator.Types as Config @@ -23,6 +24,7 @@ import qualified Data.UUID as UUID import qualified System.Directory as Dir import System.Exit (exitFailure) import System.FilePath (()) +import System.IO.Error (isDoesNotExistError) import NejlaCommon.Config hiding (Config) @@ -91,6 +93,33 @@ getSamlConfig base inst = do liftIO exitFailure Right r -> return r + let requestSigningKey = path "request-signing.key.pem" + mbRequestSigningKeyBS <- liftIO $ Ex.try (BS.readFile requestSigningKey) + samlInstanceConfigRequestSigningKey <- case mbRequestSigningKeyBS of + Right requestSigningKeyBS -> + case parsePrivateKeyPem requestSigningKeyBS of + Left e -> do + $logError [i|Could not parse SAML request signing key from #{requestSigningKey}: #{show e}|] + liftIO exitFailure + Right key -> return $ Just key + Left e | isDoesNotExistError e -> do + $logInfo [i|No request signing key found for #{inst}, disabling request signing|] + return Nothing + Left e -> do + $logError [i|Could not read SAML request signing key from #{requestSigningKey}: #{show e}|] + liftIO exitFailure + + $logInfo [i|Got SAML configuration for instance #{samlInstanceConfigInstance}|] + + samlInstanceConfigRequestSigningDigest + <- case Map.lookup "request_signing_digest" conf of + Nothing -> return RequestSigningDigestSHA256 + Just "sha1" -> return RequestSigningDigestSHA1 + Just "sha256" -> return RequestSigningDigestSHA256 + Just d -> do + $logError [i|Unknown request signing digest: #{d}|] + liftIO exitFailure + return SamlInstanceConfig{..} where diff --git a/service/src/Types.hs b/service/src/Types.hs index 1570a15..f5a4d26 100644 --- a/service/src/Types.hs +++ b/service/src/Types.hs @@ -21,15 +21,11 @@ import qualified Control.Monad.Catch as Ex import qualified Crypto.PubKey.RSA.Types as RSA import Data.Default import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map import Data.Text (Text) import Data.Time (NominalDiffTime) import Data.Typeable -import Data.UUID (UUID) -import qualified Data.UUID as UUID import Network.Mail.Mime (Address) import qualified Text.Microstache as Mustache -import Web.FormUrlEncoded import qualified SignedAuth import AuthService.Types @@ -110,6 +106,11 @@ data AccountCreationConfig = , accountCreationConfigDefaultInstances :: [InstanceID] } +data RequestSigningDigest = + RequestSigningDigestSHA1 + | RequestSigningDigestSHA256 + deriving (Eq, Ord, Show) + data SamlInstanceConfig = SamlInstanceConfig { samlInstanceConfigEncryptionKey :: RSA.PrivateKey @@ -120,6 +121,8 @@ data SamlInstanceConfig = , samlInstanceConfigIdPBaseUrl :: Text , samlInstanceConfigRedirectAfterLogin :: Text , samlInstanceConfigAllowUnsolicited :: Bool + , samlInstanceConfigRequestSigningKey :: Maybe RSA.PrivateKey + , samlInstanceConfigRequestSigningDigest :: RequestSigningDigest } deriving Show data SamlConfig = diff --git a/service/src/Util.hs b/service/src/Util.hs index c3b967e..802475c 100644 --- a/service/src/Util.hs +++ b/service/src/Util.hs @@ -14,10 +14,6 @@ import qualified Language.Haskell.TH.Quote as TH import qualified Language.Haskell.TH.Syntax as TH import qualified Text.Microstache as Mustache --- Orphan instances for Microstache Templates -instance (TH.Lift a, TH.Lift b) => TH.Lift (Map a b) where - lift m = [|Map.fromAscList $(TH.lift $ Map.toAscList m)|] - deriving instance TH.Lift Mustache.PName deriving instance TH.Lift Mustache.Key deriving instance TH.Lift Mustache.Node diff --git a/service/stack.dockerhub.yaml b/service/stack.dockerhub.yaml index 20de978..14cefe0 100644 --- a/service/stack.dockerhub.yaml +++ b/service/stack.dockerhub.yaml @@ -1,6 +1,6 @@ # stack.yaml for use by dockerhub -resolver: lts-18.12 +resolver: lts-22.12 extra-deps: - git: https://github.com/nejla/nejla-common.git diff --git a/service/stack.yaml b/service/stack.yaml index f6ebe53..56aa387 100644 --- a/service/stack.yaml +++ b/service/stack.yaml @@ -3,16 +3,12 @@ # in stack.dockerhub.yaml ! ############################################## -resolver: lts-18.12 +resolver: lts-22.12 extra-deps: - git: git@git.nejla.com:nejla-ab/common.git - commit: 3cbc5d0db2e8c18838159b92d7bb9b39f551e226 + commit: f83bc8cdfb2cd067c3713a254f57ce7435fed2c7 - '../auth-service-core' - - base64-bytestring-1.2.0.1 - - git: https://github.com/Philonous/wai-saml2.git - commit: b97c4aa979b53ed59257ae852942cd38bda46d9c - - hspec-wai-json-0.11.0 docker: enable: false @@ -20,16 +16,5 @@ docker: allow-newer: true -flags: - nejla-common: - # Required for lts < 19 - new-singletons: false - nix: - # shell-file: stack.nix - packages: - - zlib - - postgresql - - pkg-config - - libxml2 - - openssl + shell-file: ../shell.nix diff --git a/tests/test b/tests/test index 2f74532..a321d38 100755 --- a/tests/test +++ b/tests/test @@ -22,8 +22,8 @@ fi # You need to have jq in path -AUTHSERVICE_CONTAINER=auth-service_auth-service_1 -DB_CONTAINER=auth-service_database_1 +AUTHSERVICE_CONTAINER=auth-service-auth-service-backend-1 +DB_CONTAINER=auth-service-database-1 DB_HOST=database DB_USER=postgres DB_DATABASE=postgres @@ -36,12 +36,23 @@ PASSWORD=pwd123 USER2=user2@example.com PASSWORD2=pwd1234 NAME="JohnDoe" -INSTANCE="de305d54-75b4-431b-adb2-eb6b9e546014" +INSTANCE="657b5108-7559-4b8e-a643-dd0cc29b9e34" INSTANCE2="$(uuidgen)" NOTINSTANCE="deadbeef-75b4-431b-adb2-eb6b9e546014" +declare -a tmpfiles=() + +cleanup() { + for tmpfile in "${tmpfiles[@]}"; do + rm -f "$tmpfile" + done +} + +trap "cleanup" EXIT + + testing () { echo -e "\e[32m$1 \e[39m" } @@ -168,7 +179,7 @@ login() { http() { tmpfile=$(mktemp --tmpdir auth-service.tmp.XXXXX) || fail "Could not make temporary file" - trap "rm -f $tmpfile" EXIT + tmpfiles+=("$tmpfile") res=$($CURL -o "$tmpfile" -w "%{http_code}" "$@") if [[ "$res" -lt 200 || "$res" -gt 300 ]]; then echo "http error (response code $res)" @@ -180,7 +191,7 @@ http() { call() { tmpfile=$(mktemp --tmpdir auth-service.tmp.XXXXX) || fail "Could not make temporary file" - trap "rm -f $tmpfile" EXIT + tmpfiles+=("$tmpfile") ENDPOINT=$1 shift RES=$($CURL -XPOST \ @@ -200,9 +211,10 @@ call() { } logout() { - $CURL -H "X-Instance: $INSTANCE" \ - -H "X-Token: $TOKEN" \ - http://$API/logout + http -XPOST \ + -H "X-Instance: $INSTANCE" \ + -H "X-Token: $TOKEN" \ + "http://$API/logout" } check_upstream() { @@ -226,7 +238,6 @@ clearEmail() { # Reads the latest email and tries to extract the token; stores it in $token emailGetToken() { tmpfile=$(mktemp --tmpdir auth-service.tmp.XXXXX) || fail "Could not make temporary file" - trap "rm -f $tmpfile" EXIT res=$($CURL --silent -w "%{http_code}" "http://$EMAIL_API/messages" -o "$tmpfile") if [[ $res -lt 200 || $res -gt 300 ]]; then fail "Failed with error code $res" @@ -236,15 +247,16 @@ emailGetToken() { token=$(< "$tmpfile" \ jq -r '.[0] | .MIME.Parts | .[1] | .Body' \ - | perl -n -e '/\?token=3D([[:alnum:]]+)<\/a>/ && print $1') - [[ -n "$token" ]] || fail "could not get token" - + | perl -MMIME::QuotedPrint -0777 -nle \ + 'decode_qp($_) =~ /\?token=([[:alnum:]]+)/ && print $1' ) + [[ -n "$token" ]] || { jq -r '.[0] | .MIME.Parts | .[1] | .Body' < "$tmpfile"; fail "could not get token"; } + tmpfiles+=("$tmpfile") } # run _local_ test runtest() { RES="$(login)" - echo $RES + echo "$RES" TOKEN=$(echo "$RES" | jq -r '.token.token') if [[ -z "$TOKEN" ]]; then echo "Could not login" @@ -444,9 +456,9 @@ docker_test() { testing "Testing otp" create_otp $USER2 $PASSWORD2 get_otp - [[ -n $OTP ]] || fail "Could not get OTP" - OTP=$(echo $OTP | tr '[:upper:]' '[:lower:]') - login $USER2 $PASSWORD2 $OTP || fail "could not log in" + [[ -n "$OTP" ]] || fail "Could not get OTP" + OTP=$(echo "$OTP" | tr '[:upper:]' '[:lower:]') + login $USER2 $PASSWORD2 "$OTP" || fail "could not log in" testing "Trying to login without otp" create_otp $USER2 $PASSWORD2 @@ -455,13 +467,14 @@ docker_test() { testing "Trying to double-use OTP" create_otp $USER2 $PASSWORD2 get_otp - [[ -n $OTP ]] || fail "Could not get OTP" - OTP=$(echo $OTP | tr '[:upper:]' '[:lower:]') - login $USER2 $PASSWORD2 $OTP || fail "could not log in" + [[ -n "$OTP" ]] || fail "Could not get OTP" + OTP=$(echo "$OTP" | tr '[:upper:]' '[:lower:]') + login $USER2 $PASSWORD2 "$OTP" || fail "could not log in" logout - login $USER2 $PASSWORD2 $OTP && fail "Double-used OTP" + login $USER2 $PASSWORD2 "$OTP" && fail "Double-used OTP" testing "Testing logout" + login logout RES=$($CURL -H "X-Instance: $INSTANCE" \ -H "X-Token: $TOKEN" \ @@ -485,7 +498,7 @@ docker_test() { login || fail "could not log in" call "change-password" \ -H "Content-Type: application/json" \ - -d "{\"oldPassword\":\"$PASSWORD\",\"newPassword\":\"$PASSWORD2\"}" + -d "{\"old_password\":\"$PASSWORD\",\"new_password\":\"$PASSWORD2\"}" logout login $USER $PASSWORD2 || fail "Could not login with new password" login && fail "could still log on with old credentials" @@ -498,7 +511,7 @@ docker_test() { -d "{\"email\": \"$USER\"}" emailGetToken call "reset-password" -H "Content-Type: application/json" \ - -d "{\"token\":\"$token\", \"newPassword\":\"newpwd\"}" + -d "{\"token\":\"$token\", \"new_password\":\"newpwd\"}" login "$USER" "newpwd" || fail "Could not login" # Check that we can't login with the old credentials login && fail "password wasn't changed" @@ -508,7 +521,7 @@ docker_test() { -H "Content-Type: application/json" \ -d "{\"email\": \"$USER\"}" emailGetToken - $CURL "http://$API/reset-password-info/$token" + http "http://$API/reset-password-info/$token" >/dev/null testing "Password reset with unknown email" call "request-password-reset" \ @@ -518,7 +531,7 @@ docker_test() { -H "Content-Type: application/json" \ -d "{\"email\": \"$USER\"}" emailGetToken - http "http://$API/reset-password-info?token=$token" + http "http://$API/reset-password-info?token=$token" >/dev/null testing "Checking Roles" docker_setup &> /dev/null