{-# LANGUAGE TemplateHaskell #-}

module Wire.Sem.Jwk where

import Control.Exception
import Crypto.JOSE.JWK
import Data.Aeson
import Data.ByteString (fromStrict)
import qualified Data.ByteString as BS
import Imports
import Polysemy

data Jwk m a where
  Get :: FilePath -> Jwk m (Maybe JWK)

makeSem ''Jwk

interpretJwk :: (Members '[Embed IO] r) => Sem (Jwk ': r) a -> Sem r a
interpretJwk :: forall (r :: EffectRow) a.
Members '[Embed IO] r =>
Sem (Jwk : r) a -> Sem r a
interpretJwk = (forall (rInitial :: EffectRow) x. Jwk (Sem rInitial) x -> Sem r x)
-> Sem (Jwk : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Jwk (Sem rInitial) x -> Sem r x)
 -> Sem (Jwk : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Jwk (Sem rInitial) x -> Sem r x)
-> Sem (Jwk : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \(Get FilePath
fp) -> IO (Maybe JWK) -> Sem r (Maybe JWK)
forall a. IO a -> Sem r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe JWK) -> Sem r (Maybe JWK))
-> IO (Maybe JWK) -> Sem r (Maybe JWK)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe JWK)
readJwk FilePath
fp

readJwk :: FilePath -> IO (Maybe JWK)
readJwk :: FilePath -> IO (Maybe JWK)
readJwk FilePath
fp =
  forall e a. Exception e => IO a -> IO (Either e a)
try @IOException (FilePath -> IO ByteString
BS.readFile FilePath
fp)
    IO (Either IOException ByteString)
-> (Either IOException ByteString -> Maybe JWK) -> IO (Maybe JWK)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (IOException -> Maybe JWK)
-> (ByteString -> Maybe JWK)
-> Either IOException ByteString
-> Maybe JWK
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (Maybe JWK -> IOException -> Maybe JWK
forall a b. a -> b -> a
const Maybe JWK
forall a. Maybe a
Nothing)
      (ByteString -> Maybe JWK
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe JWK)
-> (ByteString -> ByteString) -> ByteString -> Maybe JWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict)