smith-client (empty) → 0.0.1
raw patch · 24 files changed
+1128/−0 lines, 24 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, case-insensitive, directory, filepath, hedgehog, http-client, http-client-tls, http-types, jose, oauth2-jwt-bearer, smith-client, text, transformers, transformers-bifunctors
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- README.md +61/−0
- Setup.hs +2/−0
- pact/Pact.hs +95/−0
- pact/pact-generator.hs +46/−0
- smith-client.cabal +88/−0
- src/Smith/Client.hs +37/−0
- src/Smith/Client/Api.hs +57/−0
- src/Smith/Client/Config.hs +244/−0
- src/Smith/Client/Data/Certificate.hs +14/−0
- src/Smith/Client/Data/CertificateAuthority.hs +14/−0
- src/Smith/Client/Data/CertificateRequest.hs +38/−0
- src/Smith/Client/Data/Environment.hs +15/−0
- src/Smith/Client/Data/Identity.hs +14/−0
- src/Smith/Client/Data/User.hs +14/−0
- src/Smith/Client/Error.hs +33/−0
- src/Smith/Client/Network.hs +64/−0
- src/Smith/Client/Request.hs +60/−0
- src/Smith/Client/Response.hs +52/−0
- src/Smith/Client/Serial/Decode.hs +66/−0
- src/Smith/Client/Serial/Encode.hs +24/−0
- test/Test/Smith/Client/Api.hs +38/−0
- test/test.hs +17/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for smith-client++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, HotelKilo++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 Mark Hibberd 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.
+ README.md view
@@ -0,0 +1,61 @@+# smith-client++This is a client-library for the [Smith](https://smith.st) API.++The goal is to provide a convenient Haskell API for working with+the API.+++### Configuration++The default 'configure' function will source credentials configuration as follows:+ - It will check for an environment provided API key in '$SMITH_JWK'.+ - It will fall-back to looking for '$SMITH_HOME/credentials.json' if '$SMITH_HOME' is set.+ - It will fall-back to looking for '$HOME/.smith/credentials.json'.++The default 'configure' function will source endpoint configuration as follows:+ - It will check for an environment provided endpoint in '$SMITH_ENDPOINT'.+ - It will fall-back to the public production endpoint 'https://api.smith.st'.+++### Stability++This library is new, and should have the disclaimers that normally+comes with that. It is expected that most people will interact with+`smith-cli` rather than directly with this library, however if you+do use this library directly, please note that whilst compatibility+won't be broken unless necessary there are a few parts of the library+(for example error handling) that will be evolved and polished as an+official release version of the API is available.+++### Example++A crude example:++```+import qualified Data.Text.IO as Text++import qualified Smith.Client as Smith+import Smith.Client.Data.User+import Smith.Client.Error (SmithError (..))++example :: IO (Either SmithError UserInfo)+example =+ Smith.configure >>= \c -> case c of+ Left err ->+ Text.putStrLn . Smith.renderSmithConfigureError $ err+ Right smith ->+ Smith.runRequest smith Smith.userinfo+```+++### Development++The simplest way to develop this library is working against the+[Pact](https://docs.pact.io/) stub server (depends on docker).++```+# Configures and starts a docker container with API stubs.+/bin/ghci-stub+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pact/Pact.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+module Pact (+ Provider (..)+ , Consumer (..)+ , Request (..)+ , Response (..)+ , Interaction (..)+ , Pact (..)+ , serialise+ ) where++import qualified Data.Aeson as Aeson+import Data.Aeson ((.=))+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.CaseInsensitive as CaseInsensitive+import Data.Monoid ((<>))+import Data.String (IsString (..))+import Data.Text (Text)+import qualified Data.Text.Encoding as Text+import qualified Network.HTTP.Types as HTTP++newtype Provider =+ Provider {+ providerName :: Text+ } deriving (Eq, Ord, Show, IsString)++newtype Consumer =+ Consumer {+ consumerName :: Text+ } deriving (Eq, Ord, Show, IsString)++data Request =+ Request {+ requestMethod :: HTTP.StdMethod+ , requestPath :: Text+ , requestBody :: Maybe Aeson.Value+ } deriving (Eq, Show)++data Response =+ Response {+ responseStatus :: HTTP.Status+ , responseHeaders :: [HTTP.Header]+ , responseBody :: Maybe Aeson.Value+ } deriving (Eq, Show)++data Interaction =+ Interaction {+ interactionDescription :: Text+ , interactionRequest :: Request+ , interactionRespone :: Response+ } deriving (Eq, Show)++data Pact =+ Pact {+ pactProvider :: Provider+ , pactConsumer :: Consumer+ , pactInteractions :: [Interaction]+ } deriving (Eq, Show)++instance Aeson.ToJSON Interaction where+ toJSON (Interaction description request response) =+ Aeson.object [+ "description" .= description+ , "request" .= Aeson.object ([+ "method" .= (Text.decodeUtf8 . HTTP.renderStdMethod . requestMethod) request+ , "path" .= requestPath request+ ] <> maybe [] (\v -> ["body" .= v]) (requestBody request))+ , "response" .= Aeson.object ([+ "status" .= HTTP.statusCode (responseStatus response)+ , "headers" .= Aeson.object (flip fmap (responseHeaders response) $ \(k, v) ->+ (Text.decodeUtf8 . CaseInsensitive.original) k .= Text.decodeUtf8 v)+ ] <> maybe [] (\v -> ["body" .= v]) (responseBody response))+ ]++instance Aeson.ToJSON Pact where+ toJSON (Pact provider consumer interactions) =+ Aeson.object [+ "provider" .= Aeson.object [+ "name" .= providerName provider+ ]+ , "consumer" .= Aeson.object [+ "name" .= consumerName consumer+ ]+ , "interactions" .= interactions+ , "metadata" .= Aeson.object [+ "pactSpecification" .= Aeson.object [+ "version" .= ("3.0.0" :: Text)+ ]+ ]+ ]++serialise :: Pact -> LazyByteString.ByteString+serialise pact =+ Aeson.encode pact
+ pact/pact-generator.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.Aeson as Aeson+import Data.Aeson ((.=))+import qualified Data.ByteString.Lazy as LazyByteString+import Data.Text (Text)+import qualified Network.HTTP.Types as HTTP+import Pact++smith :: Pact+smith =+ Pact "smith" "smith-client" [+ Interaction "oauth2"+ (Request HTTP.POST "/oauth/token" Nothing)+ (Response HTTP.status200 [(HTTP.hContentType, "application/json")] . Just $+ Aeson.object [+ "access_token" .= ("test-token" :: Text)+ , "expires_in" .= (3600 :: Int)+ , "token_type" .= ("Bearer" :: Text)+ ])+ , Interaction "userinfo"+ (Request HTTP.GET "/userinfo" Nothing)+ (Response HTTP.status200 [(HTTP.hContentType, "application/json")] . Just $+ Aeson.object [+ "sub" .= ("2" :: Text)+ ])+ , Interaction "public-keys"+ (Request HTTP.GET "/environment/public-keys/muppets" Nothing)+ (Response HTTP.status200 [(HTTP.hContentType, "application/json")] . Just $+ Aeson.object [+ "public-keys" .= [+ ("ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDH91hUsWDGHT7Ry6qoSS2HDWGL0NmWqOaTKSEqCnWf/4Vhf8X9t2sV7ADuRhP1UVXpHZHz2KL7yBk1ZXHUsL6zvAy1edjksJX3R3mpFOaEqh7TJGXWWRFKYpR69BIHVYS6gB9+GXXl5lz9fU6tKpSL50agYRgIcyGX8osTLUmQDEFyt9Hvi+qg3URuD8Bc8yeng9Kbu0r02Rcb07yHTPJFWbJDe1lY+vNLiH8PiuIu4Xk2qyBZl3NeBVUy3N0X+WCjNHk7ir/FnHp0NR21eGm3m0uDKmxhZgpY4X54Mnu3kZGJKILfq+7oZ33AZ+OiQqLhB8FGoiW7zIGM2kbRDVKR example-ca@example.com" :: Text)+ ]+ ])+ , Interaction "issue"+ (Request HTTP.POST "/issue" Nothing)+ (Response HTTP.status200 [(HTTP.hContentType, "application/json")] . Just $+ Aeson.object [+ "certificate" .= ("ssh-rsa-cert-v01@openssh.com AAAAHHNzaC1yc2EtY2VydC12MDFAb3BlbnNzaC5jb20AAAAgQfzyYQgA3tOHCdUTOX/a/CFBmYxXewTDSfOt8Y9E4AEAAAADAQABAAABAQDJRDZnxY1ywG2x5Mn2Ndlr7noCDwuKJPSVCy9LHNPauvPubXNVLDBV9ygkUphP+A9rtPQQ6ziGrG0NkhlGQ8beSfLq+MF283EnnhAnxnzqyvFQFh0seHo1a+MOgGcUliLbQEKE5uzt4An1epxhRyF71DmnNtASUh2TraTHcBqWCejr6INzv3dy4QeaDIUUI/C3xWqlDev+IFszTHS/2w3WPPMaJQUIeHN4MxUx+lDDIIIIagF03KM+k3AGZn+4j8WgNp916gjKXBvzX3gE11BBRNojq1N0uICDBYl5Si6uQzt46PLB0IojQ1zpQQREX0GKdd40Ar9ZuXOQlcLnBEs7AAAAAAAAAAAAAAABAAAACXNsaW5nc2hvdAAAAAgAAAAEcm9vdAAAAABcQ+KYAAAAAFxFNBgAAAAAAAAAEgAAAApwZXJtaXQtcHR5AAAAAAAAAAAAAAIXAAAAB3NzaC1yc2EAAAADAQABAAACAQCkXksJuOJZ57vi5m6ZnMOV09ANgbEscHUmGEsqu9xKXNuY+kOtUzbeHwAdJx8KAKmA93Bx5yXX1nPLuPIjv9PeaC5IT8BIx+9nXHe8r+Nk8hISFRl9k8btSFBXMO87GB+jp0nyPNsbUXDcKKneZa7Y5pDSIldiFEwXHzVO2hRrAT9m6jQ3CscZjR4IQMtdYLG5Occ6d9YpbBi4tE53e/He9IyY26QW87qsT1NrFMa0c0QpeZk2jY6FOrwQE5NfxkDc5Qd2HHepgParxkR/xyzPUqxKNpKC/lKvQIMSK6rsC0nPF2lH+NdHXN0QVUyiA1dyQoo0gGVmup9XKed9yq55zZO51NEnrpPbplcIvSZ6lhE8icJDcCdDnUv2U4HSE1+2yoTRDXcbyqq2rpo3QbGE16fFv8ZNGxbLxoAiENQ7oFbHwRX3kuL5DG6mrZ/BzEljzymccbbJ9RSNYMJ6UknZNTyWHl0IKfjW/HJw3lYAKgWsnhzviRZs3z+iv2P9vkLt1cgzREwie6iUdD3+Gba9m0wIiKEELH3WILxKEjF9qi7fVzyYbXKT8C0QUYoLXHBqu5eWPmGIx0Yoh3LItVKX0wIhhTaD5YwMyqwr0XIY3y7ziGCE/r5vDIx9iOWpb+eb2B04+xx5gQ8ESQMVQC7IHKOacnHzlpvehIClogIW7QAAAg8AAAAHc3NoLXJzYQAAAgB8d+QPH4xXbupLQCp4eqAnnXEJ/sGTD2MHo1w/7GtfulskMzW3nzGPh4gAdBdDXsTV11ubKzSx1JL7wqaoMS/z86zFP5h+lkRmkiEglb2iw0H6MMSd0qGqM8Us1SI6Bxg1P16AQBjdWY0/+oLhnsj58sxELx0WkMK/iCq2pJRPicXiU9hXc5mIx3wUi2x3DotwMCJ6p+YGm9j2Zkl1aLXIfCfCVGJ5MuO0SS3vQ3AVto5Xuhe4OGK+LCPPPCKHFRSF1m8l1j2RWO3bC3C8AHl7S0Pn8A4HYhkdHreBoNJtFmj9aGIw+6zgZ0mRzOZL0cunkhbe84WwVab5ZU8ZWIgkRRsnVVsaNnejzAg+fT+Q644D0GQq5peQuCCPD+hMC82UUq7wbSKvy7vQYqNpNtigfVJE/cReuKUt3OuQYkIe7uTkTYpTjyJa31GNR1RDdB8qYjjywUBk9S2b5AkVhdbOz5d9BV+pOg37dpWHSlZSXQ0rHevYNvuJSkK5+XM6P74zEKZYU+9Yv3iiq8g/46R0shlXKmB756mA8BPxt2oPhAWrjQmQ6YxN5ypASz6zmPVIXQT/sErGpTZV7DG8YL9MZBOeuC1TDKJv+e+5JiDiHNDIx/vou8HSJHuVZyq1EiM/2V4vsTE7S9SK+8Vc+ATFoi5oHA61SDoHNiNO1UGEyA== smith-ca" :: Text)+ ])+ ]++main :: IO ()+main =+ LazyByteString.writeFile "pact/json/smith.json" $+ serialise smith
+ smith-client.cabal view
@@ -0,0 +1,88 @@+name: smith-client+version: 0.0.1+synopsis: API client for <https://smith.st/ Smith>.+homepage: https://github.com/smith-security/smith-client+license: BSD3+license-file: LICENSE+author: Mark Hibberd+maintainer: mth@smith.st+copyright: (c) 2019, HotelKilo+bug-reports: https://github.com/smith-security/smith-client/issues+category: Security+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >= 1.10+description:+ This is an API client library for interacting with <https://smith.st Smith>.+source-repository head+ type: git+ location: git@github.com:smith-security/smith-client.git++library+ default-language: Haskell2010+ build-depends:+ aeson >= 1.0 && < 1.5+ , base >= 4.10 && < 5+ , bytestring == 0.*+ , directory == 1.*+ , filepath == 1.*+ , http-client >= 0.5 && < 0.6+ , http-client-tls >= 0.2 && < 0.4+ , http-types == 0.*+ , jose == 0.7.*+ , oauth2-jwt-bearer == 0.0.*+ , text == 1.*+ , transformers >= 0.4 && < 0.6+ , transformers-bifunctors == 0.*++ hs-source-dirs:+ src++ exposed-modules:+ Smith.Client+ Smith.Client.Api+ Smith.Client.Config+ Smith.Client.Data.Certificate+ Smith.Client.Data.CertificateAuthority+ Smith.Client.Data.CertificateRequest+ Smith.Client.Data.Environment+ Smith.Client.Data.Identity+ Smith.Client.Data.User+ Smith.Client.Error+ Smith.Client.Network+ Smith.Client.Request+ Smith.Client.Response+ Smith.Client.Serial.Decode+ Smith.Client.Serial.Encode+++test-suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: test.hs+ hs-source-dirs: test+ build-depends:+ base >= 4.10 && < 5+ , hedgehog == 0.6.*+ , smith-client+ , transformers++ other-modules:+ Test.Smith.Client.Api++test-suite pact-generator+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: pact-generator.hs+ hs-source-dirs: pact+ build-depends:+ aeson+ , base >= 4.10 && < 5+ , bytestring+ , case-insensitive+ , http-types+ , text+ , smith-client++ other-modules:+ Pact
+ src/Smith/Client.hs view
@@ -0,0 +1,37 @@+-- |+-- Smith Client top-level module.+--+-- Designed to be import qualified:+--+-- > import qualified Smith.Client as Smith+--+module Smith.Client (+ -- * Smith runtime data+ Smith (..)++ -- * Smith OAuth2 Scopes+ , SmithScope (..)++ -- * Smith configuration operations.+ , configure+ , configureWith+ , configureT+ , configureWithT++ -- * Smith configuration errors and default handler.+ , SmithConfigureError (..)+ , renderSmithConfigureError++ -- * Smith API definition runners.+ , runRequest+ , runRequestT++ -- * Smith API definitions.+ , module Api+ ) where++import Smith.Client.Config (Smith (..), SmithScope (..))+import Smith.Client.Config (configure, configureWith, configureT, configureWithT)+import Smith.Client.Config (SmithConfigureError (..), renderSmithConfigureError)+import Smith.Client.Network (runRequest, runRequestT)+import Smith.Client.Api as Api
+ src/Smith/Client/Api.hs view
@@ -0,0 +1,57 @@+-- |+-- Smith API definitions.+--+-- Should be used as a qualified import from top-level module:+--+-- > import qualified Smith.Client as Smith+--+-- Example:+-- > Smith.runRequest configuration Smith.userinfo+--+{-# LANGUAGE OverloadedStrings #-}+module Smith.Client.Api (+ userinfo+ , issue+ , keys+ ) where++import qualified Network.HTTP.Types as HTTP++import Smith.Client.Data.Certificate+import Smith.Client.Data.CertificateAuthority+import Smith.Client.Data.CertificateRequest+import Smith.Client.Data.Environment+import Smith.Client.Data.User+import qualified Smith.Client.Response as Response+import Smith.Client.Request (Request (..))+import qualified Smith.Client.Request as Request+import qualified Smith.Client.Serial.Decode as Decode+import qualified Smith.Client.Serial.Encode as Encode+++-- |+-- Obtain the identity information of the currently authenticated user or service.+--+userinfo :: Request UserInfo+userinfo =+ Request HTTP.GET "userinfo"+ (Response.json 200 Decode.userinfo)+ Request.none++-- |+-- Issue a certificate for the specified request details.+--+issue :: CertificateRequest -> Request Certificate+issue request =+ Request HTTP.POST "issue"+ (Response.json 200 Decode.certificate)+ (Request.json $ Encode.certificateRequest request)++-- |+-- Obtain all CA public keys for the specified environment.+--+keys :: Environment -> Request [AuthorityPublicKey]+keys environment =+ Request HTTP.GET (mconcat ["environment/public-keys/", getEnvironment environment])+ (Response.json 200 Decode.authorityPublicKeys)+ Request.none
+ src/Smith/Client/Config.hs view
@@ -0,0 +1,244 @@+-- |+-- Smith client configuration data and functions.+--+{-# LANGUAGE OverloadedStrings #-}+module Smith.Client.Config (+ -- * Smith client runtime data.+ Smith (..)++ -- * Smith client input configuration.+ , SmithEndpoint (..)+ , SmithCredentialsType (..)+ , SmithCredentials (..)++ -- * OAuth2 scopes+ , SmithScope (..)++ -- * High-level configuration operations.+ , configure+ , configureWith+ , configureT+ , configureWithT++ -- * Low-level configuration operations.+ , configureEndpoint+ , configureOAuth2+ , configureCredentials+ , configureCredentialsByteString+ , configureCredentialsFile++ -- * Configuration errors.+ , SmithConfigureError (..)+ , renderSmithConfigureError+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)++import Crypto.JWT (JWK)++import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import Data.Aeson ((.:))+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import Data.Int (Int64)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text++import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Client.TLS as HTTP+import qualified Network.OAuth2.JWT.Client as OAuth2++import Smith.Client.Data.Identity (IdentityId (..))++import qualified System.Directory as Directory+import qualified System.Environment as Environment+import System.FilePath (FilePath, (</>))+++data Smith =+ Smith SmithEndpoint HTTP.Manager OAuth2.Store+++newtype SmithEndpoint =+ SmithEndpoint {+ getSmithEndpoint :: Text+ } deriving (Eq, Ord, Show)+++data SmithCredentialsType =+ EnvironmentCredentials+ | SmithHomeCredentials FilePath+ | HomeCredentials FilePath+ | SuppliedCredentials+ deriving (Eq, Ord, Show)+++data SmithCredentials =+ SmithCredentials SmithCredentialsType IdentityId JWK+ deriving (Eq, Show)+++data SmithScope =+ ProfileScope+ | CAScope+ deriving (Eq, Ord, Show, Enum, Bounded)+++toOAuth2 :: SmithScope -> OAuth2.Scope+toOAuth2 s =+ case s of+ ProfileScope ->+ OAuth2.Scope "profile"+ CAScope ->+ OAuth2.Scope "ca"+++configure :: IO (Either SmithConfigureError Smith)+configure =+ runExceptT configureT+++configureT :: ExceptT SmithConfigureError IO Smith+configureT = do+ liftIO (HTTP.newManager HTTP.tlsManagerSettings) >>=+ configureWithT [minBound .. maxBound]+++configureWith :: [SmithScope] -> HTTP.Manager -> IO (Either SmithConfigureError Smith)+configureWith scopes manager =+ runExceptT $ configureWithT scopes manager+++configureWithT :: [SmithScope] -> HTTP.Manager -> ExceptT SmithConfigureError IO Smith+configureWithT scopes manager = do+ endpoint <- liftIO $ configureEndpoint+ SmithCredentials _ issuer jwk <- configureCredentials+ oauth2 <- liftIO $ configureOAuth2 manager endpoint (toOAuth2 <$> scopes) jwk issuer+ pure $ Smith endpoint manager oauth2+++configureEndpoint :: IO SmithEndpoint+configureEndpoint =+ maybe (SmithEndpoint "https://api.smith.st") (SmithEndpoint . Text.pack) <$>+ Environment.lookupEnv "SMITH_ENDPOINT"+++configureOAuth2 :: HTTP.Manager -> SmithEndpoint -> [OAuth2.Scope] -> JWK -> IdentityId -> IO OAuth2.Store+configureOAuth2 manager endpoint scopes jwk issuer =+ let+ token =+ OAuth2.TokenEndpoint $+ mconcat [getSmithEndpoint endpoint, "/oauth/token"]++ claims =+ OAuth2.Claims+ (OAuth2.Issuer $ identityId issuer)+ Nothing+ (OAuth2.Audience "https://smith.st")+ scopes+ (OAuth2.ExpiresIn 3600)+ []+ in+ OAuth2.newStore manager token claims jwk+++configureCredentials :: ExceptT SmithConfigureError IO SmithCredentials+configureCredentials = do+ j <- liftIO $ Environment.lookupEnv "SMITH_JWK"+ case j of+ Nothing -> do+ s <- liftIO $ Environment.lookupEnv "SMITH_HOME"+ case s of+ Nothing -> do+ h <- liftIO Directory.getHomeDirectory+ let path = h </> ".smith" </> "credentials.json"+ configureCredentialsFile (SmithHomeCredentials path) path+ Just ss -> do+ let path = ss </> "credentials.json"+ configureCredentialsFile (SmithHomeCredentials path) path+ Just s ->+ configureCredentialsByteString EnvironmentCredentials . Text.encodeUtf8 . Text.pack $ s+++configureCredentialsByteString :: SmithCredentialsType -> ByteString -> ExceptT SmithConfigureError IO SmithCredentials+configureCredentialsByteString t keydata = do+ json <- case Aeson.decodeStrict keydata of+ Nothing ->+ left $ SmithConfigureJsonDecodeError t+ Just v ->+ pure v++ jwk <- case Aeson.decodeStrict keydata of+ Nothing ->+ left $ SmithConfigureJwkDecodeError t+ Just v ->+ pure v++ issuer <- case Aeson.parse (Aeson.withObject "JWK" $ \o -> o .: "smith.st/identity-id") json of+ Aeson.Error _msg ->+ left $ SmithConfigureIdentityIdDecodeError t+ Aeson.Success v ->+ pure $ IdentityId . Text.pack . show $ (v :: Int64)++ pure $ SmithCredentials t issuer jwk+++configureCredentialsFile :: SmithCredentialsType -> FilePath -> ExceptT SmithConfigureError IO SmithCredentials+configureCredentialsFile t path = do+ exists <- liftIO . Directory.doesFileExist $ path+ case exists of+ False ->+ left $ SmithConfigureCredentialsNotFound t+ True -> do+ bytes <- liftIO . ByteString.readFile $ path+ configureCredentialsByteString t bytes+++data SmithConfigureError =+ SmithConfigureCredentialsNotFound SmithCredentialsType+ | SmithConfigureJsonDecodeError SmithCredentialsType+ | SmithConfigureJwkDecodeError SmithCredentialsType+ | SmithConfigureIdentityIdDecodeError SmithCredentialsType+ deriving (Eq, Ord, Show)+++renderSmithCredentialsType :: SmithCredentialsType -> Text+renderSmithCredentialsType t =+ case t of+ EnvironmentCredentials ->+ "Credentials were found in environment using $SMITH_JWK."+ SmithHomeCredentials path ->+ mconcat ["Credentials were found using $SMITH_HOME: ", Text.pack path]+ HomeCredentials path ->+ mconcat ["Credentials were found using $HOME: ", Text.pack path]+ SuppliedCredentials ->+ "Credentials were supplied programatically."+++renderSmithConfigureError :: SmithConfigureError -> Text+renderSmithConfigureError e =+ case e of+ SmithConfigureCredentialsNotFound t ->+ mconcat ["Smith credentials not found. ", case t of+ SuppliedCredentials ->+ "It looks you are using the library programatically, consider using 'configure'."+ SmithHomeCredentials path ->+ mconcat ["$SMITH_HOME is set, using $SMITH_HOME/credentials.json, but credentials file was not found: ", Text.pack path]+ HomeCredentials path ->+ mconcat ["$SMITH_HOME is not set, defaulting to $HOME/.smith/credentials.json, but credentials file was not found: ", Text.pack path]+ EnvironmentCredentials ->+ "Attempted to use $SMITH_JWK, but it was not set."]+ SmithConfigureJsonDecodeError t ->+ mconcat ["Smith credentials are not valid json and could not be decoded. ", renderSmithCredentialsType t]+ SmithConfigureJwkDecodeError t ->+ mconcat ["Smith credentials do not contain a valid JWT and could not be decoded. ", renderSmithCredentialsType t]+ SmithConfigureIdentityIdDecodeError t ->+ mconcat ["Smith credentials do not contain a valid identity and could not be decoded. ", renderSmithCredentialsType t]+++left :: Applicative m => x -> ExceptT x m a+left =+ ExceptT . pure . Left
+ src/Smith/Client/Data/Certificate.hs view
@@ -0,0 +1,14 @@+-- |+-- Smith certificate data types.+--+module Smith.Client.Data.Certificate (+ Certificate (..)+ ) where++import Data.Text (Text)+++newtype Certificate =+ Certificate {+ getCertificate :: Text+ } deriving (Eq, Ord, Show)
+ src/Smith/Client/Data/CertificateAuthority.hs view
@@ -0,0 +1,14 @@+-- |+-- Smith certificate authority data types.+--+module Smith.Client.Data.CertificateAuthority (+ AuthorityPublicKey (..)+ ) where++import Data.Text (Text)+++newtype AuthorityPublicKey =+ AuthorityPublicKey {+ getAuthorityPublicKey :: Text+ } deriving (Eq, Ord, Show)
+ src/Smith/Client/Data/CertificateRequest.hs view
@@ -0,0 +1,38 @@+-- |+-- Smith certificate request data types.+--+module Smith.Client.Data.CertificateRequest (+ Principal (..)+ , PublicKey (..)+ , HostName (..)+ , CertificateRequest (..)+ ) where+++import Data.Text (Text)++import Smith.Client.Data.Environment+++newtype Principal =+ Principal {+ getPrincipal :: Text+ } deriving (Eq, Ord, Show)++newtype PublicKey =+ PublicKey {+ getPublicKey :: Text+ } deriving (Eq, Ord, Show)++newtype HostName =+ HostName {+ getHostName :: Text+ } deriving (Eq, Ord, Show)++data CertificateRequest =+ CertificateRequest {+ certificateRequestPublicKey :: PublicKey+ , certificateRequestPrincipals :: [Principal]+ , certificateRequestEnvironment :: Environment+ , certificateRequestHostName :: Maybe HostName+ } deriving (Eq, Ord, Show)
+ src/Smith/Client/Data/Environment.hs view
@@ -0,0 +1,15 @@+-- |+-- Smith environment data types.+--+module Smith.Client.Data.Environment (+ Environment (..)+ ) where+++import Data.Text (Text)+++newtype Environment =+ Environment {+ getEnvironment :: Text+ } deriving (Eq, Ord, Show)
+ src/Smith/Client/Data/Identity.hs view
@@ -0,0 +1,14 @@+-- |+-- Smith identity data types.+--+module Smith.Client.Data.Identity (+ IdentityId (..)+ ) where++import Data.Text (Text)+++newtype IdentityId =+ IdentityId {+ identityId :: Text+ } deriving (Eq, Ord, Show)
+ src/Smith/Client/Data/User.hs view
@@ -0,0 +1,14 @@+-- |+-- Smith user data types.+--+module Smith.Client.Data.User (+ UserInfo (..)+ ) where++import Data.Text (Text)+++newtype UserInfo =+ UserInfo {+ userInfo :: Text+ } deriving (Eq, Ord, Show)
+ src/Smith/Client/Error.hs view
@@ -0,0 +1,33 @@+-- |+-- Smith API errors, these represent application, authn/authz and network+-- errors that can occur when making actual requests to the Smith API.+--+module Smith.Client.Error (+ SmithError (..)+ , ErrorCode (..)+ , ErrorMessage (..)+ ) where++import Data.Text (Text)+import qualified Data.ByteString.Lazy as Lazy+import qualified Network.OAuth2.JWT.Client as OAuth2++-- FIX Better division of errors, see module description for ideas...+data SmithError =+ SmithApplicationError ErrorCode (Maybe ErrorMessage)+ | SmithAuthorizationError ErrorCode (Maybe ErrorMessage)+ | SmithAuthenticationError OAuth2.GrantError+ | SmithResponseParseError Int Lazy.ByteString Text+ | SmithStatusCodeError Int Lazy.ByteString+ | SmithUrlParseError Text+ deriving (Eq, Show)++newtype ErrorCode =+ ErrorCode {+ getErrorCode :: Text+ } deriving (Eq, Ord, Show)++newtype ErrorMessage =+ ErrorMessage {+ getErrorMessage :: Text+ } deriving (Eq, Ord, Show)
+ src/Smith/Client/Network.hs view
@@ -0,0 +1,64 @@+-- |+-- Smith HTTP interactions.+--+-- Should be used as a qualified import from top-level module:+--+-- > import qualified Smith.Client as Smith+--+-- Example:+-- > Smith.runRequest configuration Smith.userinfo+--+{-# LANGUAGE OverloadedStrings #-}+module Smith.Client.Network (+ runRequest+ , runRequestT+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Bifunctor (BifunctorTrans (..))+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)++import Data.Bifunctor (Bifunctor (..))+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text++import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types as HTTP+import qualified Network.OAuth2.JWT.Client as OAuth2++import Smith.Client.Config+import Smith.Client.Error+import Smith.Client.Request (Request (..), Requester (..))+import Smith.Client.Response (Responder (..))++-- |+-- Takes Smith runtime data, and an API request definition and actually+-- runs the request. Results are in IO and the error cases handled+-- explicitly.+--+runRequest :: Smith -> Request a -> IO (Either SmithError a)+runRequest smith =+ runExceptT . runRequestT smith++-- |+-- Takes Smith runtime data, and an API request definition and actually+-- runs the request. Results are embeded in ExceptT for convenience.+--+runRequestT :: Smith -> Request a -> ExceptT SmithError IO a+runRequestT (Smith endpoint manager oauth2) (Request method path responder requester) = do+ req <- ExceptT . pure . first (SmithUrlParseError . Text.pack . show) $+ HTTP.parseRequest (Text.unpack $ mconcat [getSmithEndpoint endpoint, "/", path])++ token <- firstT SmithAuthenticationError . ExceptT $+ OAuth2.grant oauth2++ res <- liftIO $ flip HTTP.httpLbs manager . runRequester requester $+ req {+ HTTP.method = HTTP.renderStdMethod method+ , HTTP.requestHeaders = [+ ("Authorization", mconcat ["Bearer ", Text.encodeUtf8 . OAuth2.renderAccessToken $ token])+ ]+ }++ ExceptT . pure $+ runResponder responder res
+ src/Smith/Client/Request.hs view
@@ -0,0 +1,60 @@+-- |+-- Smith API definition request combinators.+--+-- You shouldn't need these unless defining custom/additional calls, see+-- 'Smith.Client.Api' for complete API definition.+--+{-# LANGUAGE OverloadedStrings #-}+module Smith.Client.Request (+ Request (..)+ , Requester (..)++ , none+ , json+ ) where++import qualified Data.Aeson as Aeson+import Data.Aeson (Value)+import Data.Text (Text)++import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types as HTTP++import Smith.Client.Response (Responder (..))+++data Request a =+ Request {+ requestMethod :: HTTP.StdMethod+ , requestPath :: Text+ , requestResponder :: Responder a+ , requestRequester :: Requester+ }+++newtype Requester =+ Requester {+ runRequester :: HTTP.Request -> HTTP.Request+ }+++none :: Requester+none =+ Requester $ \request ->+ request {+ HTTP.requestHeaders = [+ ("Accept", "application/json")+ ] ++ HTTP.requestHeaders request+ }+++json :: Value -> Requester+json value =+ Requester $ \request ->+ request {+ HTTP.requestBody = HTTP.RequestBodyLBS (Aeson.encode value)+ , HTTP.requestHeaders = [+ ("Content-Type", "application/json")+ , ("Accept", "application/json")+ ] ++ HTTP.requestHeaders request+ }
+ src/Smith/Client/Response.hs view
@@ -0,0 +1,52 @@+-- |+-- Smith API definition response combinators.+--+-- You shouldn't need these unless defining custom/additional calls, see+-- 'Smith.Client.Api' for complete API definition.+--+module Smith.Client.Response (+ ResponseError (..)++ , Responder (..)++ , json+ ) where++import Data.Aeson (Value)+import Data.Aeson.Types (Parser)+import Data.Bifunctor (Bifunctor (..))+import qualified Data.ByteString.Lazy as Lazy+import Data.Text (Text)++import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types as HTTP+import Smith.Client.Error+import qualified Smith.Client.Serial.Decode as Decode+++data ResponseError =+ ParseResponseError Int Lazy.ByteString Text+ | UnknownStatusResponseError Int Lazy.ByteString+ deriving (Eq, Ord, Show)++newtype Responder a =+ Responder {+ runResponder :: HTTP.Response Lazy.ByteString -> Either SmithError a+ }++json :: Int -> (Value -> Parser a) -> Responder a+json code parser =+ Responder $ \res ->+ case (HTTP.statusCode . HTTP.responseStatus) res of+ 400 ->+ (first (SmithResponseParseError 400 (HTTP.responseBody res)) $+ Decode.parse Decode.errored (HTTP.responseBody res)) >>= Left+ 403 ->+ (first (SmithResponseParseError 403 (HTTP.responseBody res)) $+ Decode.parse Decode.forbidden (HTTP.responseBody res)) >>= Left+ x | x == code ->+ first (SmithResponseParseError x (HTTP.responseBody res)) $+ Decode.parse parser (HTTP.responseBody res)+ x ->+ Left $+ SmithStatusCodeError x (HTTP.responseBody res)
+ src/Smith/Client/Serial/Decode.hs view
@@ -0,0 +1,66 @@+-- |+-- Smith JSON representiation decoders.+--+{-# LANGUAGE OverloadedStrings #-}+module Smith.Client.Serial.Decode (+ userinfo+ , certificate+ , authorityPublicKeys+ , errored+ , forbidden+ , parse+ ) where++import Data.Aeson (Value, (.:), (.:?))+import Data.Aeson.Types (Parser)+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import Data.Bifunctor (Bifunctor (..))+import qualified Data.ByteString.Lazy as Lazy+import Data.Text (Text)+import qualified Data.Text as Text++import Smith.Client.Data.CertificateAuthority+import Smith.Client.Data.Certificate+import Smith.Client.Data.User+import Smith.Client.Error+++userinfo :: Value -> Parser UserInfo+userinfo =+ Aeson.withObject "UserInfo" $ \o ->+ UserInfo+ <$> o .: "sub"++certificate :: Value -> Parser Certificate+certificate =+ Aeson.withObject "Certificate" $ \o ->+ Certificate+ <$> o .: "certificate"++authorityPublicKeys :: Value -> Parser [AuthorityPublicKey]+authorityPublicKeys =+ Aeson.withObject "AuthorityPublicKeys" $ \o -> do+ o .: "public-keys" >>= pure . fmap AuthorityPublicKey++errored :: Value -> Parser SmithError+errored =+ Aeson.withObject "SmithError" $ \o ->+ SmithApplicationError+ <$> (ErrorCode <$> o .: "error")+ <*> (fmap ErrorMessage <$> o .:? "message")++forbidden :: Value -> Parser SmithError+forbidden =+ Aeson.withObject "SmithError" $ \o ->+ SmithAuthorizationError+ <$> (ErrorCode <$> o .: "error")+ <*> (fmap ErrorMessage <$> o .:? "message")++parse :: (Value -> Parser a) -> Lazy.ByteString -> Either Text a+parse to t =+ first Text.pack (Aeson.eitherDecode t) >>= \v -> case Aeson.parse to v of+ Aeson.Success a ->+ pure a+ Aeson.Error msg ->+ Left . Text.pack $ msg
+ src/Smith/Client/Serial/Encode.hs view
@@ -0,0 +1,24 @@+-- |+-- Smith JSON representiation encoders.+--+{-# LANGUAGE OverloadedStrings #-}+module Smith.Client.Serial.Encode (+ certificateRequest+ ) where+++import Data.Aeson ((.=))+import qualified Data.Aeson as Aeson++import Smith.Client.Data.CertificateRequest+import Smith.Client.Data.Environment+++certificateRequest :: CertificateRequest -> Aeson.Value+certificateRequest request =+ Aeson.object [+ "public-key" .= (getPublicKey $ certificateRequestPublicKey request)+ , "principals" .= (getPrincipal <$> certificateRequestPrincipals request)+ , "environment" .= (getEnvironment $ certificateRequestEnvironment request)+ , "host-name" .= (getHostName <$> certificateRequestHostName request)+ ]
+ test/Test/Smith/Client/Api.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Test.Smith.Client.Api where++import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Except (runExceptT)+import Hedgehog++import qualified Smith.Client as Smith+import Smith.Client.Data.Environment+import Smith.Client.Data.CertificateRequest++import qualified System.Environment as Environment+++prop_end_to_end :: Property+prop_end_to_end =+ withTests 1 . property $ do+ e <- liftIO $ Environment.lookupEnv "SMITH_ENDPOINT"+ case e of+ Nothing ->+ success+ Just _endpoint -> do+ smith <- (=<<) evalEither . liftIO . runExceptT $+ Smith.configureT+ _userinfo <- (=<<) evalEither . liftIO $+ Smith.runRequest smith Smith.userinfo+ _cas <- (=<<) evalEither . liftIO $+ Smith.runRequest smith (Smith.keys $ Environment "muppets")+ _cert <- (=<<) evalEither . liftIO $+ Smith.runRequest smith (Smith.issue $+ CertificateRequest (PublicKey "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJRDZnxY1ywG2x5Mn2Ndlr7noCDwuKJPSVCy9LHNPauvPubXNVLDBV9ygkUphP+A9rtPQQ6ziGrG0NkhlGQ8beSfLq+MF283EnnhAnxnzqyvFQFh0seHo1a+MOgGcUliLbQEKE5uzt4An1epxhRyF71DmnNtASUh2TraTHcBqWCejr6INzv3dy4QeaDIUUI/C3xWqlDev+IFszTHS/2w3WPPMaJQUIeHN4MxUx+lDDIIIIagF03KM+k3AGZn+4j8WgNp916gjKXBvzX3gE11BBRNojq1N0uICDBYl5Si6uQzt46PLB0IojQ1zpQQREX0GKdd40Ar9ZuXOQlcLnBEs7 example@example.com") [Principal "root"] (Environment "muppets") (Just $ HostName "example"))+ success+ success++tests :: IO Bool+tests =+ checkParallel $$(discover)
+ test/test.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-}++import Control.Monad ((>>=), (>>), when, mapM)++import Prelude (($), (.), not, all, id)++import qualified System.Exit as Exit+import System.IO (IO)+import qualified System.IO as IO++import qualified Test.Smith.Client.Api++main :: IO ()+main =+ IO.hSetBuffering IO.stdout IO.LineBuffering >> mapM id [+ Test.Smith.Client.Api.tests+ ] >>= \rs -> when (not . all id $ rs) Exit.exitFailure