diff --git a/ms-graph-api-test/CHANGELOG.md b/ms-graph-api-test/CHANGELOG.md new file mode 100644 index 0000000..76b5432 --- /dev/null +++ b/ms-graph-api-test/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `ms-graph-api-test` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/ms-graph-api-test/LICENSE b/ms-graph-api-test/LICENSE new file mode 100644 index 0000000..c5b6c16 --- /dev/null +++ b/ms-graph-api-test/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2023 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/ms-graph-api-test/README.md b/ms-graph-api-test/README.md new file mode 100644 index 0000000..1d5b69b --- /dev/null +++ b/ms-graph-api-test/README.md @@ -0,0 +1,5 @@ +# ms-graph-api-test + +[![Build Status](https://travis-ci.org/githubuser/ms-graph-api-test.png)](https://travis-ci.org/githubuser/ms-graph-api-test) + +TODO Description. diff --git a/ms-graph-api-test/Setup.hs b/ms-graph-api-test/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/ms-graph-api-test/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ms-graph-api-test/app/Main.hs b/ms-graph-api-test/app/Main.hs new file mode 100644 index 0000000..489e939 --- /dev/null +++ b/ms-graph-api-test/app/Main.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE DataKinds #-} +{-# language OverloadedStrings #-} +{-# language QuasiQuotes #-} +{-# options_ghc -Wno-unused-imports #-} +module Main (main) where + +import Control.Monad.IO.Class (MonadIO(..)) + +-- hoauth2 +import Network.OAuth.OAuth2 (OAuth2Token(..)) +import Network.OAuth2.Experiment (IdpApplication, GrantTypeFlow(..)) +-- http-client +import Network.HTTP.Client (Manager, newManager) +-- http-client-tls +import Network.HTTP.Client.TLS (tlsManagerSettings) +-- req +import Network.HTTP.Req (runReq, defaultHttpConfig, httpConfigAltManager) +-- scotty +import Web.Scotty.Trans (ScottyT, scottyT, get, html, RoutePattern, middleware) +-- text +import qualified Data.Text as T (unpack) +import qualified Data.Text.Lazy as TL (Text, pack) +-- transformers +import Control.Monad.Trans.Reader (runReaderT) +-- unliftio +import UnliftIO.STM (STM, newTVarIO) +-- uri-bytestring +import URI.ByteString.QQ (uri) +-- wai-extra +import Network.Wai.Middleware.RequestLogger (logStdoutDev) + +import qualified MSGraphAPI.Users.User as MSG (getMe, User(..)) +import Network.OAuth2.Provider.AzureAD (OAuthCfg(..), azureOAuthADApp, AzureAD) +import Network.OAuth2.Session (Tokens, newTokens, tokensToList, withAADUser, loginEndpoint, replyEndpoint, UserSub, Scotty, Action) + + +main :: IO () +main = server + +server :: MonadIO m => m () +server = do + ts <- newTokens + mgr <- liftIO $ newManager tlsManagerSettings + let + runR r = runReaderT r ts + scottyT 3000 runR $ do + middleware logStdoutDev + loginEndpoint idpApp "/oauth/login" + replyEndpoint idpApp ts mgr "/oauth/reply" + allTokensEndpoint ts "/tokens" + currentUsersEndpoint ts (Just mgr) "/me" + +-- currentUserEndpoint :: MonadIO m => +-- Tokens UserSub OAuth2Token +-- -> RoutePattern -> Scotty m () +-- currentUserEndpoint ts pth = get pth $ withAADUser ts "/oauth/login" $ \oat -> do +-- let +-- t = accessToken oat +-- u <- runReq defaultHttpConfig $ MSG.getMe t +-- let +-- uname = MSG.uDisplayName u +-- h = TL.pack $ unwords ["", "

", T.unpack uname, "

