{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Data.X509.Internal
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
module Data.X509.Internal (
    module Data.ASN1.Parse,
    asn1Container,
    OID,

    -- * error handling
    ErrT,
    runErrT,
    safeDecode,
    safeCharacterToString,
) where

import Control.Exception (
    SomeAsyncException,
    SomeException,
    evaluate,
    fromException,
    throwIO,
    try,
 )
import Control.Monad.Trans.Except
import Data.ASN1.Parse
import Data.ASN1.Types
import qualified Data.List as L
import System.IO.Unsafe (unsafeDupablePerformIO)

runErrT :: ExceptT e m a -> m (Either e a)
runErrT :: forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runErrT = ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
type ErrT = ExceptT

-- | create a container around the stream of ASN1
asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1]
asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1]
asn1Container ASN1ConstructionType
ty [ASN1]
l = [ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
ty] [ASN1] -> [ASN1] -> [ASN1]
forall a. [a] -> [a] -> [a]
++ [ASN1]
l [ASN1] -> [ASN1] -> [ASN1]
forall a. [a] -> [a] -> [a]
++ [ASN1ConstructionType -> ASN1
End ASN1ConstructionType
ty]

-- | Force a decoded ASN.1 stream so that errors thrown lazily from inside
-- the list by the decoder are turned into 'Left'.
safeDecode :: Show e => Either e [a] -> Either String [a]
safeDecode :: forall e a. Show e => Either e [a] -> Either String [a]
safeDecode Either e [a]
r = case (Either e [a] -> ())
-> Either e [a] -> Either String (Either e [a])
forall a. (a -> ()) -> a -> Either String a
tryPure Either e [a] -> ()
forall {a} {t :: * -> *} {a}.
(Show a, Foldable t) =>
Either a (t a) -> ()
forceE Either e [a]
r of
    Left String
err -> String -> Either String [a]
forall a b. a -> Either a b
Left String
err
    Right (Left e
e) -> String -> Either String [a]
forall a b. a -> Either a b
Left (e -> String
forall a. Show a => a -> String
show e
e)
    Right (Right [a]
xs) -> [a] -> Either String [a]
forall a b. b -> Either a b
Right [a]
xs
  where
    forceE :: Either a (t a) -> ()
forceE (Left a
e) = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a -> String
forall a. Show a => a -> String
show a
e) Int -> () -> ()
forall a b. a -> b -> b
`seq` ()
    forceE (Right t a
xs) = (() -> a -> ()) -> () -> t a -> ()
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' ((a -> () -> ()) -> () -> a -> ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> () -> ()
forall a b. a -> b -> b
seq) () t a
xs

-- | Like 'asn1CharacterToString' but 'Nothing' on invalid encoding.
safeCharacterToString :: ASN1CharacterString -> Maybe String
safeCharacterToString :: ASN1CharacterString -> Maybe String
safeCharacterToString ASN1CharacterString
cs =
    ASN1CharacterString -> Maybe String
asn1CharacterToString ASN1CharacterString
cs Maybe String -> (String -> Maybe String) -> Maybe String
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Maybe String)
-> (String -> Maybe String) -> Either String String -> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe String -> String -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) String -> Maybe String
forall a. a -> Maybe a
Just (Either String String -> Maybe String)
-> (String -> Either String String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ()) -> String -> Either String String
forall a. (a -> ()) -> a -> Either String a
tryPure String -> ()
forall {a}. [a] -> ()
force
  where
    force :: [a] -> ()
force = (() -> a -> ()) -> () -> [a] -> ()
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' ((a -> () -> ()) -> () -> a -> ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> () -> ()
forall a b. a -> b -> b
seq) ()

-- | Run a forcing function and turn synchronous exceptions into 'Left'.
tryPure :: (a -> ()) -> a -> Either String a
tryPure :: forall a. (a -> ()) -> a -> Either String a
tryPure a -> ()
force a
x = IO (Either String a) -> Either String a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String a) -> Either String a)
-> IO (Either String a) -> Either String a
forall a b. (a -> b) -> a -> b
$ do
    Either SomeException ()
res <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ()
force a
x
    case Either SomeException ()
res of
        Right () -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ a -> Either String a
forall a b. b -> Either a b
Right a
x
        Left (SomeException
e :: SomeException)
            | Just (SomeAsyncException
_ :: SomeAsyncException) <- SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> SomeException -> IO (Either String a)
forall e a. Exception e => e -> IO a
throwIO SomeException
e
            | Bool
otherwise -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
{-# NOINLINE tryPure #-}