git.iko.soy/typeable/random-token
on master help sign in
swap
6cb8a6011 ahead, 0 behind
LICENSEnew file+2
since splitsnapshots
unifiedsplit
@@ -0,0 +1,2 @@
1+Copyright © 2020, Antorica LLC
2+All rights reserved
random-token.cabal+107−99
@@ -1,103 +1,111 @@
1+cabal-version: 2.4
1−name: random-token
2+name: random-token
2−version: 0.1.0.0
3+version: 0.1.0.0
3−synopsis: Implementation of random token generation and parsing
4+synopsis: Implementation of random token generation and parsing
4−-- description:
5−author: typeable.io
5+author: typeable.io
6−maintainer: s9gf4ult@gmail.com
6+maintainer: s9gf4ult@gmail.com
7−copyright: 2020 Author name here
7+license-file: LICENSE
8−category: Web
8+category: Web
9−build-type: Simple
9+build-type: Simple
10−cabal-version: >=1.10
11
10
12library
11library
13− hs-source-dirs: src
12+ hs-source-dirs: src
14− ghc-options: -Wall
13+ ghc-options: -Wall
15− exposed-modules: Random.Token
14+ exposed-modules: Random.Token
16− build-depends: base >= 4.7 && < 5
15+ build-depends:
17− , QuickCheck
16+ , aeson
18− , aeson
17+ , base >=4.9 && <5
19− , base64-bytestring
18+ , base64-bytestring
20− , bytestring
19+ , bytestring >=0.10
21− , deepseq
20+ , deepseq
22− , http-api-data
21+ , http-api-data
22+ , QuickCheck
23− , text
23+ , text
24+
25+ if !(impl(ghcjs) || arch(javascript) || arch(wasm32))
26+ build-depends:
24− , cryptonite
27+ , cryptonite
25− , postgresql-simple
28+ , postgresql-simple
29+
26− default-language: Haskell2010
30+ default-language: Haskell2010
27− default-extensions: CPP
31+ default-extensions:
32+ CPP
28− , ConstraintKinds
33+ ConstraintKinds
29− , DataKinds
34+ DataKinds
30− , DeriveFoldable
35+ DeriveFoldable
31− , DeriveFunctor
36+ DeriveFunctor
32− , DeriveGeneric
37+ DeriveGeneric
33− , DeriveTraversable
38+ DeriveTraversable
34− , DuplicateRecordFields
39+ DuplicateRecordFields
35− , FlexibleContexts
40+ FlexibleContexts
36− , FlexibleInstances
41+ FlexibleInstances
37− , FunctionalDependencies
42+ FunctionalDependencies
38− , GADTs
43+ GADTs
39− , GeneralizedNewtypeDeriving
44+ GeneralizedNewtypeDeriving
40− , LambdaCase
45+ LambdaCase
41− , MultiParamTypeClasses
46+ MultiParamTypeClasses
42− , MultiWayIf
47+ MultiWayIf
43− , NumDecimals
48+ NumDecimals
44− , OverloadedStrings
49+ OverloadedStrings
45− , PolyKinds
50+ PolyKinds
46− , QuasiQuotes
51+ QuasiQuotes
47− , RankNTypes
52+ RankNTypes
48− , RecordWildCards
53+ RecordWildCards
49− , RoleAnnotations
54+ RoleAnnotations
50− , ScopedTypeVariables
55+ ScopedTypeVariables
51− , StandaloneDeriving
56+ StandaloneDeriving
52− , TemplateHaskell
57+ TemplateHaskell
53− , TupleSections
58+ TupleSections
54− , TypeApplications
59+ TypeApplications
55− , TypeFamilies
60+ TypeFamilies
56− , TypeOperators
61+ TypeOperators
57− , UndecidableInstances
62+ UndecidableInstances
58− , ViewPatterns
63+ ViewPatterns
59
64
60test-suite spec
65test-suite spec
61− type: exitcode-stdio-1.0
66+ type: exitcode-stdio-1.0
62− hs-source-dirs: spec
67+ hs-source-dirs: spec
63− main-is: Test.hs
68+ main-is: Test.hs
64− other-modules: TokenSpec
69+ other-modules: TokenSpec
65− default-language: Haskell2010
70+ default-language: Haskell2010
66− build-depends: base >= 4.10 && <4.13
71+ build-depends:
72+ , base >=4.10 && <5
67− , hspec
73+ , hspec
68− , random-token
74+ , random-token
75+
76+ build-tool-depends: hspec-discover:hspec-discover
69− ghc-options: -Wall
77+ ghc-options:
70− -threaded
71− -rtsopts
72− "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"
78+ -Wall -threaded -rtsopts "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"
79+
73− ghc-prof-options: -fprof-auto
80+ ghc-prof-options: -fprof-auto
74− default-extensions: ConstraintKinds
81+ default-extensions:
82+ ConstraintKinds
75− , DataKinds
83+ DataKinds
76− , DeriveFoldable
84+ DeriveFoldable
77− , DeriveFunctor
85+ DeriveFunctor
78− , DeriveGeneric
86+ DeriveGeneric
79− , DeriveTraversable
87+ DeriveTraversable
80− , DuplicateRecordFields
88+ DuplicateRecordFields
81− , FlexibleContexts
89+ FlexibleContexts
82− , FlexibleInstances
90+ FlexibleInstances
83− , FunctionalDependencies
91+ FunctionalDependencies
84− , GADTs
92+ GADTs
85− , GeneralizedNewtypeDeriving
93+ GeneralizedNewtypeDeriving
86− , LambdaCase
94+ LambdaCase
87− , MultiParamTypeClasses
95+ MultiParamTypeClasses
88− , MultiWayIf
96+ MultiWayIf
89− , NumDecimals
97+ NumDecimals
90− , OverloadedStrings
98+ OverloadedStrings
91− , PolyKinds
99+ PolyKinds
92− , QuasiQuotes
100+ QuasiQuotes
93− , RankNTypes
101+ RankNTypes
94− , RecordWildCards
102+ RecordWildCards
95− , ScopedTypeVariables
103+ ScopedTypeVariables
96− , StandaloneDeriving
104+ StandaloneDeriving
97− , TemplateHaskell
105+ TemplateHaskell
98− , TupleSections
106+ TupleSections
99− , TypeApplications
107+ TypeApplications
100− , TypeFamilies
108+ TypeFamilies
101− , TypeOperators
109+ TypeOperators
102− , UndecidableInstances
110+ UndecidableInstances
103− , ViewPatterns
111+ ViewPatterns
src/Random/Token.hs+17−2
@@ -1,10 +1,15 @@
1+{-# LANGUAGE CPP #-}
1module Random.Token
2module Random.Token
2 ( Token
3 ( Token
3 , tokenToAscii
4 , tokenToAscii
4 , tokenToText
5 , tokenToText
5 , asciiToToken
6 , asciiToToken
6 , textToToken
7 , textToToken
8+ , unsafeCoerceToken
9+ , tokenWithContents
10+#ifndef ghcjs_HOST_OS
7 , generateToken
11 , generateToken
12+#endif
8 ) where
13 ) where
9
14
10import Control.DeepSeq
15import Control.DeepSeq
@@ -19,16 +24,17 @@ import Data.Typeable
19import Test.QuickCheck.Arbitrary
24import Test.QuickCheck.Arbitrary
20import Web.HttpApiData
25import Web.HttpApiData
21
26
27+
28+#ifndef ghcjs_HOST_OS
22import Crypto.Random as R
29import Crypto.Random as R
23import Database.PostgreSQL.Simple.FromField
30import Database.PostgreSQL.Simple.FromField
24import Database.PostgreSQL.Simple.ToField
31import Database.PostgreSQL.Simple.ToField
32+#endif
25
33
26-- | 16 bytes lenght random value parametrized by label.
34-- | 16 bytes lenght random value parametrized by label.
27newtype Token (a :: k) = Token ByteString
35newtype Token (a :: k) = Token ByteString
28 deriving (Ord, Eq, Show, NFData)
36 deriving (Ord, Eq, Show, NFData)
29
37
30−type role Token nominal
31−
32instance Arbitrary (Token a) where
38instance Arbitrary (Token a) where
33 arbitrary = fmap (Token . BS.pack) $ sequence $ L.replicate 16 arbitrary
39 arbitrary = fmap (Token . BS.pack) $ sequence $ L.replicate 16 arbitrary
34
40
@@ -40,6 +46,7 @@ instance FromJSON (Token a) where
40instance ToJSON (Token a) where
46instance ToJSON (Token a) where
41 toJSON = toJSON . tokenToText
47 toJSON = toJSON . tokenToText
42
48
49+#ifndef ghcjs_HOST_OS
43instance forall a. (Typeable (Token a), Typeable a) => FromField (Token a) where
50instance forall a. (Typeable (Token a), Typeable a) => FromField (Token a) where
44 fromField fld bs = do
51 fromField fld bs = do
45 t <- fromField fld bs
52 t <- fromField fld bs
@@ -53,6 +60,8 @@ instance ToField (Token a) where
53generateToken :: (MonadRandom m) => m (Token a)
60generateToken :: (MonadRandom m) => m (Token a)
54generateToken = Token <$> R.getRandomBytes 16
61generateToken = Token <$> R.getRandomBytes 16
55
62
63+#endif
64+
56instance FromHttpApiData (Token a) where
65instance FromHttpApiData (Token a) where
57 parseQueryParam = first T.pack . textToToken
66 parseQueryParam = first T.pack . textToToken
58
67
@@ -70,3 +79,9 @@ asciiToToken bs = Token <$> B64.decode bs
70
79
71textToToken :: Text -> Either String (Token a)
80textToToken :: Text -> Either String (Token a)
72textToToken = asciiToToken . T.encodeUtf8
81textToToken = asciiToToken . T.encodeUtf8
82+
83+tokenWithContents :: Text -> Token a
84+tokenWithContents = Token . T.encodeUtf8
85+
86+unsafeCoerceToken :: Token a -> Token b
87+unsafeCoerceToken (Token a) = Token a