",""] +-- html h + +currentUsersEndpoint :: (MonadIO m) => + Tokens a OAuth2Token + -> Maybe Manager -- ^ if Nothing it uses the default implicit connection manager + -> RoutePattern -> Scotty m () +currentUsersEndpoint ts mmgr pth = get pth $ do + tsl <- tokensToList ts + let + f (_, oat) = do + let + t = accessToken oat + usr <- runReq defaultHttpConfig{ httpConfigAltManager = mmgr } $ MSG.getMe t + let + row = unwords ["", show usr, ""] + pure row + rows <- traverse f tsl + let + h = TL.pack ("" <> mconcat rows <> "
") + html h + +allTokensEndpoint :: (MonadIO m, Show a1) => + Tokens a1 OAuth2Token -> RoutePattern -> Scotty m () +allTokensEndpoint ts pth = get pth $ do + tsl <- tokensToList ts + html (table tsl) + +table :: (Foldable t, Show a) => t (a, OAuth2Token) -> TL.Text +table mm = TL.pack ("" <> foldMap insf mm <> "
") + where + insf (k, oat) = unwords ["", show k , "", show (accessToken oat), ""] + + + +-- also double check https://stackoverflow.com/a/63929994/2890063 in the AAD app manifest +idpApp :: IdpApplication 'AuthorizationCode AzureAD +idpApp = azureOAuthADApp (OAuthCfg + "ms-graph-api-test" + "53647139-affd-4ec6-b83a-e41323f33240" + "4C68Q~sGVNAqdr_jGERbi68oSE4kjNtmt1Ilmbxx" + ["profile", "email", "User.Read"] + "abcd1234" + [uri|https://66b3-213-89-187-253.ngrok-free.app/oauth/reply|] + ) + + + diff --git a/ms-graph-api-test/makefile b/ms-graph-api-test/makefile new file mode 100644 index 0000000..aca471a --- /dev/null +++ b/ms-graph-api-test/makefile @@ -0,0 +1,11 @@ +# in shell 1 +run: + stack build && stack exec -- ms-graph-api-test + +# in shell 2 +tunnel: + ngrok http 3000 + +# all: +# make tunnel +# make run diff --git a/ms-graph-api-test/ms-graph-api-test.cabal b/ms-graph-api-test/ms-graph-api-test.cabal new file mode 100644 index 0000000..53edaac --- /dev/null +++ b/ms-graph-api-test/ms-graph-api-test.cabal @@ -0,0 +1,60 @@ +name: ms-graph-api-test +version: 0.1.0.0 +-- synopsis: +-- description: +homepage: https://github.com/unfoldml/ms-api +license: BSD3 +license-file: LICENSE +author: Marco Zocca +maintainer: oss@unfoldml.com +copyright: 2023 Marco Zocca +category: API +build-type: Simple +extra-source-files: README.md + CHANGELOG.md +cabal-version: >=1.10 +tested-with: GHC == 9.2.7 + +library + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: Lib + build-depends: base >= 4.7 && < 5 + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + +executable ms-graph-api-test + default-language: Haskell2010 + hs-source-dirs: app + main-is: Main.hs + build-depends: base + , hoauth2 == 2.6.0 + , http-client + , http-client-tls >= 0.3 + , ms-graph-api + , ms-graph-api-test + , ms-auth >= 0.2 + , req + , scotty + , text >= 1.2.5.0 + , transformers >= 0.5.6.2 + , unliftio + , uri-bytestring + , wai-extra >= 3.1.13.0 + ghc-options: -Wall + -threaded + -rtsopts + -with-rtsopts=-N + + + +source-repository head + type: git + location: https://github.com/githubuser/ms-graph-api-test diff --git a/ms-graph-api-test/stack.yaml b/ms-graph-api-test/stack.yaml new file mode 100644 index 0000000..ccd6710 --- /dev/null +++ b/ms-graph-api-test/stack.yaml @@ -0,0 +1,44 @@ +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/25.yaml + +packages: +- . +- ../ms-auth +- ../ms-graph-api + +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: + +extra-deps: +- validation-micro-1.0.0.0 + +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of Stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.9" +# +# Override the architecture used by Stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by Stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor